diff --git a/NEWS.md b/NEWS.md index 8a67ba433..39bf97355 100644 --- a/NEWS.md +++ b/NEWS.md @@ -50,6 +50,7 @@ * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico). * `sprintf_linter()` lints `sprintf()` and `gettextf()` calls when a constant string is passed to `fmt` (#2894, @Bisaloo). * `use_lintr()` adds the created `.lintr` file to the `.Rbuildignore` if run in a package (#2926, initial work by @MEO265, finalized by @Bisaloo). +* `sort_linter()` recommends usage of `!is.unsorted(x)` over `identical(x, sort(x))` (#2921, @Bisaloo). * `length_test_linter()` is extended to check incorrect usage of `nrow()`, `ncol()`, `NROW()`, `NCOL()` (#2933, @mcol). * `implicit_assignment_linter()` gains argument `allow_paren_print` to disable lints for the use of `(` for auto-printing (#2962, @TimTaylor). diff --git a/R/sort_linter.R b/R/sort_linter.R index aa66ece89..abff5d8de 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -89,7 +89,13 @@ sort_linter <- function() { and expr/expr = expr ] " - + sorted_identical_xpath <- " + parent::expr[not(SYMBOL_SUB)] + /parent::expr[ + expr/SYMBOL_FUNCTION_CALL[text() = 'identical'] + and expr/expr = expr + ] + " arguments_xpath <- ".//SYMBOL_SUB[text() = 'method' or text() = 'decreasing' or text() = 'na.last']" @@ -142,8 +148,22 @@ sort_linter <- function() { "Use is.unsorted(x) to test the unsortedness of a vector." ) + sorted_identical_expr <- xml_find_all(xml_calls, sorted_identical_xpath) + is_negated <- !is.na( + xml_find_first(sorted_identical_expr, "preceding-sibling::*[not(self::COMMENT)][1][self::OP-EXCLAMATION]") + ) + + lint_message <- c( + lint_message, + ifelse( + is_negated, + "Use is.unsorted(x) to test the unsortedness of a vector.", + "Use !is.unsorted(x) to test the sortedness of a vector." + ) + ) + sorted_lints <- xml_nodes_to_lints( - sorted_expr, + combine_nodesets(sorted_expr, sorted_identical_expr), source_expression = source_expression, lint_message = lint_message, type = "warning" diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 15d8ab209..d9536c599 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -1,17 +1,21 @@ test_that("sort_linter skips allowed usages", { linter <- sort_linter() - expect_lint("order(y)", NULL, linter) + expect_no_lint("order(y)", linter) - expect_lint("y[order(x)]", NULL, linter) + expect_no_lint("y[order(x)]", linter) # If another function is intercalated, don't fail - expect_lint("x[c(order(x))]", NULL, linter) + expect_no_lint("x[c(order(x))]", linter) - expect_lint("x[order(y, x)]", NULL, linter) - expect_lint("x[order(x, y)]", NULL, linter) + expect_no_lint("x[order(y, x)]", linter) + expect_no_lint("x[order(x, y)]", linter) # pretty sure this never makes sense, but test anyway - expect_lint("x[order(y, na.last = x)]", NULL, linter) + expect_no_lint("x[order(y, na.last = x)]", linter) + + # is.unsorted false positives + expect_no_lint("identical(sort(x), y)", linter) + expect_no_lint("identical(sort(foo(x)), x)", linter) }) @@ -108,15 +112,20 @@ test_that("sort_linter blocks simple disallowed usages", { sorted_msg <- rex::rex("Use !is.unsorted(x) to test the sortedness of a vector.") expect_lint("sort(x) == x", sorted_msg, linter) + expect_lint("identical(x, sort(x))", sorted_msg, linter) # argument order doesn't matter expect_lint("x == sort(x)", sorted_msg, linter) + expect_lint("identical(sort(x), x)", sorted_msg, linter) # inverted version expect_lint("sort(x) != x", unsorted_msg, linter) + expect_lint("!identical(x, sort(x))", unsorted_msg, linter) # expression matching expect_lint("sort(foo(x)) == foo(x)", sorted_msg, linter) + expect_lint("identical(foo(x), sort(foo(x)))", sorted_msg, linter) + expect_lint("identical(sort(foo(x)), foo(x))", sorted_msg, linter) }) test_that("lints vectorize", {