From c03a1be978b4a71b7614b2e2ca6b5aba9556cb19 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 18:58:19 +0000 Subject: [PATCH 01/12] initial implementation: just add the argument, deprecation, and add expected warnings --- R/assignment_linter.R | 23 ++++- tests/testthat/test-assignment_linter.R | 114 ++++++++++++++---------- 2 files changed, 89 insertions(+), 48 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index da42b5119..a62ec26b0 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -70,10 +70,29 @@ #' - #' - #' @export -assignment_linter <- function(allow_cascading_assign = TRUE, +assignment_linter <- function(operator = c("<-", "<<-"), + allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, allow_pipe_assign = FALSE) { + if (!missing(allow_cascading_assign)) { + lintr_deprecated("allow_cascading_assign", '"<<-" and/or "->>" in operator', version = "3.2.0", type = "Argument") + operator <- drop_or_add(operator, "<<-", allow_cascading_assign) + } + if (!missing(allow_right_assign)) { + lintr_deprecated("allow_right_assign", '"->" in operator', version = "3.2.0", type = "Argument") + operator <- drop_or_add(operator, c("->", if (allow_cascading_assign) "->>"), allow_right_assign) + } + if (!missing(allow_pipe_assign)) { + lintr_deprecated("allow_pipe_assign", '"%<>%" in operator', version = "3.2.0", type = "Argument") + operator <- drop_or_add(operator, "%<>%", allow_pipe_assign) + } + all_operators <- c("<-", "=", "->", "<<-", "->>", ":=", "%<>%") + if ("any" %in% operator) { + operator <- all_operators + } else { + operator <- match.arg(operator, all_operators, several.ok = TRUE) + } trailing_assign_xpath <- paste( collapse = " | ", c( @@ -124,3 +143,5 @@ assignment_linter <- function(allow_cascading_assign = TRUE, xml_nodes_to_lints(bad_expr, source_expression, lint_message, type = "style") }) } + +drop_or_add <- function(x, y, add) (if (add) union else setdiff)(x, y) diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index bae8a048e..b47c1a5ea 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -35,49 +35,60 @@ test_that("arguments handle <<- and ->/->> correctly", { # <<- is only blocked optionally expect_lint("1 <<- blah", NULL, linter) - expect_lint( - "1 <<- blah", - rex::rex("Replace <<- by assigning to a specific environment"), - assignment_linter(allow_cascading_assign = FALSE) + expect_warning( + expect_lint( + "1 <<- blah", + rex::rex("Replace <<- by assigning to a specific environment"), + assignment_linter(allow_cascading_assign = FALSE) + ), + "allow_cascading_assign" ) # blocking -> can be disabled - expect_lint("1 -> blah", NULL, assignment_linter(allow_right_assign = TRUE)) - expect_lint("1 ->> blah", NULL, assignment_linter(allow_right_assign = TRUE)) + expect_warning( + expect_lint("1 -> blah", NULL, assignment_linter(allow_right_assign = TRUE)), + "allow_right_assign" + ) + expect_warning( + expect_lint("1 ->> blah", NULL, assignment_linter(allow_right_assign = TRUE)), + "allow_right_assign" + ) # blocked under cascading assign but not under right assign --> blocked - expect_lint( - "1 ->> blah", - lint_msg_right, - assignment_linter(allow_cascading_assign = FALSE, allow_right_assign = TRUE) + expect_warning( + expect_warning( + expect_lint( + "1 ->> blah", + lint_msg_right, + assignment_linter(allow_cascading_assign = FALSE, allow_right_assign = TRUE) + ), + "allow_cascading_assign" + ), + "allow_right_assign" ) }) test_that("arguments handle trailing assignment operators correctly", { - expect_lint("x <- y", NULL, assignment_linter(allow_trailing = FALSE)) - expect_lint("foo(bar = 1)", NULL, assignment_linter(allow_trailing = FALSE)) + linter <- assignment_linter(allow_trailing = FALSE) + expect_lint("x <- y", NULL, linter) + expect_lint("foo(bar = 1)", NULL, linter) expect_lint( "foo(bar =\n1)", rex::rex("= should not be trailing at the end of a line."), - assignment_linter(allow_trailing = FALSE) + linter ) - expect_lint( - "x <<-\ny", - rex::rex("<<- should not be trailing"), - assignment_linter(allow_trailing = FALSE) - ) - expect_lint( + expect_lint("x <<-\ny", rex::rex("<<- should not be trailing"), linter) + expect_warning( + expect_lint( "x <<-\ny", - rex::rex("Replace <<- by assigning to a specific environment"), - assignment_linter(allow_trailing = FALSE, allow_cascading_assign = FALSE) + rex::rex("Replace <<- by assigning to a specific environment"), + assignment_linter(allow_trailing = FALSE, allow_cascading_assign = FALSE) + ), + "allow_cascading_assign" ) - expect_lint( - "x <- #Test \ny", - rex::rex("<- should not be trailing"), - assignment_linter(allow_trailing = FALSE) - ) + expect_lint("x <- #Test \ny", rex::rex("<- should not be trailing"), linter) expect_lint( "is_long <-\nis %>%\ngather(measure, value, -Species) %>%\narrange(-value)", @@ -87,7 +98,7 @@ test_that("arguments handle trailing assignment operators correctly", { expect_lint( "is_long <-\nis %>%\ngather(measure, value, -Species) %>%\narrange(-value)", rex::rex("<- should not be trailing"), - assignment_linter(allow_trailing = FALSE) + linter ) expect_lint( @@ -98,12 +109,15 @@ test_that("arguments handle trailing assignment operators correctly", { expect_lint( "is %>%\ngather(measure, value, -Species) %>%\narrange(-value) ->\nis_long", rex::rex("Use <-, not ->"), - assignment_linter(allow_trailing = FALSE) + linter ) - expect_lint( - "is %>%\ngather(measure, value, -Species) %>%\narrange(-value) ->\nis_long", - rex::rex("-> should not be trailing"), - assignment_linter(allow_right_assign = TRUE, allow_trailing = FALSE) + expect_warning( + expect_lint( + "is %>%\ngather(measure, value, -Species) %>%\narrange(-value) ->\nis_long", + rex::rex("-> should not be trailing"), + assignment_linter(allow_right_assign = TRUE, allow_trailing = FALSE) + ), + "allow_right_assign" ) expect_lint( @@ -112,7 +126,7 @@ test_that("arguments handle trailing assignment operators correctly", { list(message = "=", line_number = 3L, column_number = 5L), list(message = "<-", line_number = 5L, column_number = 5L) ), - assignment_linter(allow_trailing = FALSE) + linter ) }) @@ -169,26 +183,32 @@ test_that("allow_trailing interacts correctly with comments in braced expression test_that("%<>% throws a lint", { expect_lint("x %<>% sum()", "Avoid the assignment pipe %<>%", assignment_linter()) - expect_lint("x %<>% sum()", NULL, assignment_linter(allow_pipe_assign = TRUE)) + expect_warning( + expect_lint("x %<>% sum()", NULL, assignment_linter(allow_pipe_assign = TRUE)), + "allow_pipe_assign" + ) # interaction with allow_trailing expect_lint("x %<>%\n sum()", "Assignment %<>% should not be trailing", assignment_linter(allow_trailing = FALSE)) }) test_that("multiple lints throw correct messages", { - expect_lint( - trim_some("{ - x <<- 1 - y ->> 2 - z -> 3 - x %<>% as.character() - }"), - list( - list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), - list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), - list(message = "Use <-, not ->", line_number = 4L), - list(message = "Avoid the assignment pipe %<>%", line_number = 5L) + expect_warning( + expect_lint( + trim_some("{ + x <<- 1 + y ->> 2 + z -> 3 + x %<>% as.character() + }"), + list( + list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), + list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), + list(message = "Use <-, not ->", line_number = 4L), + list(message = "Avoid the assignment pipe %<>%", line_number = 5L) + ), + assignment_linter(allow_cascading_assign = FALSE) ), - assignment_linter(allow_cascading_assign = FALSE) + "allow_cascading_assign" ) }) From b29efda9586851ef3365955e7b81e2e49d869621 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 19:03:20 +0000 Subject: [PATCH 02/12] replace allow* arguments with equivalent operator= logic --- R/assignment_linter.R | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index a62ec26b0..5579f6bd8 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -96,11 +96,13 @@ assignment_linter <- function(operator = c("<-", "<<-"), trailing_assign_xpath <- paste( collapse = " | ", c( - paste0("//LEFT_ASSIGN", if (allow_cascading_assign) "" else "[text() = '<-']"), - if (allow_right_assign) paste0("//RIGHT_ASSIGN", if (allow_cascading_assign) "" else "[text() = '->']"), + paste0("//LEFT_ASSIGN", if ("<<-" %in% operator) "" else "[text() = '<-']"), + if (any(c("->", "->>") %in% operator)) { + paste0("//RIGHT_ASSIGN", if ("->>" %in% operator) "" else "[text() = '->']") + }, "//EQ_SUB", "//EQ_FORMALS", - if (!allow_pipe_assign) "//SPECIAL[text() = '%<>%']" + if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" ), "[@line1 < following-sibling::expr[1]/@line1]" ) @@ -109,13 +111,17 @@ assignment_linter <- function(operator = c("<-", "<<-"), # always block = (NB: the parser differentiates EQ_ASSIGN, EQ_SUB, and EQ_FORMALS) "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' - if (!allow_right_assign) "//RIGHT_ASSIGN" else if (!allow_cascading_assign) "//RIGHT_ASSIGN[text() = '->>']", + if (!any(c("->", "->>") %in% operator)) { + "//RIGHT_ASSIGN" + } else if (!"->>" %in% operator) { + "//RIGHT_ASSIGN[text() = '->>']" + }, # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. # NB: := is not linted because of (1) its common usage in rlang/data.table and # (2) it's extremely uncommon as a normal assignment operator - if (!allow_cascading_assign) "//LEFT_ASSIGN[text() = '<<-']", + if (!"<<-" %in% operator) "//LEFT_ASSIGN[text() = '<<-']", if (!allow_trailing) trailing_assign_xpath, - if (!allow_pipe_assign) "//SPECIAL[text() = '%<>%']" + if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" )) Linter(linter_level = "expression", function(source_expression) { From e2af31766ac66044a6b093483e5dc8a19023c558 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 19:45:33 +0000 Subject: [PATCH 03/12] some progress unmangling --- R/assignment_linter.R | 44 +++++---- tests/testthat/test-assignment_linter.R | 118 ++++++++++++++++++++++++ 2 files changed, 143 insertions(+), 19 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 5579f6bd8..6851f2f72 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -107,9 +107,8 @@ assignment_linter <- function(operator = c("<-", "<<-"), "[@line1 < following-sibling::expr[1]/@line1]" ) - xpath <- paste(collapse = " | ", c( - # always block = (NB: the parser differentiates EQ_ASSIGN, EQ_SUB, and EQ_FORMALS) - "//EQ_ASSIGN", + op_xpath_parts <- c( + if (!"=" %in% operator) "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' if (!any(c("->", "->>") %in% operator)) { "//RIGHT_ASSIGN" @@ -122,31 +121,38 @@ assignment_linter <- function(operator = c("<-", "<<-"), if (!"<<-" %in% operator) "//LEFT_ASSIGN[text() = '<<-']", if (!allow_trailing) trailing_assign_xpath, if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" - )) + ) + op_xpath <- if (!is.null(op_xpath_parts)) paste(op_xpath_parts, collapse = "|") Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content - bad_expr <- xml_find_all(xml, xpath) - if (length(bad_expr) == 0L) { - return(list()) - } + lints <- NULL + if (!is.null(op_xpath)) { + op_expr <- xml_find_all(xml, op_xpath) - operator <- xml_text(bad_expr) - lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(operator)) - lint_message_fmt[operator %in% c("<<-", "->>")] <- - "Replace %s by assigning to a specific environment (with assign() or <-) to avoid hard-to-predict behavior." - lint_message_fmt[operator == "%<>%"] <- - "Avoid the assignment pipe %s; prefer using <- and %%>%% separately." + op_text <- xml_text(op_expr) + op_lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(op_text)) + op_lint_message_fmt[op_text %in% c("<<-", "->>")] <- + "Replace %s by assigning to a specific environment (with assign() or <-) to avoid hard-to-predict behavior." + op_lint_message_fmt[op_text == "%<>%"] <- + "Avoid the assignment pipe %s; prefer using <- and %%>%% separately." + + op_lint_message <- sprintf(op_lint_message_fmt, op_text) + lints <- xml_nodes_to_lints(op_expr, source_expression, op_lint_message, type = "style") + } if (!allow_trailing) { - bad_trailing_expr <- xml_find_all(xml, trailing_assign_xpath) - trailing_assignments <- xml2::xml_attrs(bad_expr) %in% xml2::xml_attrs(bad_trailing_expr) - lint_message_fmt[trailing_assignments] <- "Assignment %s should not be trailing at the end of a line." + trailing_assign_expr <- xml_find_all(xml, trailing_assign_xpath) + trailing_assign_text <- xml_text(trailing_assign_expr) + trailing_assign_msg_fmt <- "Assignment %s should not be trailing at the end of a line." + trailing_assign_msg <- sprintf(trailing_assign_msg_fmt, trailing_assign_text) + lints <- c(lints, + xml_nodes_to_lints(trailing_assign_expr, source_expression, trailing_assign_msg, type = "style") + ) } - lint_message <- sprintf(lint_message_fmt, operator) - xml_nodes_to_lints(bad_expr, source_expression, lint_message, type = "style") + lints }) } diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index b47c1a5ea..36a83d1d7 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -212,3 +212,121 @@ test_that("multiple lints throw correct messages", { "allow_cascading_assign" ) }) + +test_that("assignment operator can be toggled", { + eq_linter <- assignment_linter(operator = "=") + any_linter <- assignment_linter(operator = "any") + lint_message <- rex("Use =, not") + + expect_lint("a = 1", NULL, eq_linter) + expect_lint("a = 1", NULL, any_linter) + + expect_lint("a <- 1", lint_message, eq_linter) + expect_lint("a <- 1", NULL, any_linter) + + expect_lint("a := 1", lint_message, eq_linter) + expect_lint("a := 1", NULL, any_linter) + + expect_lint("a = 1; b <- 2", lint_message, eq_linter) + expect_lint("a = 1; b <- 2", NULL, any_linter) + + expect_lint( + trim_some(" + foo = function() { + a = 1 + } + "), + NULL, + eq_linter + ) + expect_lint( + trim_some(" + foo = function() { + a = 1 + } + "), + NULL, + any_linter + ) + + expect_lint( + trim_some(" + foo = function() { + a <- 1 + } + "), + list(lint_message, line_number = 3L), + eq_linter + ) + expect_lint( + trim_some(" + foo = function() { + a <- 1 + } + "), + NULL, + any_linter + ) + + expect_lint("if ({a = TRUE}) 1", NULL, eq_linter) + expect_lint("if ({a = TRUE}) 1", NULL, any_linter) + + expect_lint("if (a <- TRUE) 1", NULL, eq_linter) + expect_lint("if (a <- TRUE) 1", NULL, any_linter) + + expect_lint("for (ii in {a = TRUE}) 1", NULL, eq_linter) + expect_lint("for (ii in {a = TRUE}) 1", NULL, any_linter) + + expect_lint("for (ii in a <- TRUE) 1", NULL, eq_linter) + expect_lint("for (ii in a <- TRUE) 1", NULL, any_linter) + + expect_lint("DT[, a := 1]", NULL, eq_linter) + expect_lint("DT[, a := 1]", NULL, any_linter) +}) + +test_that("multiple lints throw correct messages when both = and <- are allowed", { + expect_warning( + expect_lint( + trim_some("{ + x <<- 1 + y ->> 2 + z -> 3 + x %<>% as.character() + foo <- 1 + bar = 2 + }"), + list( + list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), + list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), + list(message = "Use <-, not ->", line_number = 4L), + list(message = "Avoid the assignment pipe %<>%", line_number = 5L) + ), + assignment_linter(allow_cascading_assign = FALSE, operator = "any") + ), + "allow_cascading_assign" + ) +}) + +test_that("multiple lints throw correct messages when = is required", { + expect_warning( + expect_lint( + trim_some("{ + x <<- 1 + y ->> 2 + z -> 3 + x %<>% as.character() + foo <- 1 + bar = 2 + }"), + list( + list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), + list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), + list(message = "Use <-, not ->", line_number = 4L), + list(message = "Avoid the assignment pipe %<>%", line_number = 5L), + list(message = "Use =, not <-, for top-level assignment.", line_number = 6L) + ), + assignment_linter(allow_cascading_assign = FALSE, operator = "=") + ), + "allow_cascading_assign" + ) +}) From 6308bff351b127484674858c832b357b472bf586 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:10:23 +0000 Subject: [PATCH 04/12] fix most tests --- R/assignment_linter.R | 27 ++++++++++++------- tests/testthat/test-assignment_linter.R | 35 +++++++++++++++++-------- 2 files changed, 41 insertions(+), 21 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 6851f2f72..f68b3554a 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -93,16 +93,14 @@ assignment_linter <- function(operator = c("<-", "<<-"), } else { operator <- match.arg(operator, all_operators, several.ok = TRUE) } - trailing_assign_xpath <- paste( + trailing_assign_xpath <- paste0( collapse = " | ", c( - paste0("//LEFT_ASSIGN", if ("<<-" %in% operator) "" else "[text() = '<-']"), - if (any(c("->", "->>") %in% operator)) { - paste0("//RIGHT_ASSIGN", if ("->>" %in% operator) "" else "[text() = '->']") - }, + "//LEFT_ASSIGN", + "//RIGHT_ASSIGN", "//EQ_SUB", "//EQ_FORMALS", - if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" + "//SPECIAL[text() = '%<>%']" ), "[@line1 < following-sibling::expr[1]/@line1]" ) @@ -118,11 +116,14 @@ assignment_linter <- function(operator = c("<-", "<<-"), # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. # NB: := is not linted because of (1) its common usage in rlang/data.table and # (2) it's extremely uncommon as a normal assignment operator - if (!"<<-" %in% operator) "//LEFT_ASSIGN[text() = '<<-']", - if (!allow_trailing) trailing_assign_xpath, + if (!any(c("<-", "<<-") %in% operator)) { + "//LEFT_ASSIGN" + } else if (!"<<-" %in% operator) { + "//LEFT_ASSIGN[text() = '<<-']" + }, if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" ) - op_xpath <- if (!is.null(op_xpath_parts)) paste(op_xpath_parts, collapse = "|") + op_xpath <- if (!is.null(op_xpath_parts)) paste(op_xpath_parts, collapse = " | ") Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content @@ -132,7 +133,13 @@ assignment_linter <- function(operator = c("<-", "<<-"), op_expr <- xml_find_all(xml, op_xpath) op_text <- xml_text(op_expr) - op_lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(op_text)) + op_lint_message_fmt <- rep( + sprintf( + "Use %s for assignment, not %%s.", + if (length(operator) > 1L) paste("one of", toString(operator)) else operator + ), + length(op_text) + ) op_lint_message_fmt[op_text %in% c("<<-", "->>")] <- "Replace %s by assigning to a specific environment (with assign() or <-) to avoid hard-to-predict behavior." op_lint_message_fmt[op_text == "%<>%"] <- diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 36a83d1d7..05e93a566 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -9,7 +9,7 @@ test_that("assignment_linter skips allowed usages", { test_that("assignment_linter blocks disallowed usages", { linter <- assignment_linter() - lint_msg <- rex::rex("Use <-, not =, for assignment.") + lint_msg <- rex::rex("Use one of <-, <<- for assignment, not =.") expect_lint("blah=1", lint_msg, linter) expect_lint("blah = 1", lint_msg, linter) @@ -30,7 +30,7 @@ test_that("arguments handle <<- and ->/->> correctly", { linter <- assignment_linter() lint_msg_right <- rex::rex("Replace ->> by assigning to a specific environment") - expect_lint("1 -> blah", rex::rex("Use <-, not ->, for assignment."), linter) + expect_lint("1 -> blah", rex::rex("Use one of <-, <<- for assignment, not ->."), linter) expect_lint("1 ->> blah", lint_msg_right, linter) # <<- is only blocked optionally @@ -82,7 +82,10 @@ test_that("arguments handle trailing assignment operators correctly", { expect_warning( expect_lint( "x <<-\ny", - rex::rex("Replace <<- by assigning to a specific environment"), + list( + rex::rex("Replace <<- by assigning to a specific environment"), + rex::rex("Assignment <<- should not be trailing") + ), assignment_linter(allow_trailing = FALSE, allow_cascading_assign = FALSE) ), "allow_cascading_assign" @@ -103,12 +106,15 @@ test_that("arguments handle trailing assignment operators correctly", { expect_lint( "is %>%\ngather(measure, value, -Species) %>%\narrange(-value) ->\nis_long", - rex::rex("Use <-, not ->"), + rex::rex("Use one of <-, <<- for assignment, not ->"), assignment_linter() ) expect_lint( "is %>%\ngather(measure, value, -Species) %>%\narrange(-value) ->\nis_long", - rex::rex("Use <-, not ->"), + list( + rex::rex("Use one of <-, <<- for assignment, not ->"), + rex::rex("Assignment -> should not be trailing") + ), linter ) expect_warning( @@ -189,7 +195,14 @@ test_that("%<>% throws a lint", { ) # interaction with allow_trailing - expect_lint("x %<>%\n sum()", "Assignment %<>% should not be trailing", assignment_linter(allow_trailing = FALSE)) + expect_lint( + "x %<>%\n sum()", + list( + "Avoid the assignment pipe %<>%", + "Assignment %<>% should not be trailing" + ), + assignment_linter(allow_trailing = FALSE) + ) }) test_that("multiple lints throw correct messages", { @@ -204,7 +217,7 @@ test_that("multiple lints throw correct messages", { list( list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), - list(message = "Use <-, not ->", line_number = 4L), + list(message = "Use <- for assignment, not ->", line_number = 4L), list(message = "Avoid the assignment pipe %<>%", line_number = 5L) ), assignment_linter(allow_cascading_assign = FALSE) @@ -216,7 +229,7 @@ test_that("multiple lints throw correct messages", { test_that("assignment operator can be toggled", { eq_linter <- assignment_linter(operator = "=") any_linter <- assignment_linter(operator = "any") - lint_message <- rex("Use =, not") + lint_message <- rex("Use = for assignment, not") expect_lint("a = 1", NULL, eq_linter) expect_lint("a = 1", NULL, any_linter) @@ -255,7 +268,7 @@ test_that("assignment operator can be toggled", { a <- 1 } "), - list(lint_message, line_number = 3L), + list(lint_message, line_number = 2L), eq_linter ) expect_lint( @@ -321,9 +334,9 @@ test_that("multiple lints throw correct messages when = is required", { list( list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), - list(message = "Use <-, not ->", line_number = 4L), + list(message = "Use = for assignment, not ->", line_number = 4L), list(message = "Avoid the assignment pipe %<>%", line_number = 5L), - list(message = "Use =, not <-, for top-level assignment.", line_number = 6L) + list(message = "Use = for assignment, not <-", line_number = 6L) ), assignment_linter(allow_cascading_assign = FALSE, operator = "=") ), From 1ffd72b852ea5ad3607a7bbfdc0f2fa395494940 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:30:07 +0000 Subject: [PATCH 05/12] passing existing tests --- R/assignment_linter.R | 16 ++++++++++++++-- tests/testthat/test-assignment_linter.R | 4 ++-- 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index f68b3554a..0e30eb868 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -117,13 +117,25 @@ assignment_linter <- function(operator = c("<-", "<<-"), # NB: := is not linted because of (1) its common usage in rlang/data.table and # (2) it's extremely uncommon as a normal assignment operator if (!any(c("<-", "<<-") %in% operator)) { - "//LEFT_ASSIGN" + "//LEFT_ASSIGN[text() != ':=' or not(parent::expr/preceding-sibling::OP-LEFT-BRACKET)]" } else if (!"<<-" %in% operator) { "//LEFT_ASSIGN[text() = '<<-']" }, if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" ) - op_xpath <- if (!is.null(op_xpath_parts)) paste(op_xpath_parts, collapse = " | ") + if (!is.null(op_xpath_parts)) { + # NB: copy-pasted from implicit_assignment_linter. Keep in sync. + implicit_assignment_xpath <- " + [not(parent::expr[ + preceding-sibling::*[2][self::IF or self::WHILE] + or parent::forcond + or parent::expr/*[1][self::OP-LEFT-PAREN] + ])] + " + op_xpath <- paste0(op_xpath_parts, implicit_assignment_xpath, collapse = " | ") + } else { + op_xpath <- NULL + } Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 05e93a566..22acdfaa0 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -311,10 +311,10 @@ test_that("multiple lints throw correct messages when both = and <- are allowed" list( list(message = "Replace <<- by assigning to a specific environment", line_number = 2L), list(message = "Replace ->> by assigning to a specific environment", line_number = 3L), - list(message = "Use <-, not ->", line_number = 4L), + list(message = "Use one of =, <- for assignment, not ->", line_number = 4L), list(message = "Avoid the assignment pipe %<>%", line_number = 5L) ), - assignment_linter(allow_cascading_assign = FALSE, operator = "any") + assignment_linter(allow_cascading_assign = FALSE, operator = c("=", "<-")) ), "allow_cascading_assign" ) From c25bfde02103473ff737d36cf7927cddc4ad19ba Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:34:54 +0000 Subject: [PATCH 06/12] simplify, remove := handling as before --- R/assignment_linter.R | 12 ++---------- tests/testthat/test-assignment_linter.R | 6 ------ 2 files changed, 2 insertions(+), 16 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 0e30eb868..44f663b80 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -108,19 +108,11 @@ assignment_linter <- function(operator = c("<-", "<<-"), op_xpath_parts <- c( if (!"=" %in% operator) "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' - if (!any(c("->", "->>") %in% operator)) { - "//RIGHT_ASSIGN" - } else if (!"->>" %in% operator) { - "//RIGHT_ASSIGN[text() = '->>']" - }, + glue("//RIGHT_ASSIGN[{xp_text_in_table(setdiff(c('->', '->>'), operator))}]"), # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. # NB: := is not linted because of (1) its common usage in rlang/data.table and # (2) it's extremely uncommon as a normal assignment operator - if (!any(c("<-", "<<-") %in% operator)) { - "//LEFT_ASSIGN[text() != ':=' or not(parent::expr/preceding-sibling::OP-LEFT-BRACKET)]" - } else if (!"<<-" %in% operator) { - "//LEFT_ASSIGN[text() = '<<-']" - }, + glue("//LEFT_ASSIGN[{xp_text_in_table(setdiff(c('<-', '<<-'), operator))}]"), if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" ) if (!is.null(op_xpath_parts)) { diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 22acdfaa0..b764d00ee 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -237,9 +237,6 @@ test_that("assignment operator can be toggled", { expect_lint("a <- 1", lint_message, eq_linter) expect_lint("a <- 1", NULL, any_linter) - expect_lint("a := 1", lint_message, eq_linter) - expect_lint("a := 1", NULL, any_linter) - expect_lint("a = 1; b <- 2", lint_message, eq_linter) expect_lint("a = 1; b <- 2", NULL, any_linter) @@ -292,9 +289,6 @@ test_that("assignment operator can be toggled", { expect_lint("for (ii in a <- TRUE) 1", NULL, eq_linter) expect_lint("for (ii in a <- TRUE) 1", NULL, any_linter) - - expect_lint("DT[, a := 1]", NULL, eq_linter) - expect_lint("DT[, a := 1]", NULL, any_linter) }) test_that("multiple lints throw correct messages when both = and <- are allowed", { From 4f39f6e6e5339020125dcbb421c5b586fe8c04ed Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:40:27 +0000 Subject: [PATCH 07/12] add docs, readability --- R/assignment_linter.R | 28 ++++++++++++++++++++-------- R/implicit_assignment_linter.R | 1 + man/assignment_linter.Rd | 22 ++++++++++++++++++---- 3 files changed, 39 insertions(+), 12 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 44f663b80..0fd443f59 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -1,12 +1,14 @@ #' Assignment linter #' -#' Check that `<-` is always used for assignment. +#' Check that the specified operator is used for assignment. #' -#' @param allow_cascading_assign Logical, default `TRUE`. +#' @param operator Character vector of valid assignment operators. Defaults to allowing `<-` and `<<-`; other valid +#' options are `=`, `->`, `->>`, and `%<>%`. +#' @param allow_cascading_assign (Deprecated) Logical, default `TRUE`. #' If `FALSE`, [`<<-`][base::assignOps] and `->>` are not allowed. -#' @param allow_right_assign Logical, default `FALSE`. If `TRUE`, `->` and `->>` are allowed. +#' @param allow_right_assign (Deprecated) Logical, default `FALSE`. If `TRUE`, `->` and `->>` are allowed. #' @param allow_trailing Logical, default `TRUE`. If `FALSE` then assignments aren't allowed at end of lines. -#' @param allow_pipe_assign Logical, default `FALSE`. If `TRUE`, magrittr's `%<>%` assignment is allowed. +#' @param allow_pipe_assign (Deprecated) Logical, default `FALSE`. If `TRUE`, magrittr's `%<>%` assignment is allowed. #' #' @examples #' # will produce lints @@ -27,6 +29,11 @@ #' linters = assignment_linter() #' ) #' +#' lint( +#' text = "x <- 1", +#' linters = assignment_linter(operator = "=") +#' ) +#' #' # okay #' lint( #' text = "x <- mean(x)", @@ -64,6 +71,11 @@ #' linters = assignment_linter(allow_pipe_assign = TRUE) #' ) #' +#' lint( +#' text = "x = 1", +#' linters = assignment_linter(operator = "=") +#' ) +#' #' @evalRd rd_tags("assignment_linter") #' @seealso #' - [linters] for a complete list of linters available in lintr. @@ -87,7 +99,7 @@ assignment_linter <- function(operator = c("<-", "<<-"), lintr_deprecated("allow_pipe_assign", '"%<>%" in operator', version = "3.2.0", type = "Argument") operator <- drop_or_add(operator, "%<>%", allow_pipe_assign) } - all_operators <- c("<-", "=", "->", "<<-", "->>", ":=", "%<>%") + all_operators <- c("<-", "=", "->", "<<-", "->>", "%<>%") if ("any" %in% operator) { operator <- all_operators } else { @@ -108,15 +120,15 @@ assignment_linter <- function(operator = c("<-", "<<-"), op_xpath_parts <- c( if (!"=" %in% operator) "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' - glue("//RIGHT_ASSIGN[{xp_text_in_table(setdiff(c('->', '->>'), operator))}]"), + glue("//RIGHT_ASSIGN[{ xp_text_in_table(setdiff(c('->', '->>'), operator)) }]"), # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. # NB: := is not linted because of (1) its common usage in rlang/data.table and # (2) it's extremely uncommon as a normal assignment operator - glue("//LEFT_ASSIGN[{xp_text_in_table(setdiff(c('<-', '<<-'), operator))}]"), + glue("//LEFT_ASSIGN[{ xp_text_in_table(setdiff(c('<-', '<<-'), operator)) }]"), if (!"%<>%" %in% operator) "//SPECIAL[text() = '%<>%']" ) if (!is.null(op_xpath_parts)) { - # NB: copy-pasted from implicit_assignment_linter. Keep in sync. + # NB: Also used, essentially, in implicit_assignment_linter. Keep in sync. implicit_assignment_xpath <- " [not(parent::expr[ preceding-sibling::*[2][self::IF or self::WHILE] diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index 70dfd3376..758c8ab6e 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -79,6 +79,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" sep = " | " ) + # NB: Also used, essentially, in assignment_linter. Keep in sync. xpath <- glue(" ({assignments}) /parent::expr[ diff --git a/man/assignment_linter.Rd b/man/assignment_linter.Rd index 291343fb2..9ed11c6f3 100644 --- a/man/assignment_linter.Rd +++ b/man/assignment_linter.Rd @@ -5,6 +5,7 @@ \title{Assignment linter} \usage{ assignment_linter( + operator = c("<-", "<<-"), allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, @@ -12,17 +13,20 @@ assignment_linter( ) } \arguments{ -\item{allow_cascading_assign}{Logical, default \code{TRUE}. +\item{operator}{Character vector of valid assignment operators. Defaults to allowing \verb{<-} and \verb{<<-}; other valid +options are \code{=}, \verb{->}, \verb{->>}, and \verb{\%<>\%}.} + +\item{allow_cascading_assign}{(Deprecated) Logical, default \code{TRUE}. If \code{FALSE}, \code{\link[base:assignOps]{<<-}} and \verb{->>} are not allowed.} -\item{allow_right_assign}{Logical, default \code{FALSE}. If \code{TRUE}, \verb{->} and \verb{->>} are allowed.} +\item{allow_right_assign}{(Deprecated) Logical, default \code{FALSE}. If \code{TRUE}, \verb{->} and \verb{->>} are allowed.} \item{allow_trailing}{Logical, default \code{TRUE}. If \code{FALSE} then assignments aren't allowed at end of lines.} -\item{allow_pipe_assign}{Logical, default \code{FALSE}. If \code{TRUE}, magrittr's \verb{\%<>\%} assignment is allowed.} +\item{allow_pipe_assign}{(Deprecated) Logical, default \code{FALSE}. If \code{TRUE}, magrittr's \verb{\%<>\%} assignment is allowed.} } \description{ -Check that \verb{<-} is always used for assignment. +Check that the specified operator is used for assignment. } \examples{ # will produce lints @@ -43,6 +47,11 @@ lint( linters = assignment_linter() ) +lint( + text = "x <- 1", + linters = assignment_linter(operator = "=") +) + # okay lint( text = "x <- mean(x)", @@ -80,6 +89,11 @@ lint( linters = assignment_linter(allow_pipe_assign = TRUE) ) +lint( + text = "x = 1", + linters = assignment_linter(operator = "=") +) + } \seealso{ \itemize{ From 69841ea10e94c6cf9914ab84c05b9db43e2bf9c4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:48:18 +0000 Subject: [PATCH 08/12] NEWS, and mention "any" in man --- NEWS.md | 2 ++ R/assignment_linter.R | 3 ++- man/assignment_linter.Rd | 3 ++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 688c18fab..072f1b81d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,6 +18,7 @@ * `scalar_in_linter` is now configurable to allow other `%in%` like operators to be linted. The data.table operator `%chin%` is no longer linted by default; use `in_operators = "%chin%"` to continue linting it. (@F-Noelle) * `lint()` and friends now normalize paths to forward slashes on Windows (@olivroy, #2613). * `undesirable_function_linter()`, `undesirable_operator_linter()`, and `list_comparison_linter()` were removed from the tag `efficiency` (@IndrajeetPatil, #2655). If you use `linters_with_tags("efficiency")` to include these linters, you'll need to adjust your config to keep linting your code against them. We did not find any such users on GitHub. +* Arguments `allow_cascading_assign=`, `allow_right_assign=`, and `allow_pipe_assign=` to `assignment_linter()` are all deprecated in favor of the new `operator=` argument. See below about the new argument. ## Bug fixes @@ -61,6 +62,7 @@ * `expect_no_lint()` was added as new function to cover the typical use case of expecting no lint message, akin to the recent {testthat} functions like `expect_no_warning()` (#2580, @F-Noelle). * `lint()` and friends emit a message if no lints are found (#2643, @IndrajeetPatil). * `{lintr}` now has a hex sticker (https://github.com/rstudio/hex-stickers/pull/110). Thank you, @gregswinehart! +* `assignment_linter()` can be fully customized with the new `operator=` argument to specify an exact vector of assignment operators to allow (#2441, @MichaelChirico and @J-Moravec). The default is `<-` and `<<-`; authors wishing to use `=` (only) for assignment in their codebase can use `operator = "="`. This supersedes several old arguments: to accomplish `allow_cascading_assign=TRUE`, add `"<<-"` (and/or `"->>"`) to `operator=`; for `allow_right_assign=TRUE`, add `"->"` (and/or `"->>"`) to `operator=`; for `allow_pipe_assign=TRUE`, add `"%<>%"` to `operator=`. Use `operator = "any"` to denote "ignore all assignment operators"; in this case, only the value of `allow_trailing=` matters. Implicit assignments with `<-` are always ignored by `assignment_linter()`; use `implicit_assignment_linter()` to handle linting these. ### New linters diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 0fd443f59..683407cb9 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -3,7 +3,8 @@ #' Check that the specified operator is used for assignment. #' #' @param operator Character vector of valid assignment operators. Defaults to allowing `<-` and `<<-`; other valid -#' options are `=`, `->`, `->>`, and `%<>%`. +#' options are `=`, `->`, `->>`, `%<>%`; use `"any"` to denote "allow all operators", in which case this linter only +#' considers `allow_trailing` for generating lints. #' @param allow_cascading_assign (Deprecated) Logical, default `TRUE`. #' If `FALSE`, [`<<-`][base::assignOps] and `->>` are not allowed. #' @param allow_right_assign (Deprecated) Logical, default `FALSE`. If `TRUE`, `->` and `->>` are allowed. diff --git a/man/assignment_linter.Rd b/man/assignment_linter.Rd index 9ed11c6f3..9efc4bbd1 100644 --- a/man/assignment_linter.Rd +++ b/man/assignment_linter.Rd @@ -14,7 +14,8 @@ assignment_linter( } \arguments{ \item{operator}{Character vector of valid assignment operators. Defaults to allowing \verb{<-} and \verb{<<-}; other valid -options are \code{=}, \verb{->}, \verb{->>}, and \verb{\%<>\%}.} +options are \code{=}, \verb{->}, \verb{->>}, \verb{\%<>\%}; use \code{"any"} to denote "allow all operators", in which case this linter only +considers \code{allow_trailing} for generating lints.} \item{allow_cascading_assign}{(Deprecated) Logical, default \code{TRUE}. If \code{FALSE}, \code{\link[base:assignOps]{<<-}} and \verb{->>} are not allowed.} From 73e3cac3629daa2fc86e07751f9bf638fd163e63 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 21:58:04 +0000 Subject: [PATCH 09/12] allow_trailing=FALSE lints when EQ_ASSIGN used --- R/assignment_linter.R | 1 + tests/testthat/test-assignment_linter.R | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 683407cb9..cda46512e 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -111,6 +111,7 @@ assignment_linter <- function(operator = c("<-", "<<-"), c( "//LEFT_ASSIGN", "//RIGHT_ASSIGN", + "//EQ_ASSIGN", "//EQ_SUB", "//EQ_FORMALS", "//SPECIAL[text() = '%<>%']" diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index b764d00ee..b2056e8b5 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -134,6 +134,12 @@ test_that("arguments handle trailing assignment operators correctly", { ), linter ) + + expect_lint( + "a =\n1", + "= should not be trailing", + linter + ) }) test_that("allow_trailing interacts correctly with comments in braced expressions", { From cff4f72579d06dc3c7a03b737671aa46ffe70d0a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 22:57:18 +0000 Subject: [PATCH 10/12] fix tests --- tests/testthat/test-assignment_linter.R | 14 ++++++++++---- tests/testthat/test-exclusions.R | 4 ++-- tests/testthat/test-expect_lint.R | 2 +- tests/testthat/test-knitr_formats.R | 2 +- 4 files changed, 14 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index b2056e8b5..3a05f2e08 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -127,10 +127,16 @@ test_that("arguments handle trailing assignment operators correctly", { ) expect_lint( - "\n\nblah=\n42\nblh2<-\n54", + trim_some(" + blah = + 42 + blh2 <- + 54 + "), list( - list(message = "=", line_number = 3L, column_number = 5L), - list(message = "<-", line_number = 5L, column_number = 5L) + list(message = "Use one of <-, <<- for assignment, not =.", line_number = 1L, column_number = 6L), + list(message = "Assignment = should not be trailing at the end of a line", line_number = 1L, column_number = 6L), + list(message = "Assignment <- should not be trailing at the end of a line", line_number = 3L, column_number = 6L) ), linter ) @@ -138,7 +144,7 @@ test_that("arguments handle trailing assignment operators correctly", { expect_lint( "a =\n1", "= should not be trailing", - linter + assignment_linter(operator = "=", allow_trailing = FALSE) ) }) diff --git a/tests/testthat/test-exclusions.R b/tests/testthat/test-exclusions.R index d4e8dd5c6..9fce8adf5 100644 --- a/tests/testthat/test-exclusions.R +++ b/tests/testthat/test-exclusions.R @@ -194,7 +194,7 @@ test_that("next-line exclusion works", { # NLN: line_length_linter. x = 1 "), - rex::rex("Use <-, not =, for assignment."), + rex::rex("Use one of <-, <<- for assignment, not =."), list(linter, line_length_linter()) ) @@ -204,7 +204,7 @@ test_that("next-line exclusion works", { x = 1 # NLN: assignment_linter. x = 2 "), - list(rex::rex("Use <-, not =, for assignment."), line_number = 1L), + list(rex::rex("Use one of <-, <<- for assignment, not =."), line_number = 1L), linter ) }) diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index f03d7e7a3..c2b9d6264 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -3,7 +3,7 @@ # for failure, always put the lint check or lint field that must fail first. linter <- assignment_linter() -lint_msg <- "Use <-, not =" +lint_msg <- "Use one of <-, <<- for assignment, not =" test_that("no checks", { expect_success(expect_no_lint("a", linter)) diff --git a/tests/testthat/test-knitr_formats.R b/tests/testthat/test-knitr_formats.R index a62d23e2a..eb3dfc5f9 100644 --- a/tests/testthat/test-knitr_formats.R +++ b/tests/testthat/test-knitr_formats.R @@ -1,5 +1,5 @@ regexes <- list( - assign = rex::rex("Use <-, not =, for assignment."), + assign = rex::rex("Use one of <-, <<- for assignment, not =."), local_var = rex::rex("local variable"), quotes = rex::rex("Only use double-quotes."), trailing = rex::rex("Remove trailing blank lines."), From aa05ac79b9aaffd1d95f366abae56d8083922dd5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 23:19:28 +0000 Subject: [PATCH 11/12] last two tests --- tests/testthat/test-knitr_extended_formats.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-knitr_extended_formats.R b/tests/testthat/test-knitr_extended_formats.R index 35dcbd652..15526265e 100644 --- a/tests/testthat/test-knitr_extended_formats.R +++ b/tests/testthat/test-knitr_extended_formats.R @@ -4,7 +4,7 @@ test_that("marginfigure engine from tufte package doesn't cause problems", { expect_lint( file = test_path("knitr_extended_formats", "tufte.Rmd"), - checks = list(rex::rex("Use <-, not =, for assignment."), line_number = 11L), + checks = list(rex::rex("Use one of <-, <<- for assignment, not =."), line_number = 11L), default_linters, parse_settings = FALSE ) @@ -16,7 +16,7 @@ test_that("engines from bookdown package cause no problems", { expect_lint( file = test_path("knitr_extended_formats", "bookdown.Rmd"), - checks = list(rex::rex("Use <-, not =, for assignment."), line_number = 14L), + checks = list(rex::rex("Use one of <-, <<- for assignment, not =."), line_number = 14L), default_linters, parse_settings = FALSE ) From 979200142fe103fee54b0c85bb93c5460ae371f5 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 28 Jan 2025 23:20:38 +0000 Subject: [PATCH 12/12] delint --- tests/testthat/test-assignment_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 3a05f2e08..0e00d5c89 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -81,7 +81,7 @@ test_that("arguments handle trailing assignment operators correctly", { expect_lint("x <<-\ny", rex::rex("<<- should not be trailing"), linter) expect_warning( expect_lint( - "x <<-\ny", + "x <<-\ny", list( rex::rex("Replace <<- by assigning to a specific environment"), rex::rex("Assignment <<- should not be trailing")