From 2580ab2543725d9a7522310772e75b3007e60c00 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 17 Mar 2022 12:38:21 -0700 Subject: [PATCH] extend infix_spaces_linter to be more flexible & correct (#931) * extend infix_spaces_linter to be more flexible & correct * git mangled * clarifying comments * test of grouped exclusion by %% * missed ~ in docs * use angle brackets for external URL * remove linter from DB & document() * sAF=FALSE for R<4 * sQuote version issue * more tests * switch from with() usage to appease object_usage_linter * mini-edit to create a commit * roxygenize * roxygenize * fix new lintr lints caught by the improvement Co-authored-by: AshesITR --- .gitignore | 1 + DESCRIPTION | 1 - NAMESPACE | 1 - NEWS.md | 3 +- R/assignment_spaces_linter.R | 38 -------- R/infix_spaces_linter.R | 96 +++++++++++++------ R/methods.R | 2 +- R/path_linters.R | 6 +- R/spaces_left_parentheses_linter.R | 7 +- R/utils.R | 4 +- inst/lintr/linters.csv | 1 - man/assignment_spaces_linter.Rd | 17 ---- man/infix_spaces_linter.Rd | 13 ++- man/linters.Rd | 5 +- man/readability_linters.Rd | 1 - man/style_linters.Rd | 1 - .../testthat/test-assignment_spaces_linter.R | 54 ----------- tests/testthat/test-infix_spaces_linter.R | 67 ++++++++++++- 18 files changed, 160 insertions(+), 158 deletions(-) delete mode 100644 R/assignment_spaces_linter.R delete mode 100644 man/assignment_spaces_linter.Rd delete mode 100644 tests/testthat/test-assignment_spaces_linter.R diff --git a/.gitignore b/.gitignore index a102227a5..2d456158c 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ script.R *.Rcheck lintr_*.tar.gz +testthat-problems.rds diff --git a/DESCRIPTION b/DESCRIPTION index e944e6891..5f3f90d33 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,7 +50,6 @@ Collate: 'actions.R' 'addins.R' 'assignment_linter.R' - 'assignment_spaces_linter.R' 'backport_linter.R' 'cache.R' 'closed_curly_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 3db3748df..d86c70569 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,7 +14,6 @@ export(absolute_path_linter) export(all_undesirable_functions) export(all_undesirable_operators) export(assignment_linter) -export(assignment_spaces_linter) export(available_linters) export(backport_linter) export(checkstyle_output) diff --git a/NEWS.md b/NEWS.md index 6523cfa14..cc17577c6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,7 +10,6 @@ format specifiers (#472, @russHyde) * New style SNAKE_CASE for `object_name_linter()` (#494, @AshesITR) * RStudio source markers are cleared when there are no lints (#520, @AshesITR) -* New `assignment_spaces()` lintr. (#538, @f-ritter) * `seq_linter()`'s lint message is clearer about the reason for linting. (#522, @michaelchirico) * New `missing_package_linter()` (#536, #547, @renkun-ken) * New `namespace_linter()` (#548, #551, @renkun-ken) @@ -95,6 +94,8 @@ function calls. (#850, #851, @renkun-ken) + `expect_true_false_linter()` Require usage of `expect_true(x)` over `expect_equal(x, TRUE)` and similar * `expect_length_linter()` Require usage of `expect_length(x, n)` over `expect_equal(length(x), n)` and similar * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico) +* `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico) +* `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico) # lintr 2.0.1 diff --git a/R/assignment_spaces_linter.R b/R/assignment_spaces_linter.R deleted file mode 100644 index 4c90f0530..000000000 --- a/R/assignment_spaces_linter.R +++ /dev/null @@ -1,38 +0,0 @@ -#' Assignment spaces linter -#' -#' Check that assignments only have one space before and after. -#' -#' @evalRd rd_tags("assignment_spaces_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -assignment_spaces_linter <- function() { - Linter(function(source_file) { - lapply( - c( - ids_with_token(source_file, "LEFT_ASSIGN"), - ids_with_token(source_file, "EQ_ASSIGN") - ), - function(id) { - parsed <- with_id(source_file, id) - match <- re_matches( - substr( - x = source_file$lines[parsed$line1], - start = parsed$col1 - 2, - stop = parsed$col1 + nchar(parsed$text) + 1 - ), - rex(at_least(space, 2)) - ) - if (match) { - Lint( - filename = source_file$filename, - line_number = parsed$line1, - column_number = parsed$col1, - type = "style", - message = "Assignments should only have one space before and after the operator.", - line = source_file$lines[parsed$line1] - ) - } - } - ) - }) -} diff --git a/R/infix_spaces_linter.R b/R/infix_spaces_linter.R index 446b4f66a..a13d8e31b 100644 --- a/R/infix_spaces_linter.R +++ b/R/infix_spaces_linter.R @@ -1,43 +1,81 @@ -# names: xml tags; values: getParseData tokens -# these can be used as unary operators; treat separately -unary_infix_tokens <- c( - "OP-PLUS" = "'+'", # + : unary plus - "OP-MINUS" = "'-'", # - : unary minus +# some metadata about infix operators on the R parse tree. +# xml_tag gives the XML tag as returned by xmlparsedata::xml_parse_data(). +# r_string gives the operator as you would write it in R code. +# NB: this metadata is used elsewhere in lintr, e.g. spaces_left_parentheses_linter. +# because of that, even though some rows of this table are currently unused, but +# we keep them around because it's useful to keep this info in one place. +infix_metadata <- data.frame(stringsAsFactors = FALSE, matrix(byrow = TRUE, ncol = 2L, c( + "OP-PLUS", "+", + "OP-MINUS", "-", + "OP-TILDE", "~", + "GT", ">", + "GE", ">=", + "LT", "<", + "LE", "<=", + "EQ", "==", + "NE", "!=", + "AND", "&", + "OR", "|", + "AND2", "&&", + "OR2", "||", + "LEFT_ASSIGN", "<-", # also includes := and <<- + "RIGHT_ASSIGN", "->", # also includes ->> + "EQ_ASSIGN", "=", + "EQ_SUB", "=", # in calls: foo(x = 1) + "EQ_FORMALS", "=", # in definitions: function(x = 1) + "SPECIAL", "%%", + "OP-SLASH", "/", + "OP-STAR", "*", + "OP-COMMA", ",", + "OP-CARET", "^", # also includes ** + "OP-AT", "@", + "OP-EXCLAMATION", "!", + "OP-COLON", ":", + "NS_GET", "::", + "NS_GET_INT", ":::", + "OP-LEFT-BRACE", "{", + "OP-LEFT-BRACKET", "[", + "LBB", "[[", + "OP-LEFT-PAREN", "(", + "OP-QUESTION", "?", NULL +))) +names(infix_metadata) <- c("xml_tag", "string_value") +# utils::getParseData()'s designation for the tokens wouldn't be valid as XML tags +infix_metadata$parse_tag <- ifelse( + startsWith(infix_metadata$xml_tag, "OP-"), + # NB: sQuote(x, "'") doesn't work on older R versions + paste0("'", infix_metadata$string_value, "'"), + infix_metadata$xml_tag ) -binary_infix_tokens <- c( - - "GT" = "GT", # > : greater than - "GE" = "GE", # <= : greater than or equal to - "LT" = "LT", # < : less than - "LE" = "LE", # <= : less than or equal to - "EQ" = "EQ", # == : vector equality - "NE" = "NE", # != : not equal - "AND" = "AND", # & : vector boolean and - "OR" = "OR", # | : vector boolean or - "AND2" = "AND2", # && : scalar boolean and - "OR2" = "OR2", # || : scalar boolean or - "LEFT_ASSIGN" = "LEFT_ASSIGN", # <- or := : left assignment - "RIGHT_ASSIGN" = "RIGHT_ASSIGN", # -> : right assignment - "EQ_ASSIGN" = "EQ_ASSIGN", # = : equal assignment - "EQ_SUB" = "EQ_SUB", # = : keyword assignment - "SPECIAL" = "SPECIAL", # %[^%]*% : infix operators - "OP-SLASH" = "'/'", # / : unary division - "OP-STAR" = "'*'", # * : unary multiplication - - NULL +# treated separately because spacing rules are different for unary operators +infix_metadata$unary <- infix_metadata$xml_tag %in% c("OP-PLUS", "OP-MINUS", "OP-TILDE") +# high-precedence operators are ignored by this linter; see +# https://style.tidyverse.org/syntax.html#infix-operators +infix_metadata$low_precedence <- infix_metadata$string_value %in% c( + "+", "-", "~", ">", ">=", "<", "<=", "==", "!=", "&", "&&", "|", "||", "<-", "->", "=", "%%", "/", "*" ) -infix_tokens <- c(unary_infix_tokens, binary_infix_tokens) #' Infix spaces linter #' -#' Check that infix operators are surrounded by spaces. +#' Check that infix operators are surrounded by spaces. Enforces the corresponding Tidyverse style guide rule; +#' see . #' +#' @param exclude_operators Character vector of operators to exlude from consideration for linting. +#' Default is to include the following "low-precedence" operators: +#' `+`, `-`, `~`, `>`, `>=`, `<`, `<=`, `==`, `!=`, `&`, `&&`, `|`, `||`, `<-`, `:=`, `<<-`, `->`, `->>`, +#' `=`, `/`, `*`, and any infix operator (exclude infixes by passing `"%%"`). Note that `<-`, `:=`, and `<<-` +#' are included/excluded as a group (indicated by passing `"<-"`), as are `->` and `->>` (_viz_, `"->"`), +#' and that `=` for assignment and for setting arguments in calls are treated the same. #' @evalRd rd_tags("infix_spaces_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export -infix_spaces_linter <- function() { +infix_spaces_linter <- function(exclude_operators = NULL) { Linter(function(source_file) { + infix_tokens <- infix_metadata[ + infix_metadata$low_precedence & !infix_metadata$string_value %in% exclude_operators, + "parse_tag" + ] lapply( ids_with_token(source_file, infix_tokens, fun = `%in%`), function(id) { diff --git a/R/methods.R b/R/methods.R index 834eaf55c..9abf8c441 100644 --- a/R/methods.R +++ b/R/methods.R @@ -129,7 +129,7 @@ names.lints <- function(x, ...) { } #' @export -split.lints <- function(x, f=NULL, ...) { +split.lints <- function(x, f = NULL, ...) { if (is.null(f)) f <- names(x) splt <- split.default(x, f) for (i in names(splt)) class(splt[[i]]) <- "lints" diff --git a/R/path_linters.R b/R/path_linters.R index df28f53c1..915766bc2 100644 --- a/R/path_linters.R +++ b/R/path_linters.R @@ -59,7 +59,7 @@ is_path <- function(path) { re_matches(path, path_regex) } -is_valid_path <- function(path, lax=FALSE) { +is_valid_path <- function(path, lax = FALSE) { # Given a character vector of paths, return FALSE for directory or file having valid characters. # On Windows, invalid chars are all control chars and: * ? " < > | : # On Unix, all characters are valid, except when lax=TRUE (use same invalid chars as Windows). @@ -91,7 +91,7 @@ is_long_path <- function(path) { ) } -is_valid_long_path <- function(path, lax=FALSE) { +is_valid_long_path <- function(path, lax = FALSE) { # Convenience function to avoid linting short paths and those unlikely to be valid paths ret <- is_valid_path(path, lax) if (lax) { @@ -101,7 +101,7 @@ is_valid_long_path <- function(path, lax=FALSE) { } -split_path <- function(path, sep="/|\\\\") { +split_path <- function(path, sep = "/|\\\\") { if (!is.character(path)) { stop("argument 'path' should be a character vector") } diff --git a/R/spaces_left_parentheses_linter.R b/R/spaces_left_parentheses_linter.R index 7c74241bd..d45aae700 100644 --- a/R/spaces_left_parentheses_linter.R +++ b/R/spaces_left_parentheses_linter.R @@ -29,9 +29,12 @@ spaces_left_parentheses_linter <- function() { for_cond <- "@start - 1 = parent::forcond/preceding-sibling::FOR/@end" # see infix_spaces_linter.R; preceding-sibling::* is needed for unary operators where '-(a)' is ok - unary_nodes <- c(names(unary_infix_tokens), "OP-TILDE") + unary_nodes <- infix_metadata[infix_metadata$unary, "xml_tag"] unary_selves <- paste0("self::", unary_nodes, "[preceding-sibling::*]", collapse = " or ") - binary_nodes <- c(names(binary_infix_tokens), "EQ_FORMALS", "OP-COMMA", "OP-LEFT-BRACE", "ELSE", "IN") + binary_nodes <- c( + infix_metadata[infix_metadata$low_precedence & !infix_metadata$unary, "xml_tag"], + "OP-COMMA", "OP-LEFT-BRACE", "ELSE", "IN" + ) binary_selves <- paste0("self::", binary_nodes, collapse = " or ") # preceding-symbol::* catches (1) function definitions and (2) function calls # ancestor::expr needed for nested RHS expressions, e.g. 'y1<-(abs(yn)>90)*1' diff --git a/R/utils.R b/R/utils.R index 66f749da4..8f79087ea 100644 --- a/R/utils.R +++ b/R/utils.R @@ -163,7 +163,7 @@ viapply <- function(x, ...) vapply(x, ..., FUN.VALUE = integer(1)) # imitate sQuote(x, q) [requires R>=3.6] quote_wrap <- function(x, q) paste0(q, x, q) -unquote <- function(str, q="`") { +unquote <- function(str, q = "`") { # Remove surrounding quotes (select either single, double or backtick) from given character vector # and unescape special characters. str <- re_substitutes(str, rex(start, q, capture(anything), q, end), "\\1") @@ -185,7 +185,7 @@ escape_chars <- c( #"\\`" --> "`" # ASCII grave accent (backtick) ) -unescape <- function(str, q="`") { +unescape <- function(str, q = "`") { names(q) <- paste0("\\", q) my_escape_chars <- c(escape_chars, q) res <- gregexpr(text = str, pattern = rex(or(names(my_escape_chars)))) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 3b3f574fd..44410f9a3 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -1,7 +1,6 @@ linter,tags absolute_path_linter,robustness best_practices configurable assignment_linter,style consistency default -assignment_spaces_linter,style readability backport_linter,robustness configurable package_development closed_curly_linter,style readability default configurable commas_linter,style readability default diff --git a/man/assignment_spaces_linter.Rd b/man/assignment_spaces_linter.Rd deleted file mode 100644 index 6a0077274..000000000 --- a/man/assignment_spaces_linter.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/assignment_spaces_linter.R -\name{assignment_spaces_linter} -\alias{assignment_spaces_linter} -\title{Assignment spaces linter} -\usage{ -assignment_spaces_linter() -} -\description{ -Check that assignments only have one space before and after. -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=readability_linters]{readability}, \link[=style_linters]{style} -} diff --git a/man/infix_spaces_linter.Rd b/man/infix_spaces_linter.Rd index 3766abd0e..50381b529 100644 --- a/man/infix_spaces_linter.Rd +++ b/man/infix_spaces_linter.Rd @@ -4,10 +4,19 @@ \alias{infix_spaces_linter} \title{Infix spaces linter} \usage{ -infix_spaces_linter() +infix_spaces_linter(exclude_operators = NULL) +} +\arguments{ +\item{exclude_operators}{Character vector of operators to exlude from consideration for linting. +Default is to include the following "low-precedence" operators: +\code{+}, \code{-}, \code{~}, \code{>}, \code{>=}, \code{<}, \code{<=}, \code{==}, \code{!=}, \code{&}, \code{&&}, \code{|}, \code{||}, \verb{<-}, \verb{:=}, \verb{<<-}, \verb{->}, \verb{->>}, +\code{=}, \code{/}, \code{*}, and any infix operator (exclude infixes by passing \code{"\%\%"}). Note that \verb{<-}, \verb{:=}, and \verb{<<-} +are included/excluded as a group (indicated by passing \code{"<-"}), as are \verb{->} and \verb{->>} (\emph{viz}, \code{"->"}), +and that \code{=} for assignment and for setting arguments in calls are treated the same.} } \description{ -Check that infix operators are surrounded by spaces. +Check that infix operators are surrounded by spaces. Enforces the corresponding Tidyverse style guide rule; +see \url{https://style.tidyverse.org/syntax.html#infix-operators}. } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/man/linters.Rd b/man/linters.Rd index 02ddc4cf6..bbce28306 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -25,9 +25,9 @@ The following tags exist: \item{\link[=default_linters]{default} (25 linters)} \item{\link[=efficiency_linters]{efficiency} (4 linters)} \item{\link[=package_development_linters]{package_development} (9 linters)} -\item{\link[=readability_linters]{readability} (24 linters)} +\item{\link[=readability_linters]{readability} (23 linters)} \item{\link[=robustness_linters]{robustness} (10 linters)} -\item{\link[=style_linters]{style} (32 linters)} +\item{\link[=style_linters]{style} (31 linters)} } } \section{Linters}{ @@ -35,7 +35,6 @@ The following linters exist: \itemize{ \item{\code{\link{absolute_path_linter}} (tags: best_practices, configurable, robustness)} \item{\code{\link{assignment_linter}} (tags: consistency, default, style)} -\item{\code{\link{assignment_spaces_linter}} (tags: readability, style)} \item{\code{\link{backport_linter}} (tags: configurable, package_development, robustness)} \item{\code{\link{closed_curly_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{commas_linter}} (tags: default, readability, style)} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index d49702b3f..a9e39045a 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -12,7 +12,6 @@ Linters highlighting readability issues, such as missing whitespace. \section{Linters}{ The following linters are tagged with 'readability': \itemize{ -\item{\code{\link{assignment_spaces_linter}}} \item{\code{\link{closed_curly_linter}}} \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 2a94debf2..9f87e36a7 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -13,7 +13,6 @@ Linters highlighting code style issues. The following linters are tagged with 'style': \itemize{ \item{\code{\link{assignment_linter}}} -\item{\code{\link{assignment_spaces_linter}}} \item{\code{\link{closed_curly_linter}}} \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} diff --git a/tests/testthat/test-assignment_spaces_linter.R b/tests/testthat/test-assignment_spaces_linter.R deleted file mode 100644 index 1022dc631..000000000 --- a/tests/testthat/test-assignment_spaces_linter.R +++ /dev/null @@ -1,54 +0,0 @@ -test_that("returns the correct linting", { - linter <- assignment_spaces_linter() - msg <- rex("Assignments should only have one space before and after the operator.") - - expect_lint("fun(blah = 1)", NULL, linter) - - expect_lint("blah <- 1", NULL, linter) - expect_lint("blah = 1", NULL, linter) - - expect_lint("blah <-1", NULL, linter) - expect_lint("blah =1", NULL, linter) - - expect_lint("blah<- 1", NULL, linter) - expect_lint("blah= 1", NULL, linter) - - expect_lint("blah<-1", NULL, linter) - expect_lint("blah=1", NULL, linter) - - expect_lint("\"my = variable\" <- 42.0", NULL, linter) - - expect_lint("if (0 < 1) x <- 42L", NULL, linter) - expect_lint( - "if (0 < 1) { - x <- 42L - }", - NULL, - linter - ) - expect_lint( - "my = bad = variable = name <- 2.0", - NULL, - linter - ) - - expect_lint("blah<- 1", msg, linter) - expect_lint("blah <-1", msg, linter) - expect_lint("blah <- 1", msg, linter) - expect_lint("blah <- 1", msg, linter) - expect_lint("blah <- 1", msg, linter) - expect_lint("blah= 1", msg, linter) - expect_lint("blah =1", msg, linter) - expect_lint("blah = 1", msg, linter) - expect_lint("blah = 1", msg, linter) - expect_lint("blah = 1", msg, linter) - expect_lint("my = bad = variable = name <- 2.0", msg, linter) - expect_lint( - "my = bad = variable = name <- 2.0", - list( - msg, - msg - ), - linter - ) -}) diff --git a/tests/testthat/test-infix_spaces_linter.R b/tests/testthat/test-infix_spaces_linter.R index 414b3967b..fffdd9bb7 100644 --- a/tests/testthat/test-infix_spaces_linter.R +++ b/tests/testthat/test-infix_spaces_linter.R @@ -2,15 +2,19 @@ test_that("returns the correct linting", { ops <- c( "+", "-", + "~", "=", "==", "!=", "<=", ">=", "<-", + ":=", + "<<-", "<", ">", "->", + "->>", "%%", "/", "*", @@ -25,7 +29,7 @@ test_that("returns the correct linting", { ) linter <- infix_spaces_linter() - msg <- rex("Put spaces around all infix operators.") + msg <- rex::rex("Put spaces around all infix operators.") expect_lint("blah", NULL, linter) @@ -52,3 +56,64 @@ test_that("returns the correct linting", { expect_lint("fun(a=1)", msg, linter) }) + +test_that("The three `=` are all linted", { + linter <- infix_spaces_linter() + msg <- rex::rex("Put spaces around all infix operators.") + + # EQ_ASSIGN in the parse data + expect_lint("a=1", msg, linter) + # EQ_FORMALS in the parse data + expect_lint("foo <- function(x=1) {}", msg, linter) + # EQ_SUB in the parse data + expect_lint("foo(x=1)", msg, linter) +}) + +test_that("exclude_operators works", { + expect_lint("a+b", NULL, infix_spaces_linter(exclude_operators = "+")) + expect_lint( + trim_some(" + a+b + a-b + "), + NULL, + infix_spaces_linter(exclude_operators = c("+", "-")) + ) + + # grouped operators + expect_lint("a<<-1", NULL, infix_spaces_linter(exclude_operators = "<-")) + expect_lint("a:=1", NULL, infix_spaces_linter(exclude_operators = "<-")) + expect_lint("a->>1", NULL, infix_spaces_linter(exclude_operators = "->")) + expect_lint("a%any%1", NULL, infix_spaces_linter(exclude_operators = "%%")) + expect_lint("function(a=1) { }", NULL, infix_spaces_linter(exclude_operators = "=")) + expect_lint("foo(a=1)", NULL, infix_spaces_linter(exclude_operators = "=")) +}) + +# more tests specifically for assignment +test_that("assignment cases return the correct linting", { + linter <- infix_spaces_linter() + msg <- rex::rex("Put spaces around all infix operators.") + + expect_lint("fun(blah = 1)", NULL, linter) + + expect_lint("blah <- 1", NULL, linter) + expect_lint("blah = 1", NULL, linter) + + expect_lint("\"my = variable\" <- 42.0", NULL, linter) + + expect_lint("if (0 < 1) x <- 42L", NULL, linter) + expect_lint( + trim_some(" + if (0 < 1) { + x <- 42L + }"), + NULL, + linter + ) + expect_lint("my = bad = variable = name <- 2.0", NULL, linter) + + expect_lint("blah<- 1", msg, linter) + expect_lint("blah <-1", msg, linter) + expect_lint("blah= 1", msg, linter) + expect_lint("blah =1", msg, linter) +})