From 134cade4b44eb05a1b0f3fbf1b5de829b16da516 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 3 Oct 2022 21:45:53 +0000 Subject: [PATCH 1/2] Complete switch away from //expr XPaths --- R/class_equals_linter.R | 7 +++-- R/expect_identical_linter.R | 55 ++++++++++++++++++------------------ R/expect_named_linter.R | 18 ++++++------ R/expect_not_linter.R | 10 ++++--- R/expect_null_linter.R | 24 +++++++++------- R/expect_true_false_linter.R | 10 ++++--- R/redundant_ifelse_linter.R | 16 +++++++---- R/regex_subset_linter.R | 36 ++++++++++------------- R/unused_import_linter.R | 21 +++++++------- 9 files changed, 103 insertions(+), 94 deletions(-) diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R index 76ea15a22b..6aaa8aff8e 100644 --- a/R/class_equals_linter.R +++ b/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%']) ]" diff --git a/R/expect_identical_linter.R b/R/expect_identical_linter.R index 8a09612f28..e3bb5071bd 100644 --- a/R/expect_identical_linter.R +++ b/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")) { diff --git a/R/expect_named_linter.R b/R/expect_named_linter.R index ae7675a92f..322a6d21a3 100644 --- a/R/expect_named_linter.R +++ b/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") diff --git a/R/expect_not_linter.R b/R/expect_not_linter.R index e20744f651..e891d3e350 100644 --- a/R/expect_not_linter.R +++ b/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")) { diff --git a/R/expect_null_linter.R b/R/expect_null_linter.R index 46f781b334..825f79e36d 100644 --- a/R/expect_null_linter.R +++ b/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), diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R index 2a32cb2586..34c2cb853f 100644 --- a/R/expect_true_false_linter.R +++ b/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")) { diff --git a/R/redundant_ifelse_linter.R b/R/redundant_ifelse_linter.R index 73a3b41ecc..55e854042a 100644 --- a/R/redundant_ifelse_linter.R +++ b/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']] ]") diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index 925950401c..03a7ace3ff 100644 --- a/R/regex_subset_linter.R +++ b/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 # [grepl(pattern, )] 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 = 3) + stringr_xpath <- glue::glue(xpath_fmt, calls = c("str_detect", "str_which"), arg_pos = 2) Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { diff --git a/R/unused_import_linter.R b/R/unused_import_linter.R index 6cd296fca1..bed64e14f9 100644 --- a/R/unused_import_linter.R +++ b/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()", From ae751566f5500829efce93507be8e9f73217999a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 3 Oct 2022 21:56:54 +0000 Subject: [PATCH 2/2] explicit integers, i guess --- R/regex_subset_linter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index 03a7ace3ff..4786c78b52 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -40,8 +40,8 @@ regex_subset_linter <- function() { and expr[position() = {arg_pos} ] = parent::expr/expr[1] ] " - grep_xpath <- glue::glue(xpath_fmt, calls = c("grepl", "grep"), arg_pos = 3) - stringr_xpath <- glue::glue(xpath_fmt, calls = c("str_detect", "str_which"), arg_pos = 2) + 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")) {