From f7cc976e6e9a8164776c4cb3d35ba8f578603796 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 30 Oct 2020 02:36:39 +0000 Subject: [PATCH 01/10] extend and improve equals_na_linter --- NEWS.md | 1 + R/equals_na_lintr.R | 52 ++++++++++---------------- tests/testthat/test-equals_na_linter.R | 10 ++++- 3 files changed, 29 insertions(+), 34 deletions(-) diff --git a/NEWS.md b/NEWS.md index e98f59120..8a1b1fad1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,7 @@ * 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) +* `equals_na_linter()` now lints `x != NA` and `NA == x`, and skips usages in comments (#545, @michaelchirico) # lintr 2.0.1 diff --git a/R/equals_na_lintr.R b/R/equals_na_lintr.R index 0e716ad3f..851874b1f 100644 --- a/R/equals_na_lintr.R +++ b/R/equals_na_lintr.R @@ -1,38 +1,24 @@ #' @describeIn linters that checks for x == NA #' @export equals_na_linter <- function(source_file) { - all_matches <- re_matches( - source_file$lines, - rex("==", zero_or_more(" "), "NA"), - locations = TRUE, - global = TRUE - ) - line_numbers <- as.integer(names(source_file$lines)) - Map( - function(line_matches, line_number) { - lapply( - split(line_matches, seq_len(nrow(line_matches))), - function(match) { - start <- match[["start"]] - if (is.na(start)) { - return() - } - end <- match[["end"]] - Lint( - filename = source_file$filename, - line_number = line_number, - column_number = start, - type = "warning", - message = "Use is.na rather than == NA.", - line = source_file$lines[[as.character(line_number)]], - ranges = list(c(start, end)), - linter = "equals_na_linter" - ) - } - ) - }, - all_matches, - line_numbers - ) + if (!length(source_file$parsed_content)) return(list()) + + xml <- source_file$xml_parsed_content + + comparators <- c("EQ", "NE") + comparator_table <- paste0("self::", comparators, collapse = " or ") + NA_values <- c("NA", "NA_integer_", "NA_real_", "NA_complex_", "NA_character_") + NA_table <- paste("text() =", sQuote(NA_values, "'"), collapse = " or ") + + xpath_fmt <- "//expr[expr[NUM_CONST[%s]]]/*[%s]" + xpath <- sprintf(xpath_fmt, NA_table, comparator_table) + + #browser() + + bad_expr <- xml2::xml_find_all(xml, xpath) + + lapply(bad_expr, xml_nodes_to_lint, source_file, + message = "Use is.na for comparisons to NA (not == or !=)", + linter = "equals_na_linter", type = "warning") } diff --git a/tests/testthat/test-equals_na_linter.R b/tests/testthat/test-equals_na_linter.R index 7e42d0fc3..4a8aaf949 100644 --- a/tests/testthat/test-equals_na_linter.R +++ b/tests/testthat/test-equals_na_linter.R @@ -1,7 +1,7 @@ context("equals_na_linter") test_that("returns the correct linting", { - msg <- rex("Use is.na rather than == NA.") + msg <- rex("Use is.na for comparisons to NA") expect_lint("blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) @@ -18,4 +18,12 @@ test_that("returns the correct linting", { equals_na_linter ) + # fixed: #545 + expect_lint("# x == NA", NULL, equals_na_linter) + + # also works for != NA + expect_lint("x != NA", msg, equals_na_linter) + + # also works for reversed version + expect_lint("NA == x", msg, equals_na_linter) }) From d5f8d5ced0eb82997ce93bf453b3a8b6adb317d3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 30 Oct 2020 02:39:59 +0000 Subject: [PATCH 02/10] remove debugging tag --- R/equals_na_lintr.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/equals_na_lintr.R b/R/equals_na_lintr.R index 851874b1f..0c8b2f245 100644 --- a/R/equals_na_lintr.R +++ b/R/equals_na_lintr.R @@ -14,8 +14,6 @@ equals_na_linter <- function(source_file) { xpath_fmt <- "//expr[expr[NUM_CONST[%s]]]/*[%s]" xpath <- sprintf(xpath_fmt, NA_table, comparator_table) - #browser() - bad_expr <- xml2::xml_find_all(xml, xpath) lapply(bad_expr, xml_nodes_to_lint, source_file, From 2c614b0cd143e62c16d101a74372d5bd492527b9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 30 Oct 2020 02:44:29 +0000 Subject: [PATCH 03/10] note addition of != to man as well --- R/equals_na_lintr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/equals_na_lintr.R b/R/equals_na_lintr.R index 0c8b2f245..6da8ee325 100644 --- a/R/equals_na_lintr.R +++ b/R/equals_na_lintr.R @@ -1,4 +1,4 @@ -#' @describeIn linters that checks for x == NA +#' @describeIn linters that checks for x == NA and x != NA #' @export equals_na_linter <- function(source_file) { From d3da392057c3cc51b5edceec2c5451c4974d1878 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 30 Oct 2020 02:50:48 +0000 Subject: [PATCH 04/10] document() --- man/linters.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/linters.Rd b/man/linters.Rd index ed3632b40..b76e8f6ba 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -179,7 +179,7 @@ blocks \item \code{camel_case_linter}: check that objects are not in camelCase. -\item \code{equals_na_linter}: that checks for x == NA +\item \code{equals_na_linter}: that checks for x == NA and x != NA \item \code{extraction_operator_linter}: Check that the `[[` operator is used when extracting a single element from an object, not `[` (subsetting) nor `$` (interactive use). From 5e1af20fc3a5b1f699605e2ba24dbba56beb02d1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 27 Nov 2020 20:16:16 +0000 Subject: [PATCH 05/10] add missing function --- R/utils.R | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/R/utils.R b/R/utils.R index 39bd4fd88..97a5d270f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -210,3 +210,27 @@ unescape <- function(str, q="`") { ) str } + +# convert an XML match into a Lint +xml_nodes_to_lint <- function(xml, source_file, message, linter, + type = c("style", "warning", "error")) { + type <- match.arg(type, c("style", "warning", "error")) + line1 <- xml2::xml_attr(xml, "line1")[1] + col1 <- as.integer(xml2::xml_attr(xml, "col1")) + + if (xml2::xml_attr(xml, "line2") == line1) { + col2 <- as.integer(xml2::xml_attr(xml, "col2")) + } else { + col2 <- nchar(source_file$lines[line1]) + } + return(Lint( + filename = source_file$filename, + line_number = as.integer(line1), + column_number = as.integer(col1), + type = type, + message = message, + line = source_file$lines[line1], + ranges = list(c(col1, col2)), + linter = linter + )) +} From ff7c995c21b56f690ec2d254208cf42510bb3117 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 28 Nov 2020 17:01:53 -0500 Subject: [PATCH 06/10] skip empty xml --- R/equals_na_lintr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/equals_na_lintr.R b/R/equals_na_lintr.R index 6da8ee325..68ad9eedf 100644 --- a/R/equals_na_lintr.R +++ b/R/equals_na_lintr.R @@ -2,7 +2,7 @@ #' @export equals_na_linter <- function(source_file) { - if (!length(source_file$parsed_content)) return(list()) + if (is.null(source_file$xml_parsed_content)) return(list()) xml <- source_file$xml_parsed_content From 651dbefc78b294d2b2065767fb8b29f57fcba709 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 28 Nov 2020 19:15:53 -0500 Subject: [PATCH 07/10] backwards compatible --- R/equals_na_lintr.R | 2 +- R/utils.R | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/equals_na_lintr.R b/R/equals_na_lintr.R index 68ad9eedf..36199db4e 100644 --- a/R/equals_na_lintr.R +++ b/R/equals_na_lintr.R @@ -9,7 +9,7 @@ equals_na_linter <- function(source_file) { comparators <- c("EQ", "NE") comparator_table <- paste0("self::", comparators, collapse = " or ") NA_values <- c("NA", "NA_integer_", "NA_real_", "NA_complex_", "NA_character_") - NA_table <- paste("text() =", sQuote(NA_values, "'"), collapse = " or ") + NA_table <- paste("text() =", quote_wrap(NA_values, "'"), collapse = " or ") xpath_fmt <- "//expr[expr[NUM_CONST[%s]]]/*[%s]" xpath <- sprintf(xpath_fmt, NA_table, comparator_table) diff --git a/R/utils.R b/R/utils.R index d298b26c6..51c159ba4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -169,6 +169,9 @@ try_silently <- function(expr) { viapply <- function(x, ...) vapply(x, ..., FUN.VALUE = integer(1)) vcapply <- function(x, ...) vapply(x, ..., FUN.VALUE = character(1)) +# imitate sQuote(x, q) [requires R>=3.6] +quote_wrap <- function(x, q) sprintf("%1$s%2$s%1$s", q, x, q) + unquote <- function(str, q="`") { # Remove surrounding quotes (select either single, double or backtick) from given character vector # and unescape special characters. From 6d5b81ebcdc386986ab459ce47859019157ff9d7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 28 Nov 2020 22:39:06 -0500 Subject: [PATCH 08/10] steal tests from #546 --- tests/testthat/test-equals_na_linter.R | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-equals_na_linter.R b/tests/testthat/test-equals_na_linter.R index 4a8aaf949..b2fcfc715 100644 --- a/tests/testthat/test-equals_na_linter.R +++ b/tests/testthat/test-equals_na_linter.R @@ -1,7 +1,7 @@ context("equals_na_linter") test_that("returns the correct linting", { - msg <- rex("Use is.na for comparisons to NA") + msg <- rex("Use is.na rather than == NA.") expect_lint("blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) @@ -18,12 +18,21 @@ test_that("returns the correct linting", { equals_na_linter ) - # fixed: #545 - expect_lint("# x == NA", NULL, equals_na_linter) - - # also works for != NA - expect_lint("x != NA", msg, equals_na_linter) + expect_lint( + "x==f(1, ignore = NA)", + NULL, + equals_na_linter + ) - # also works for reversed version - expect_lint("NA == x", msg, equals_na_linter) + # equals_na_linter should ignore strings and comments + expect_lint( + "is.na(x) # dont flag x == NA if inside a comment", + NULL, + equals_na_linter + ) + expect_lint( + "msg <- 'dont flag x == NA if inside a string'", + NULL, + equals_na_linter + ) }) From f54cd2b1b68d498beb58f1842c58b34820ae3585 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 28 Nov 2020 23:03:54 -0500 Subject: [PATCH 09/10] re-fix tests --- tests/testthat/test-equals_na_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-equals_na_linter.R b/tests/testthat/test-equals_na_linter.R index b2fcfc715..75d018440 100644 --- a/tests/testthat/test-equals_na_linter.R +++ b/tests/testthat/test-equals_na_linter.R @@ -1,7 +1,7 @@ context("equals_na_linter") test_that("returns the correct linting", { - msg <- rex("Use is.na rather than == NA.") + msg <- rex("Use is.na for comparisons to NA (not == or !=)") expect_lint("blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) expect_lint(" blah", NULL, equals_na_linter) From 45f585f61b3f9aed16d1b107e792b19ac4787443 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 29 Nov 2020 13:01:44 -0500 Subject: [PATCH 10/10] simpler quote_wrap --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 51c159ba4..8f1888154 100644 --- a/R/utils.R +++ b/R/utils.R @@ -170,7 +170,7 @@ viapply <- function(x, ...) vapply(x, ..., FUN.VALUE = integer(1)) vcapply <- function(x, ...) vapply(x, ..., FUN.VALUE = character(1)) # imitate sQuote(x, q) [requires R>=3.6] -quote_wrap <- function(x, q) sprintf("%1$s%2$s%1$s", q, x, q) +quote_wrap <- function(x, q) paste0(q, x, q) unquote <- function(str, q="`") { # Remove surrounding quotes (select either single, double or backtick) from given character vector