Lint identical(x, sort(x)) in sort_linter() (#2921)

* Add tests for is.unsorted() recommendation on identical()

* Add new XPath components for identical()

* Split XPaths for idential() and ==

* Add NEWS item

* Use expect_no_lint() for false positives

* Add false positive tests for is.unsorted

* Add one expression matching test

* Work around comments

---------

Co-authored-by: Michael Chirico <chiricom@google.com>

Author: Bisaloo

NEWS.md

@@ -47,6 +47,12 @@
    + `unreachable_code_linter()` #2827
    + `vector_logic_linter()` #2826
 
+## New and improved features
+
+### Linter improvements
+
+* `sort_linter()` recommends usage of `!is.unsorted(x)` over `identical(x, sort(x))` (#2921, @Bisaloo).
+
 ## Notes
 
 * {lintr} now requires R 4.1.0

R/sort_linter.R

@@ -82,12 +82,17 @@ sort_linter <- function() {
   ")
 
   sorted_xpath <- "
-  self::*[
+  expr[
     (EQ or NE)
     and expr/expr = expr
     and not(expr/EQ_SUB)
   ]"
-
+  sorted_identical_xpath <- "
+  expr[
+    expr/SYMBOL_FUNCTION_CALL[text() = 'identical']
+    and expr/expr = expr
+  ]
+  "
 
   arguments_xpath <-
     ".//SYMBOL_SUB[text() = 'method' or text() = 'decreasing' or text() = 'na.last']"
@@ -132,7 +137,7 @@ sort_linter <- function() {
       type = "warning"
     )
 
-    sort_calls <- xml_parent(xml_parent(source_expression$xml_find_function_calls("sort")))
+    sort_calls <- xml_parent(xml_parent(xml_parent(source_expression$xml_find_function_calls("sort"))))
     sort_calls <- strip_comments_from_subtree(sort_calls)
     sorted_expr <- xml_find_all(sort_calls, sorted_xpath)
 
@@ -143,8 +148,22 @@ sort_linter <- function() {
       "Use is.unsorted(x) to test the unsortedness of a vector."
     )
 
+    sorted_identical_expr <- xml_find_all(sort_calls, sorted_identical_xpath)
+    is_negated <- !is.na(
+      xml_find_first(sorted_identical_expr, "preceding-sibling::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"

tests/testthat/test-sort_linter.R

@@ -12,6 +12,10 @@ test_that("sort_linter skips allowed usages", {
   expect_no_lint("x[order(x, y)]", linter)
   # pretty sure this never makes sense, but test anyway
   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)
 })
 
 
@@ -134,15 +138,21 @@ test_that("sort_linter blocks simple disallowed usages for is.sorted cases", {
   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)
+
   expect_lint(
     trim_some("
       sort(foo(x # comment