Complete switch away from //expr XPaths

R/class_equals_linter.R

@@ -11,9 +11,12 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 class_equals_linter <- function() {
-  xpath <- "//expr[
+  xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'class']
+  /parent::expr
+  /parent::expr
+  /parent::expr[
     not(preceding-sibling::OP-LEFT-BRACKET)
-    and expr[expr[1][SYMBOL_FUNCTION_CALL[text() = 'class']]]
     and (EQ or NE or SPECIAL[text() = '%in%'])
   ]"
 

R/expect_identical_linter.R

@@ -25,34 +25,33 @@
 #' @export
 expect_identical_linter <- function() {
   # outline:
-  #   1. conditions for expect_equal()
-  #     - skip when any named argument is set. most commonly this
-  #       is check.attributes (for 2e tests) or one of the ignore_*
-  #       arguments (for 3e tests). This will generate some false
-  #       negatives, but will be much easier to maintain.
-  #     - skip cases like expect_equal(x, 1.02) or the constant vector version
-  #       where a numeric constant indicates inexact testing is preferable
-  #     - skip calls using dots (`...`); see tests
-  #   2. conditions for expect_true()
-  xpath <- glue::glue("//expr[
-    (
-      SYMBOL_FUNCTION_CALL[text() = 'expect_equal']
-      and not(
-        following-sibling::EQ_SUB
-        or following-sibling::expr[
-          expr[1][SYMBOL_FUNCTION_CALL[text() = 'c']]
-          and expr[NUM_CONST[contains(text(), '.')]]
-        ]
-        or following-sibling::expr[NUM_CONST[contains(text(), '.')]]
-        or following-sibling::expr[SYMBOL[text() = '...']]
-      )
-    ) or (
-      SYMBOL_FUNCTION_CALL[text() = 'expect_true']
-      and following-sibling::expr[1][
-        expr[1][SYMBOL_FUNCTION_CALL[text() = 'identical']]
-      ]
-    )
-  ]")
+  #   - skip when any named argument is set. most commonly this
+  #     is check.attributes (for 2e tests) or one of the ignore_*
+  #     arguments (for 3e tests). This will generate some false
+  #     negatives, but will be much easier to maintain.
+  #   - skip cases like expect_equal(x, 1.02) or the constant vector version
+  #     where a numeric constant indicates inexact testing is preferable
+  #   - skip calls using dots (`...`); see tests
+  expect_equal_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_equal']
+  /parent::expr[not(
+    following-sibling::EQ_SUB
+    or following-sibling::expr[
+      expr[1][SYMBOL_FUNCTION_CALL[text() = 'c']]
+      and expr[NUM_CONST[contains(text(), '.')]]
+    ]
+    or following-sibling::expr[NUM_CONST[contains(text(), '.')]]
+    or following-sibling::expr[SYMBOL[text() = '...']]
+  )]
+  /parent::expr
+  "
+  expect_true_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_true']
+  /parent::expr
+  /following-sibling::expr[1][expr[1]/SYMBOL_FUNCTION_CALL[text() = 'identical']]
+  /parent::expr
+  "
+  xpath <- paste(expect_equal_xpath, "|", expect_true_xpath)
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {

R/expect_named_linter.R

@@ -8,13 +8,15 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 expect_named_linter <- function() {
-  xpath <- "//expr[
-    SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
-    and following-sibling::expr[
-      expr[1][SYMBOL_FUNCTION_CALL[text() = 'names']]
-      and (position() = 1 or preceding-sibling::expr[STR_CONST])
-    ]
-  ]"
+  xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
+  /parent::expr
+  /following-sibling::expr[
+    expr[1][SYMBOL_FUNCTION_CALL[text() = 'names']]
+    and (position() = 1 or preceding-sibling::expr[STR_CONST])
+  ]
+  /parent::expr
+  "
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
@@ -24,7 +26,7 @@ expect_named_linter <- function() {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml2::xml_find_all(xml, xpath)
-    matched_function <- xp_call_name(bad_expr, depth = 0L)
+    matched_function <- xp_call_name(bad_expr)
     lint_message <- sprintf("expect_named(x, n) is better than %s(names(x), n)", matched_function)
 
     xml_nodes_to_lints(bad_expr, source_expression = source_expression, lint_message, type = "warning")

R/expect_not_linter.R

@@ -10,10 +10,12 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 expect_not_linter <- function() {
-  xpath <- "//expr[
-    expr[1][SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']]
-    and expr[2][OP-EXCLAMATION]
-  ]"
+  xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']
+  /parent::expr
+  /following-sibling::expr[OP-EXCLAMATION]
+  /parent::expr
+  "
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {

R/expect_null_linter.R

@@ -15,15 +15,19 @@ expect_null_linter <- function() {
   # two cases two match:
   #  (1) expect_{equal,identical}(x, NULL) (or NULL, x)
   #  (2) expect_true(is.null(x))
-  xpath <- "//expr[
-    (
-      SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
-      and following-sibling::expr[position() <= 2 and NULL_CONST]
-    ) or (
-      SYMBOL_FUNCTION_CALL[text() = 'expect_true']
-      and following-sibling::expr[1][expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.null']]]
-    )
-  ]"
+  expect_equal_identical_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
+  /parent::expr
+  /following-sibling::expr[position() <= 2 and NULL_CONST]
+  /parent::expr
+  "
+  expect_true_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_true']
+  /parent::expr
+  /following-sibling::expr[1][expr[1]/SYMBOL_FUNCTION_CALL[text() = 'is.null']]
+  /parent::expr
+  "
+  xpath <- paste(expect_equal_identical_xpath, "|", expect_true_xpath)
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {
@@ -34,7 +38,7 @@ expect_null_linter <- function() {
 
     bad_expr <- xml2::xml_find_all(xml, xpath)
 
-    matched_function <- xp_call_name(bad_expr, depth = 0L)
+    matched_function <- xp_call_name(bad_expr)
     msg <- ifelse(
       matched_function %in% c("expect_equal", "expect_identical"),
       sprintf("expect_null(x) is better than %s(x, NULL)", matched_function),

R/expect_true_false_linter.R

@@ -9,10 +9,12 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 expect_true_false_linter <- function() {
-  xpath <- "//expr[expr[1][
-    SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
-    and following-sibling::expr[position() <= 2 and NUM_CONST[text() = 'TRUE' or text() = 'FALSE']]
-  ]]"
+  xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
+  /parent::expr
+  /following-sibling::expr[position() <= 2 and NUM_CONST[text() = 'TRUE' or text() = 'FALSE']]
+  /parent::expr
+  "
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {

R/redundant_ifelse_linter.R

@@ -12,15 +12,19 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 redundant_ifelse_linter <- function(allow10 = FALSE) {
-  tf_xpath <- glue::glue("//expr[
-    expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]
-    and expr[NUM_CONST[text() = 'TRUE']]
+  tf_xpath <- glue::glue("
+  //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]
+  /parent::expr
+  /parent::expr[
+    expr[NUM_CONST[text() = 'TRUE']]
     and expr[NUM_CONST[text() = 'FALSE']]
   ]")
 
-  num_xpath <- glue::glue("//expr[
-    expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]
-    and expr[NUM_CONST[text() = '1' or text() = '1L']]
+  num_xpath <- glue::glue("
+  //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]
+  /parent::expr
+  /parent::expr[
+    expr[NUM_CONST[text() = '1' or text() = '1L']]
     and expr[NUM_CONST[text() = '0' or text() = '0L']]
   ]")
 

R/regex_subset_linter.R

@@ -23,31 +23,25 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 regex_subset_linter <- function() {
-  parent_expr_cond <- xp_and(
-    "OP-LEFT-BRACKET",
-    # parent::expr for LEFT_ASSIGN and RIGHT_ASSIGN, but, strangely,
-    #   parent::equal_assign for EQ_ASSIGN. So just use * as a catchall.
-    "not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN])"
-  )
+  # parent::expr for LEFT_ASSIGN and RIGHT_ASSIGN, but, strangely,
+  #   parent::equal_assign for EQ_ASSIGN. So just use * as a catchall.
   # See https://www.w3.org/TR/1999/REC-xpath-19991116/#booleans;
   #   equality of nodes is based on the string value of the nodes, which
   #   is basically what we need, i.e., whatever expression comes in
   #   <expr>[grepl(pattern, <expr>)] matches exactly, e.g. names(x)[grepl(ptn, names(x))].
-  subset_cond_fmt <- xp_and(
-    "expr[1][SYMBOL_FUNCTION_CALL[%s]]",
-    "expr[position() = %d] = parent::expr/expr[1]"
-  )
-  grep_xpath <- sprintf(
-    "//expr[%s]/expr[%s]",
-    parent_expr_cond,
-    sprintf(subset_cond_fmt, xp_text_in_table(c("grep", "grepl")), 3L)
-  )
-
-  stringr_xpath <- sprintf(
-    "//expr[%s]/expr[%s]",
-    parent_expr_cond,
-    sprintf(subset_cond_fmt, xp_text_in_table(c("str_detect", "str_which")), 2L)
-  )
+  xpath_fmt <- "
+  //SYMBOL_FUNCTION_CALL[ {xp_text_in_table(calls)} ]
+  /parent::expr
+  /parent::expr[
+    parent::expr[
+      OP-LEFT-BRACKET
+      and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN])
+    ]
+    and expr[position() = {arg_pos} ] = parent::expr/expr[1]
+  ]
+  "
+  grep_xpath <- glue::glue(xpath_fmt, calls = c("grepl", "grep"), arg_pos = 3L)
+  stringr_xpath <- glue::glue(xpath_fmt, calls = c("str_detect", "str_which"), arg_pos = 2L)
 
   Linter(function(source_expression) {
     if (!is_lint_level(source_expression, "expression")) {

R/unused_import_linter.R

@@ -10,17 +10,16 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 unused_import_linter <- function(allow_ns_usage = FALSE, except_packages = c("bit64", "data.table", "tidyverse")) {
-  import_xpath <- "//expr[
-      expr[1][SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']]
-      and
-      (
-        not(SYMBOL_SUB[
-          text() = 'character.only' and
-          following-sibling::expr[1][NUM_CONST[text() = 'TRUE'] or SYMBOL[text() = 'T']]
-        ]) or
-        expr[2][STR_CONST]
-      )
-    ]"
+  import_xpath <- "
+  //SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']
+  /parent::expr
+  /parent::expr[
+    expr[2][STR_CONST]
+    or not(SYMBOL_SUB[
+      text() = 'character.only' and
+      following-sibling::expr[1][NUM_CONST[text() = 'TRUE'] or SYMBOL[text() = 'T']]
+    ])
+  ]"
 
   xp_used_symbols <- paste(
     "//SYMBOL_FUNCTION_CALL[not(preceding-sibling::NS_GET)]/text()",