From eabdb9a0374ec41d8193eedbe6e8f948168b16c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ji=C5=99=C3=AD=20Moravec?= Date: Thu, 22 Feb 2024 09:50:18 +1300 Subject: [PATCH 1/4] Allows the use of = instead of <- --- R/assignment_linter.R | 14 +++++++++++--- man/assignment_linter.Rd | 4 ++++ tests/testthat/test-assignment_linter.R | 8 ++++++++ 3 files changed, 23 insertions(+), 3 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index da42b5119..c2839b2fc 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -2,6 +2,8 @@ #' #' Check that `<-` is always used for assignment. #' +#' @param allow_equal_assignment Logical, default `FALSE`. +#' If `TRUE`, `=` instead of `<-` is used for assignment. #' @param allow_cascading_assign Logical, default `TRUE`. #' If `FALSE`, [`<<-`][base::assignOps] and `->>` are not allowed. #' @param allow_right_assign Logical, default `FALSE`. If `TRUE`, `->` and `->>` are allowed. @@ -70,7 +72,8 @@ #' - #' - #' @export -assignment_linter <- function(allow_cascading_assign = TRUE, +assignment_linter <- function(allow_equal_assignment = FALSE, + allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, allow_pipe_assign = FALSE) { @@ -88,7 +91,7 @@ assignment_linter <- function(allow_cascading_assign = TRUE, xpath <- paste(collapse = " | ", c( # always block = (NB: the parser differentiates EQ_ASSIGN, EQ_SUB, and EQ_FORMALS) - "//EQ_ASSIGN", + if (allow_equal_assignment) "//LEFT_ASSIGN" else "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' if (!allow_right_assign) "//RIGHT_ASSIGN" else if (!allow_cascading_assign) "//RIGHT_ASSIGN[text() = '->>']", # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. @@ -108,7 +111,12 @@ assignment_linter <- function(allow_cascading_assign = TRUE, } operator <- xml_text(bad_expr) - lint_message_fmt <- rep("Use <-, not %s, for assignment.", length(operator)) + lint_message_fmt <- rep( + paste0("Use ", + if (allow_equal_assignment) "=" else "<-", + ", 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 == "%<>%"] <- diff --git a/man/assignment_linter.Rd b/man/assignment_linter.Rd index 291343fb2..2a925d169 100644 --- a/man/assignment_linter.Rd +++ b/man/assignment_linter.Rd @@ -5,6 +5,7 @@ \title{Assignment linter} \usage{ assignment_linter( + allow_equal_assignment = FALSE, allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, @@ -12,6 +13,9 @@ assignment_linter( ) } \arguments{ +\item{allow_equal_assignment}{Logical, default \code{FALSE}. +If \code{TRUE}, \code{=} instead of \verb{<-} is used for assignment.} + \item{allow_cascading_assign}{Logical, default \code{TRUE}. If \code{FALSE}, \code{\link[base:assignOps]{<<-}} and \verb{->>} are not allowed.} diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index bae8a048e..71d008d06 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -192,3 +192,11 @@ test_that("multiple lints throw correct messages", { assignment_linter(allow_cascading_assign = FALSE) ) }) + +test_that("equal = instead of <- can be used for assignment", { + linter <- assignment_linter(allow_equal_assignment = TRUE) + lint_msg <- rex::rex("Use =, not <-, for assignment.") + + expect_lint("blah = 1", NULL, linter) + expect_lint("blah <- 1", lint_msg, linter) +}) From 445f40fa1c3fb22df647093a380d41dcde3a7fd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ji=C5=99=C3=AD=20Moravec?= Date: Thu, 22 Feb 2024 21:01:48 +1300 Subject: [PATCH 2/4] Fixed use_equal_assign name and position --- R/assignment_linter.R | 14 +++++++------- man/assignment_linter.Rd | 10 +++++----- tests/testthat/test-assignment_linter.R | 4 ++-- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index c2839b2fc..92d7836be 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -2,13 +2,13 @@ #' #' Check that `<-` is always used for assignment. #' -#' @param allow_equal_assignment Logical, default `FALSE`. -#' If `TRUE`, `=` instead of `<-` is used for assignment. #' @param allow_cascading_assign 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_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_equal_assign Logical, default `FALSE`. +#' If `TRUE`, `=` instead of `<-` is used for assignment. #' #' @examples #' # will produce lints @@ -72,11 +72,11 @@ #' - #' - #' @export -assignment_linter <- function(allow_equal_assignment = FALSE, - allow_cascading_assign = TRUE, +assignment_linter <- function(allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, - allow_pipe_assign = FALSE) { + allow_pipe_assign = FALSE, + allow_equal_assign = FALSE) { trailing_assign_xpath <- paste( collapse = " | ", c( @@ -91,7 +91,7 @@ assignment_linter <- function(allow_equal_assignment = FALSE, xpath <- paste(collapse = " | ", c( # always block = (NB: the parser differentiates EQ_ASSIGN, EQ_SUB, and EQ_FORMALS) - if (allow_equal_assignment) "//LEFT_ASSIGN" else "//EQ_ASSIGN", + if (allow_equal_assign) "//LEFT_ASSIGN" else "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' if (!allow_right_assign) "//RIGHT_ASSIGN" else if (!allow_cascading_assign) "//RIGHT_ASSIGN[text() = '->>']", # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. @@ -113,7 +113,7 @@ assignment_linter <- function(allow_equal_assignment = FALSE, operator <- xml_text(bad_expr) lint_message_fmt <- rep( paste0("Use ", - if (allow_equal_assignment) "=" else "<-", + if (allow_equal_assign) "=" else "<-", ", not %s, for assignment."), length(operator) ) diff --git a/man/assignment_linter.Rd b/man/assignment_linter.Rd index 2a925d169..592f3c990 100644 --- a/man/assignment_linter.Rd +++ b/man/assignment_linter.Rd @@ -5,17 +5,14 @@ \title{Assignment linter} \usage{ assignment_linter( - allow_equal_assignment = FALSE, allow_cascading_assign = TRUE, allow_right_assign = FALSE, allow_trailing = TRUE, - allow_pipe_assign = FALSE + allow_pipe_assign = FALSE, + allow_equal_assign = FALSE ) } \arguments{ -\item{allow_equal_assignment}{Logical, default \code{FALSE}. -If \code{TRUE}, \code{=} instead of \verb{<-} is used for assignment.} - \item{allow_cascading_assign}{Logical, default \code{TRUE}. If \code{FALSE}, \code{\link[base:assignOps]{<<-}} and \verb{->>} are not allowed.} @@ -24,6 +21,9 @@ If \code{FALSE}, \code{\link[base:assignOps]{<<-}} and \verb{->>} are not allowe \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_equal_assign}{Logical, default \code{FALSE}. +If \code{TRUE}, \code{=} instead of \verb{<-} is used for assignment.} } \description{ Check that \verb{<-} is always used for assignment. diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 71d008d06..27a87d816 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -193,8 +193,8 @@ test_that("multiple lints throw correct messages", { ) }) -test_that("equal = instead of <- can be used for assignment", { - linter <- assignment_linter(allow_equal_assignment = TRUE) +test_that("= instead of <- can be used for assignment", { + linter <- assignment_linter(allow_equal_assign = TRUE) lint_msg <- rex::rex("Use =, not <-, for assignment.") expect_lint("blah = 1", NULL, linter) From a4fb90636774636e72caf69b421f0cd7227a8dce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ji=C5=99=C3=AD=20Moravec?= Date: Fri, 23 Feb 2024 13:37:48 +1300 Subject: [PATCH 3/4] Fix matched := when using 'allow_equal_assign' --- R/assignment_linter.R | 2 +- tests/testthat/test-assignment_linter.R | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/assignment_linter.R b/R/assignment_linter.R index 92d7836be..8d81ac014 100644 --- a/R/assignment_linter.R +++ b/R/assignment_linter.R @@ -91,7 +91,7 @@ assignment_linter <- function(allow_cascading_assign = TRUE, xpath <- paste(collapse = " | ", c( # always block = (NB: the parser differentiates EQ_ASSIGN, EQ_SUB, and EQ_FORMALS) - if (allow_equal_assign) "//LEFT_ASSIGN" else "//EQ_ASSIGN", + if (allow_equal_assign) "//LEFT_ASSIGN[text() = '<-']" else "//EQ_ASSIGN", # -> and ->> are both 'RIGHT_ASSIGN' if (!allow_right_assign) "//RIGHT_ASSIGN" else if (!allow_cascading_assign) "//RIGHT_ASSIGN[text() = '->>']", # <-, :=, and <<- are all 'LEFT_ASSIGN'; check the text if blocking <<-. diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index 27a87d816..c18e298d6 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -199,4 +199,7 @@ test_that("= instead of <- can be used for assignment", { expect_lint("blah = 1", NULL, linter) expect_lint("blah <- 1", lint_msg, linter) + + # data.table's left assign := needs to be silent + expect_lint("dt[, x := 42]", NULL, linter) }) From fe714278ea51caaa37d894dd490c50798000aa97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ji=C5=99=C3=AD=20Moravec?= Date: Wed, 30 Oct 2024 16:24:07 +1300 Subject: [PATCH 4/4] Test for new beahaviour in assigmnet_linter.r New behaviour not yet implemented --- tests/testthat/test-assignment_linter.R | 72 +++++++++++++++++++++++-- 1 file changed, 69 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-assignment_linter.R b/tests/testthat/test-assignment_linter.R index c18e298d6..95192a6d7 100644 --- a/tests/testthat/test-assignment_linter.R +++ b/tests/testthat/test-assignment_linter.R @@ -193,13 +193,79 @@ test_that("multiple lints throw correct messages", { ) }) -test_that("= instead of <- can be used for assignment", { - linter <- assignment_linter(allow_equal_assign = TRUE) - lint_msg <- rex::rex("Use =, not <-, for assignment.") +# TODO +# test multiple lints (as in above) +test_that("= can be used for top-level assignment in addition to <-", { + linter <- assignment_linter(allow_explicit_equal_assign = "allowed") + + expect_lint("blah = 1", NULL, linter) + expect_lint("blah <- 1", NULL, linter) + + # implicit <- assignmnet is unaffected + expect_lint("if (x <- 1L) TRUE", NULL, linter) + expect_lint("while (x <- 0L) FALSE", NULL, linter) + expect_lint("for (x in y <- 1:10) print(x)", NULL, linter) + + # data.table's left assign := needs to be silent + expect_lint("dt[, x := 42]", NULL, linter) +}) + + +test_that("multiple lints throw correct messages when both = and <- is allowed", { + 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, allow_explicit_equal_assign = "allowed") + ) +}) + + +test_that("= must be used for top-level assignment instead of <-", { + linter <- assignment_linter(allow_explicit_equal_assign = "required") + lint_msg <- rex::rex("Use =, not <-, for top-level assignment.") expect_lint("blah = 1", NULL, linter) expect_lint("blah <- 1", lint_msg, linter) + # implicit <- assignmnet is unaffected + expect_lint("if (x <- 1L) TRUE", NULL, linter) + expect_lint("while (x <- 0L) FALSE", NULL, linter) + expect_lint("for (x in y <- 1:10) print(x)", NULL, linter) + # data.table's left assign := needs to be silent expect_lint("dt[, x := 42]", NULL, linter) }) + + +test_that("multiple lints throw correct messages when = is required", { + 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, allow_explicit_equal_assign = "required") + ) +})