From 075c4ddbe471d14cb33582b7c1bdbf0ecda13855 Mon Sep 17 00:00:00 2001 From: chiricom Date: Sun, 8 Nov 2026 16:48:30 +0000 Subject: [PATCH 1/3] Apply xpath-skill findings --- R/class_index.R | 9 ++++----- R/completion.R | 23 +++++++++++------------ R/definition.R | 8 +++----- R/folding.R | 10 ++++------ R/highlight.R | 9 ++++++--- R/hover.R | 22 +++++++++------------- R/inlay_hint.R | 46 ++++++++++++++++++++-------------------------- R/inline_value.R | 6 ++---- R/refactor.R | 28 +++++++++++++++++----------- R/references.R | 13 ++++++------- R/section.R | 17 +++++++++-------- R/selection.R | 2 +- R/semantic.R | 22 ++++------------------ R/signature.R | 5 +---- R/type_hierarchy.R | 33 ++++++++++++++------------------- R/utils.R | 16 ++++++++-------- 16 files changed, 119 insertions(+), 150 deletions(-) diff --git a/R/class_index.R b/R/class_index.R index 46236e03..2b859efe 100644 --- a/R/class_index.R +++ b/R/class_index.R @@ -47,9 +47,8 @@ class_xml_arguments <- function(node) { if (native || isTRUE(magrittr)) { lhs <- class_xml_first(operator, "preceding-sibling::expr[1]") placeholder <- vapply(arguments, function(argument) { - leaf <- class_xml_first(argument, if (native) "self::expr[count(*) = 1]/PLACEHOLDER" else - "self::expr[count(*) = 1]/SYMBOL[text() = '.']") - length(leaf) > 0L + isTRUE(xml_find_lgl(argument, if (native) "boolean(PLACEHOLDER[parent::expr[count(*) = 1]])" else + "boolean(SYMBOL[text() = '.' and parent::expr[count(*) = 1]])")) }, logical(1L)) if (any(placeholder)) arguments[placeholder] <- list(lhs) else arguments <- c(list(lhs), arguments) @@ -88,7 +87,7 @@ class_xml_index <- function(xdoc) { } for (fun in functions) { calls <- class_xml_all(xdoc, paste0("//SYMBOL_FUNCTION_CALL[text() = '", fun, - "']/ancestor::expr[.//OP-LEFT-PAREN][1]")) + "']/ancestor::expr[OP-LEFT-PAREN][1]")) names <- parents <- vector("list", length(calls)) for (i in seq_along(calls)) { call <- calls[[i]] @@ -134,7 +133,7 @@ class_xml_calls <- function(xdoc, fun, name = NULL, parent = FALSE) { index <- attr(xdoc, "class_index", exact = TRUE)[[fun]] if (is.null(index)) { return(class_xml_all(xdoc, paste0("//SYMBOL_FUNCTION_CALL[text() = '", fun, - "']/ancestor::expr[.//OP-LEFT-PAREN][1]"))) + "']/ancestor::expr[OP-LEFT-PAREN][1]"))) } if (is.null(name)) return(index$calls) rows <- get0(name, envir = if (parent) index$parents else index$names, diff --git a/R/completion.R b/R/completion.R index 6fa5aee5..9842dc8d 100644 --- a/R/completion.R +++ b/R/completion.R @@ -734,17 +734,15 @@ workspace_completion <- function(workspace, token, } scope_completion_symbols_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[self::FUNCTION or self::OP-LAMBDA]/following-sibling::SYMBOL_FORMALS", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/LEFT_ASSIGN[not(following-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[not(preceding-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA])]/following-sibling::expr[count(*)=1]/SYMBOL", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/EQ_ASSIGN[not(following-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(FUNCTION | OP-LAMBDA)/following-sibling::SYMBOL_FORMALS", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/(LEFT_ASSIGN | EQ_ASSIGN)[not(following-sibling::expr[FUNCTION or OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[not(preceding-sibling::expr[FUNCTION or OP-LAMBDA])]/following-sibling::expr[count(*)=1]/SYMBOL", "forcond/SYMBOL", sep = "|") scope_completion_functs_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/LEFT_ASSIGN[following-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[preceding-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA]]/following-sibling::expr[count(*)=1]/SYMBOL", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/EQ_ASSIGN[following-sibling::expr/*[self::FUNCTION or self::OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/(LEFT_ASSIGN | EQ_ASSIGN)[following-sibling::expr[FUNCTION or OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[preceding-sibling::expr[FUNCTION or OP-LAMBDA]]/following-sibling::expr[count(*)=1]/SYMBOL", sep = "|") #' Complete bindings supplied by the enclosing execution context @@ -1088,9 +1086,8 @@ token_completion <- function(uri, workspace, token, exclude = NULL, limit = Inf) symbols <- xml_text(xml_find_all( xdoc, glue( - "//*[ - (self::SYMBOL[preceding-sibling::OP-DOLLAR] or self::SYMBOL_SUB) and - starts-with(text(),'{token_quote}')]", + "//SYMBOL[preceding-sibling::OP-DOLLAR and starts-with(text(),'{token_quote}')] | + //SYMBOL_SUB[starts-with(text(),'{token_quote}')]", token_quote = token_quote ) )) @@ -1099,8 +1096,10 @@ token_completion <- function(uri, workspace, token, exclude = NULL, limit = Inf) symbols <- c(symbols, xml_text(xml_find_all( xdoc, glue( - "//*[(self::SYMBOL or self::SYMBOL_SUB or self::SYMBOL_FORMALS or self::SYMBOL_FUNCTION_CALL) and - starts-with(text(),'{token_quote}')]", + "//SYMBOL[starts-with(text(),'{token_quote}')] | + //SYMBOL_SUB[starts-with(text(),'{token_quote}')] | + //SYMBOL_FORMALS[starts-with(text(),'{token_quote}')] | + //SYMBOL_FUNCTION_CALL[starts-with(text(),'{token_quote}')]", token_quote = token_quote ) ))) diff --git a/R/definition.R b/R/definition.R index ef84647a..58f03895 100644 --- a/R/definition.R +++ b/R/definition.R @@ -1,8 +1,7 @@ definition_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[self::FUNCTION or self::OP-LAMBDA]/following-sibling::SYMBOL_FORMALS[text() = '{token_quote}' and @line1 <= {row}]", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[LEFT_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", + "(FUNCTION | OP-LAMBDA)/following-sibling::SYMBOL_FORMALS[text() = '{token_quote}' and @line1 <= {row}]", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[(LEFT_ASSIGN | EQ_ASSIGN)[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[RIGHT_ASSIGN[following-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and preceding-sibling::expr[@start > {start} or @end < {end}]]]", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[EQ_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", "forcond/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]", sep = "|") @@ -73,8 +72,7 @@ definition_reply <- function(id, uri, workspace, document, point, logger$info("definition: ", token_name, token_text) if (token_name %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL", "SYMBOL_FORMALS")) { # symbol - preceding_dollar <- xml_find_first(token, "preceding-sibling::OP-DOLLAR") - if (length(preceding_dollar) == 0) { + if (xml_find_lgl(token, "not(preceding-sibling::OP-DOLLAR)")) { xpath <- glue(definition_xpath, row = row, start = token_start, end = token_end, token_quote = xml_single_quote(token_text)) diff --git a/R/folding.R b/R/folding.R index c05d862b..2b050047 100644 --- a/R/folding.R +++ b/R/folding.R @@ -80,15 +80,13 @@ get_document_blocks <- function(xdoc, outline = NULL) { if (is.null(xdoc)) { return(NULL) } - blocks <- xml_find_all(xdoc, "//expr[@line1 < @line2 and - (OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE)/@line1 < - (OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE)/@line1]") - if (!length(blocks)) { # prevent floating point comparision + block_start <- xml_find_all(xdoc, "(//OP-LEFT-PAREN | //OP-LEFT-BRACKET | //OP-LEFT-BRACE)[parent::expr and + @line1 < (following-sibling::OP-RIGHT-PAREN | following-sibling::OP-RIGHT-BRACKET | following-sibling::OP-RIGHT-BRACE)/@line1]") + if (!length(block_start)) { # prevent floating point comparision return(NULL) } - block_start <- xml_find_first(blocks, "OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE") - block_end <- xml_find_first(blocks, "OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE") + block_end <- xml_find_first(block_start, "following-sibling::OP-RIGHT-PAREN | following-sibling::OP-RIGHT-BRACKET | following-sibling::OP-RIGHT-BRACE") block_start_line <- as.integer(xml_attr(block_start, "line1")) block_end_line <- as.integer(xml_attr(block_end, "line1")) diff --git a/R/highlight.R b/R/highlight.R index 28ae7c07..3962da7f 100644 --- a/R/highlight.R +++ b/R/highlight.R @@ -4,7 +4,11 @@ DocumentHighlightKind <- list( Write = 3 ) -document_highlight_xpath <- "//*[(self::SYMBOL or self::SYMBOL_FUNCTION_CALL or self::SYMBOL_FORMALS) and not(preceding-sibling::OP-DOLLAR) and text() = '{token_quote}']" +document_highlight_xpath <- paste( + "//SYMBOL[not(preceding-sibling::OP-DOLLAR) and text() = '{token_quote}']", + "//SYMBOL_FUNCTION_CALL[not(preceding-sibling::OP-DOLLAR) and text() = '{token_quote}']", + "//SYMBOL_FORMALS[not(preceding-sibling::OP-DOLLAR) and text() = '{token_quote}']", + sep = " | ") #' The response to a textDocument/documentHighlight Request #' @@ -87,8 +91,7 @@ document_highlight_reply <- function(id, uri, workspace, document, point) { tokens <- NULL if (token_name %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL", "SYMBOL_FORMALS")) { - preceding_dollar <- xml_find_first(token, "preceding-sibling::OP-DOLLAR") - if (length(preceding_dollar) == 0) { + if (xml_find_lgl(token, "not(preceding-sibling::OP-DOLLAR)")) { xpath <- glue(document_highlight_xpath, token_quote = token_quote) tokens <- xml_find_all(xdoc, xpath) } diff --git a/R/hover.R b/R/hover.R index e01ebaf2..367c3790 100644 --- a/R/hover.R +++ b/R/hover.R @@ -1,8 +1,7 @@ hover_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[self::FUNCTION or self::OP-LAMBDA][following-sibling::SYMBOL_FORMALS[text() = '{token_quote}' and @line1 <= {row}]]/parent::expr", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[LEFT_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", + "(FUNCTION | OP-LAMBDA)[following-sibling::SYMBOL_FORMALS[text() = '{token_quote}' and @line1 <= {row}]]/parent::expr", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[(LEFT_ASSIGN | EQ_ASSIGN)[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[RIGHT_ASSIGN[following-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and preceding-sibling::expr[@start > {start} or @end < {end}]]]", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[EQ_ASSIGN[preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}] and following-sibling::expr[@start > {start} or @end < {end}]]]", "forcond/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]", sep = "|") @@ -106,8 +105,7 @@ hover_reply <- function(id, uri, workspace, document, point) { logger$info(token_name, token_text) if (token_name %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL")) { # symbol - preceding_dollar <- xml_find_first(token, "preceding-sibling::OP-DOLLAR") - if (length(preceding_dollar) == 0) { + if (xml_find_lgl(token, "not(preceding-sibling::OP-DOLLAR)")) { xpath <- glue(hover_xpath, row = row, start = token_start, end = token_end, token_quote = xml_single_quote(token_text)) @@ -115,7 +113,7 @@ hover_reply <- function(id, uri, workspace, document, point) { if (length(all_defs)) { last_def <- all_defs[[length(all_defs)]] def_func <- xml_find_first(last_def, - "self::*[LEFT_ASSIGN | RIGHT_ASSIGN | EQ_ASSIGN]/expr[FUNCTION | OP-LAMBDA]") + "expr[(FUNCTION or OP-LAMBDA) and parent::*[LEFT_ASSIGN or RIGHT_ASSIGN or EQ_ASSIGN]]") if (length(def_func)) { func_line1 <- as.integer(xml_attr(def_func, "line1")) def_text <- local_function_signature(document, def_func, token_text) @@ -149,12 +147,10 @@ hover_reply <- function(id, uri, workspace, document, point) { } } else if (token_name == "SYMBOL_SUB") { # function parameter - funct <- xml_text(xml_find_first(token, - "preceding-sibling::expr/SYMBOL_FUNCTION_CALL/text()")) - if (!is.na(funct)) { - package <- xml_text(xml_find_first(token, - "preceding-sibling::expr/SYMBOL_PACKAGE/text()")) - if (is.na(package)) { + funct <- xml_find_chr(token, "string(preceding-sibling::expr/SYMBOL_FUNCTION_CALL)") + if (nzchar(funct)) { + package <- xml_find_chr(token, "string(preceding-sibling::expr/SYMBOL_PACKAGE)") + if (!nzchar(package)) { package <- NULL xpath <- glue(signature_xpath, row = row, token_quote = xml_single_quote(funct)) @@ -191,7 +187,7 @@ hover_reply <- function(id, uri, workspace, document, point) { } } else if (token_name == "SYMBOL_FORMALS") { # function formals - funct <- xml_find_first(token, "preceding-sibling::*[self::FUNCTION or self::OP-LAMBDA]/parent::expr") + funct <- xml_find_first(token, "parent::expr[FUNCTION or OP-LAMBDA]") func_line1 <- as.integer(xml_attr(funct, "line1")) doc_line1 <- detect_comments(document$content, func_line1 - 1) + 1 diff --git a/R/inlay_hint.R b/R/inlay_hint.R index c005ef16..0390fff4 100644 --- a/R/inlay_hint.R +++ b/R/inlay_hint.R @@ -47,13 +47,12 @@ call_has_implicit_argument <- function(call_node) { operator <- xml_find_first(call_node, "preceding-sibling::*[not(self::COMMENT)][1]") if (inherits(operator, "xml_missing")) return(FALSE) if (xml_name(operator) %in% c("PIPE", "OP-PIPE")) { - placeholder <- xml_find_first(call_node, "expr[count(*) = 1]/PLACEHOLDER") - } else if (xml_name(operator) == "SPECIAL" && xml_text(operator) %in% c("%>%", "%<>%", "%T>%")) { - placeholder <- xml_find_first(call_node, "expr[count(*) = 1]/SYMBOL[text() = '.']") - } else { - return(FALSE) + return(xml_find_lgl(call_node, "not(expr[count(*) = 1]/PLACEHOLDER)")) + } + if (xml_name(operator) == "SPECIAL" && xml_text(operator) %in% c("%>%", "%<>%", "%T>%")) { + return(xml_find_lgl(call_node, "not(expr[count(*) = 1]/SYMBOL[text() = '.'])")) } - inherits(placeholder, "xml_missing") + FALSE } #' Match an R named argument using exact and unique partial matching @@ -218,17 +217,19 @@ inlay_hint_reply <- function(id, uri, workspace, document, request_range) { if (request_range$end$character == 0L && end_line > start_line) { end_line <- end_line - 1L } - calls <- xml_find_all( + fn_nodes <- xml_find_all( xdoc, paste0( - "//expr[@line2 >= ", start_line, - " and @line1 <= ", end_line, - " and expr[1][following-sibling::*[not(self::COMMENT)][1]", - "[self::OP-LEFT-PAREN]] and ", - "expr[1]/SYMBOL_FUNCTION_CALL]" + "//SYMBOL_FUNCTION_CALL[parent::expr[", + "not(preceding-sibling::expr or ./OP-DOLLAR or ./OP-AT)", + " and following-sibling::*[not(self::COMMENT)][1][self::OP-LEFT-PAREN]", + " and parent::expr[@line2 >= ", start_line, " and @line1 <= ", end_line, "]]]" ) ) - if (!length(calls)) return(Response$new(id, result = list())) + if (!length(fn_nodes)) return(Response$new(id, result = list())) + calls <- xml_parent(xml_parent(fn_nodes)) + function_names <- xml_text(fn_nodes) + packages <- xml_find_chr(fn_nodes, "string(preceding-sibling::SYMBOL_PACKAGE[1])") minimum_arguments <- lsp_settings$get("inlay_hints_minimum_arguments") if (!is.numeric(minimum_arguments) || length(minimum_arguments) != 1L || @@ -246,20 +247,13 @@ inlay_hint_reply <- function(id, uri, workspace, document, request_range) { formals_cache <- new.env(parent = emptyenv()) hints <- list() - for (call_node in calls) { - callee <- xml_find_first(call_node, "expr[1]") - member_operator <- xml_find_first( - callee, - "./*[self::OP-DOLLAR or self::OP-AT]" - ) - if (!inherits(member_operator, "xml_missing")) next - - function_node <- xml_find_first(callee, "./SYMBOL_FUNCTION_CALL[1]") - if (inherits(function_node, "xml_missing")) next + for (i in seq_along(calls)) { + call_node <- calls[[i]] + function_name <- function_names[[i]] + if (!nzchar(function_name)) next - function_name <- xml_text(function_node) - package_node <- xml_find_first(callee, "./SYMBOL_PACKAGE[1]") - package <- if (inherits(package_node, "xml_missing")) NULL else xml_text(package_node) + package <- packages[[i]] + if (!nzchar(package)) package <- NULL cache_key <- paste(if (is.null(package)) "" else package, function_name, sep = "::") if (exists(cache_key, envir = formals_cache, inherits = FALSE)) { function_formals <- get(cache_key, envir = formals_cache, inherits = FALSE) diff --git a/R/inline_value.R b/R/inline_value.R index 6944c033..60d84d8b 100644 --- a/R/inline_value.R +++ b/R/inline_value.R @@ -50,12 +50,10 @@ inline_value_reply <- function(id, uri, workspace, document, request_range) { if (request_range$end$character == 0L && end_line > start_line) { end_line <- end_line - 1L } + line_cond <- paste0("@line1 >= ", start_line, " and @line1 <= ", end_line) nodes <- xml_find_all( xdoc, - paste0( - "//*[(self::SYMBOL or self::SYMBOL_FORMALS) and ", - "@line1 >= ", start_line, " and @line1 <= ", end_line, "]" - ) + paste0("//SYMBOL[", line_cond, "] | //SYMBOL_FORMALS[", line_cond, "]") ) if (!length(nodes)) return(Response$new(id, result = list())) diff --git a/R/refactor.R b/R/refactor.R index 39669cea..02e0950a 100644 --- a/R/refactor.R +++ b/R/refactor.R @@ -133,7 +133,7 @@ refactor_sequence_container <- function(node) { name <- xml_name(node) identical(name, "exprlist") || identical(name, "expr") && - length(xml_find_all(node, "OP-LEFT-BRACE")) > 0L + xml_find_lgl(node, "boolean(OP-LEFT-BRACE)") } #' Find the statement and sequential container enclosing an expression @@ -193,11 +193,11 @@ refactor_expression_movable <- function(node, statement) { pipe <- pipes[[1L]] if (refactor_same_node(node, current) || xml_text(children[[pipe]]) == "%$%") return(FALSE) placeholder <- if (child_names[[pipe]] == "SPECIAL") { - ".//*[self::PLACEHOLDER or (self::SYMBOL or self::SYMBOL_FUNCTION_CALL) and (text() = '.' or text() = '`.`')]" + "boolean(.//PLACEHOLDER | .//SYMBOL[text() = '.' or text() = '`.`'] | .//SYMBOL_FUNCTION_CALL[text() = '.' or text() = '`.`'])" } else { - ".//PLACEHOLDER" + "boolean(.//PLACEHOLDER)" } - if (length(xml_find_all(node, placeholder))) return(FALSE) + if (xml_find_lgl(node, placeholder)) return(FALSE) } assignments <- which(child_names %in% c( @@ -248,7 +248,7 @@ refactor_exact_expression <- function(xdoc, selected_range) { #' Find contiguous statement expressions matching a selected range #' @noRd refactor_statement_selection <- function(xdoc, selected_range) { - containers <- xml_find_all(xdoc, "/exprlist | //expr[OP-LEFT-BRACE]") + containers <- xml_find_all(xdoc, "/exprlist | //OP-LEFT-BRACE/parent::expr") result <- NULL for (container in containers) { children <- xml_children(container) @@ -346,7 +346,7 @@ refactor_unsafe_syntax <- function(node, extracting_function = FALSE) { token_names <- refactor_token_names(node) token_text <- xml_text(xml_find_all( node, - ".//*[self::LEFT_ASSIGN or self::RIGHT_ASSIGN]" + ".//LEFT_ASSIGN | .//RIGHT_ASSIGN" )) calls <- refactor_call_names(node) unsafe_calls <- c( @@ -516,8 +516,14 @@ refactor_multiline_quoted_ranges <- function(context) { ) })) } - quoted <- xml_find_all(context$xdoc, - "//*[@line1 < @line2 and (self::STR_CONST or starts-with(name(), 'SYMBOL'))]") + quoted <- xml_find_all(context$xdoc, paste( + "//STR_CONST[@line1 < @line2]", + "//SYMBOL[@line1 < @line2]", + "//SYMBOL_FUNCTION_CALL[@line1 < @line2]", + "//SYMBOL_FORMALS[@line1 < @line2]", + "//SYMBOL_SUB[@line1 < @line2]", + "//SYMBOL_PACKAGE[@line1 < @line2]", + sep = " | ")) lapply(quoted, refactor_node_range) } @@ -841,10 +847,10 @@ refactor_extract_function_action <- function(uri, workspace, document, return(NULL) } uses_dots <- vapply(selection$nodes, function(node) { - "..." %in% xml_text(xml_find_all( + xml_find_lgl( node, - ".//*[self::SYMBOL or self::SYMBOL_FORMALS]" - )) + "boolean(.//SYMBOL[text() = '...'] | .//SYMBOL_FORMALS[text() = '...'])" + ) }, logical(1L)) if (any(uses_dots)) { return(NULL) diff --git a/R/references.R b/R/references.R index e3987814..503a419a 100644 --- a/R/references.R +++ b/R/references.R @@ -1,4 +1,4 @@ -references_xpath <- "//*[(self::SYMBOL or self::SYMBOL_FUNCTION_CALL or self::SYMBOL_FORMALS) and text() = '{token_quote}']" +references_xpath <- "//SYMBOL[text() = '{token_quote}'] | //SYMBOL_FUNCTION_CALL[text() = '{token_quote}'] | //SYMBOL_FORMALS[text() = '{token_quote}']" #' Decode quoted symbol spellings without evaluating document code #' @noRd @@ -349,12 +349,11 @@ references_reply <- function(id, uri, workspace, document, point, idx <- 0L for (i in seq_along(symbols)) { if (!isTRUE(include_declaration)) { - declaration <- xml_find_all(symbols[[i]], paste( - "self::SYMBOL_FORMALS", - "self::SYMBOL[parent::forcond]", - "self::SYMBOL[parent::expr[count(*)=1][following-sibling::LEFT_ASSIGN or following-sibling::EQ_ASSIGN or preceding-sibling::RIGHT_ASSIGN]]", - sep = " | ")) - if (length(declaration)) next + is_declaration <- xml_name(symbols[[i]]) == "SYMBOL_FORMALS" || ( + xml_name(symbols[[i]]) == "SYMBOL" && xml_find_lgl(symbols[[i]], + "boolean(parent::forcond or parent::expr[count(*)=1 and (following-sibling::LEFT_ASSIGN or following-sibling::EQ_ASSIGN or preceding-sibling::RIGHT_ASSIGN)])") + ) + if (is_declaration) next } symbol_point <- list(row = line1[[i]] - 1, col = col1[[i]]) symbol_defn <- definition_reply( diff --git a/R/section.R b/R/section.R index cee75fb8..d0b0783c 100644 --- a/R/section.R +++ b/R/section.R @@ -241,19 +241,20 @@ extract_document_block_lines <- function(xdoc) { if (is.null(xdoc)) { return(NULL) } - blocks <- xml_find_all(xdoc, "//expr[@line1 < @line2 and - (OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE)/@line1 < - (OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE)/@line1]") - if (!length(blocks)) { # prevent floating point comparision + block_start <- xml_find_all(xdoc, "(//OP-LEFT-PAREN | //OP-LEFT-BRACKET | //OP-LEFT-BRACE)[parent::expr and + @line1 < (following-sibling::OP-RIGHT-PAREN | following-sibling::OP-RIGHT-BRACKET | following-sibling::OP-RIGHT-BRACE)/@line1]") + if (!length(block_start)) { # prevent floating point comparision return(NULL) } - block_start <- xml_find_first(blocks, "OP-LEFT-PAREN | OP-LEFT-BRACKET | OP-LEFT-BRACE") - block_end <- xml_find_first(blocks, "OP-RIGHT-PAREN | OP-RIGHT-BRACKET | OP-RIGHT-BRACE") + block_end <- xml_find_first(block_start, "following-sibling::OP-RIGHT-PAREN | following-sibling::OP-RIGHT-BRACKET | following-sibling::OP-RIGHT-BRACE") + + block_start_line <- as.integer(xml_attr(block_start, "line1")) + block_end_line <- as.integer(xml_attr(block_end, "line1")) block_lines <- unique(cbind( - as.integer(xml_attr(block_start, "line1")), - as.integer(xml_attr(block_end, "line1")) - 1L + block_start_line, + block_end_line - 1L )) lapply(1:2, function(i) block_lines[, i, drop = TRUE]) } diff --git a/R/selection.R b/R/selection.R index 34b270c4..146d18e5 100644 --- a/R/selection.R +++ b/R/selection.R @@ -37,7 +37,7 @@ selection_range_reply <- function(id, uri, workspace, document, points) { row <- point$row + 1 col <- point$col + 1 token <- xdoc_find_token(xdoc, row, col) - nodes <- xml_find_all(token, "self::*[@line1] | ancestor::*[@line1]") + nodes <- xml_find_all(token, "ancestor-or-self::*[@line1]") ranges <- lapply(nodes, function(token) { range( start = document$to_lsp_position( diff --git a/R/semantic.R b/R/semantic.R index 44d32061..c20cacc0 100644 --- a/R/semantic.R +++ b/R/semantic.R @@ -143,6 +143,7 @@ local_symbol_binding_scopes <- function(data, cand_rows, cand_names, id_parent) ) } +# Exclude member accesses (x$return, x@slot) and namespace-qualified symbols (pkg::return, pkg:::x) xml_not_qualified_symbol_xpath <- " not( preceding-sibling::OP-DOLLAR @@ -444,20 +445,9 @@ function_assignment_symbol_ids <- function(data, syntax = NULL) { .Call("function_assignment_ids_c", data, syntax, PACKAGE = "languageserver") } -# Exclude member accesses (x$return, x@slot) and namespace-qualified symbols (pkg::return, pkg:::x) -xml_not_qualified_symbol_xpath <- " - not( - preceding-sibling::OP-DOLLAR - or preceding-sibling::OP-AT - or preceding-sibling::NS_GET - or preceding-sibling::NS_GET_INT - ) -" - xml_function_assignment_rhs_xpath <- " ( - parent::expr[count(*) = 1]/following-sibling::LEFT_ASSIGN/following-sibling::expr - | parent::expr[count(*) = 1]/following-sibling::EQ_ASSIGN/following-sibling::expr + parent::expr[count(*) = 1 and (following-sibling::LEFT_ASSIGN or following-sibling::EQ_ASSIGN)]/following-sibling::expr | parent::expr[count(*) = 1]/preceding-sibling::RIGHT_ASSIGN/preceding-sibling::expr )[FUNCTION or OP-LAMBDA or (OP-LEFT-PAREN and not(OP-LEFT-PAREN/preceding-sibling::expr))] " @@ -465,7 +455,7 @@ xml_function_assignment_rhs_xpath <- " #' Whether an XML SYMBOL is assigned `function()` or `\()` #' @noRd xml_symbol_is_function_assignment <- function(node) { - if (!xml_find_lgl(node, paste0("boolean(", xml_function_assignment_rhs_xpath, ")"))) { + if (xml_find_lgl(node, paste0("not(", xml_function_assignment_rhs_xpath, ")"))) { return(FALSE) } rhs <- xml_find_first(node, xml_function_assignment_rhs_xpath) @@ -805,11 +795,7 @@ semantic_xml_token_types <- c( `OP-LAMBDA` = SemanticTokenTypes$keyword ) -semantic_tokens_xpath <- paste0( - "//*[", - paste0("self::", names(semantic_xml_token_types), collapse = " or "), - "]" -) +semantic_tokens_xpath <- paste0("//", names(semantic_xml_token_types), collapse = " | ") #' Get semantic token type for an XML token #' diff --git a/R/signature.R b/R/signature.R index 4c4babd2..e2a32cb3 100644 --- a/R/signature.R +++ b/R/signature.R @@ -1,7 +1,4 @@ -signature_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[LEFT_ASSIGN/preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]]/expr[FUNCTION|OP-LAMBDA]", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[EQ_ASSIGN/preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]]/expr[FUNCTION|OP-LAMBDA]", - sep = "|") +signature_xpath <- "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)[(LEFT_ASSIGN | EQ_ASSIGN)/preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}' and @line1 <= {row}]]/expr[FUNCTION or OP-LAMBDA]" #' Format local function arguments without reparsing the function body #' @noRd diff --git a/R/type_hierarchy.R b/R/type_hierarchy.R index 52393f5e..44b416d0 100644 --- a/R/type_hierarchy.R +++ b/R/type_hierarchy.R @@ -156,7 +156,7 @@ detect_type_definition <- function(uri, workspace, document, point, token_text) if (length(r6_expr)) { class_str <- class_xml_name(r6_expr) class_sym <- class_xml_first(r6_expr, - ".//LEFT_ASSIGN/preceding-sibling::expr[1]/SYMBOL | .//EQ_ASSIGN/preceding-sibling::expr[1]/SYMBOL") + "(.//LEFT_ASSIGN | .//EQ_ASSIGN)/preceding-sibling::expr[1]/SYMBOL") class_name_value <- NULL if (length(class_str)) { class_name_value <- class_token_text(xml_text(class_str)) @@ -216,13 +216,10 @@ detect_r6class <- function(scopes, token_text, document, uri) { # Pattern: name <- R6::R6Class(...) xpath <- glue( - "//expr[LEFT_ASSIGN or EQ_ASSIGN][ - preceding-sibling::expr[count(*)=1]/SYMBOL[text() = '{token_quote}'] - ][ - following-sibling::expr[1]//SYMBOL_FUNCTION_CALL[ - text() = 'R6Class' - ] - ]", + "(//LEFT_ASSIGN | //EQ_ASSIGN)[ + preceding-sibling::expr[count(*) = 1]/SYMBOL[text() = '{token_quote}'] + and following-sibling::expr[1]//SYMBOL_FUNCTION_CALL[text() = 'R6Class'] + ]/parent::expr", token_quote = token_quote ) @@ -288,8 +285,9 @@ detect_s3class <- function(scopes, token_text, document, uri) { class_name <- parts[length(parts)] xpath <- glue( - "//expr[LEFT_ASSIGN or EQ_ASSIGN][ - expr[1][count(*)=1]/SYMBOL[text() = '{token_quote}']]", + "(//LEFT_ASSIGN | //EQ_ASSIGN)[ + preceding-sibling::expr[count(*) = 1]/SYMBOL[text() = '{token_quote}'] + ]/parent::expr", token_quote = xml_single_quote(token_text) ) @@ -922,10 +920,8 @@ extract_r6_list_members <- function(document, list_node, access_modifier) { # Find SYMBOL_SUB elements that have EQ_SUB as immediate next sibling # This indicates name = value patterns - all_symbol_subs <- class_xml_all(list_node, paste( - ".//SYMBOL_SUB[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]]", - ".//STR_CONST[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]]", - sep = " | ")) + all_symbol_subs <- class_xml_all(list_node, + ".//EQ_SUB/preceding-sibling::*[not(self::COMMENT)][1][self::SYMBOL_SUB or self::STR_CONST]") # Process all SYMBOL_SUB elements and try to find their values for (symbol_sub in all_symbol_subs) { @@ -980,8 +976,7 @@ extract_r6_list_members <- function(document, list_node, access_modifier) { } # Check if this specific value expression contains a FUNCTION keyword - func_node <- class_xml_first(value_expr, ".//FUNCTION") - is_function <- length(func_node) > 0 + is_function <- xml_find_lgl(value_expr, "boolean(.//FUNCTION)") member_kind <- if (is_function) SymbolKind$Method else SymbolKind$Field member_range <- get_element_range(document, symbol_sub) @@ -1026,7 +1021,7 @@ extract_s4_members <- function(document, xdoc, def) { if (length(slots_node)) { # Find all named slots slot_names <- class_xml_all(slots_node, - ".//SYMBOL_SUB[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]] | .//STR_CONST[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]]") + ".//EQ_SUB/preceding-sibling::*[not(self::COMMENT)][1][self::SYMBOL_SUB or self::STR_CONST]") for (slot_name_node in slot_names) { slot_name_text <- xml_text(slot_name_node) slot_name <- class_token_text(slot_name_text) @@ -1110,7 +1105,7 @@ extract_refclass_members <- function(document, xdoc, def) { if (length(fields_node)) { field_names <- class_xml_all(fields_node, - "./SYMBOL_SUB[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]] | ./STR_CONST[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]]") + "./EQ_SUB/preceding-sibling::*[not(self::COMMENT)][1][self::SYMBOL_SUB or self::STR_CONST]") for (field_name_node in field_names) { field_name <- class_token_text(xml_text(field_name_node)) field_range <- get_element_range(document, field_name_node) @@ -1135,7 +1130,7 @@ extract_refclass_members <- function(document, xdoc, def) { if (length(methods_node)) { method_names <- class_xml_all(methods_node, - "./SYMBOL_SUB[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]] | ./STR_CONST[following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]]") + "./EQ_SUB/preceding-sibling::*[not(self::COMMENT)][1][self::SYMBOL_SUB or self::STR_CONST]") for (method_name_node in method_names) { method_name <- class_token_text(xml_text(method_name_node)) method_range <- get_element_range(document, method_name_node) diff --git a/R/utils.R b/R/utils.R index 9a6ccf73..5d0013f4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -727,13 +727,13 @@ xdoc_top_level_index <- function(x, syntax = NULL, navigation = NULL) { all(token_line2[previous] < token_line1[following] | token_line2[previous] == token_line1[following] & token_col2[previous] < token_col1[following]) - assignment_symbol <- paste( - "(LEFT_ASSIGN | EQ_ASSIGN)/preceding-sibling::expr[count(*)=1]/SYMBOL", - "RIGHT_ASSIGN/following-sibling::expr[count(*)=1]/SYMBOL", + definition_symbols <- xml_find_all(x, paste( + "(//LEFT_ASSIGN | //EQ_ASSIGN)/preceding-sibling::expr[count(*)=1]/SYMBOL", + "//RIGHT_ASSIGN/following-sibling::expr[count(*)=1]/SYMBOL", sep = " | " - ) - definitions <- xml_find_all(x, paste0("//*[", assignment_symbol, "]")) - definition_names <- xml_text(xml_find_first(definitions, assignment_symbol)) + )) + definitions <- xml_parent(xml_parent(definition_symbols)) + definition_names <- xml_text(definition_symbols) list( nodes = nodes, line1 = as.integer(xml_attr(nodes, "line1")), @@ -800,7 +800,7 @@ xdoc_find_enclosing_scopes <- function(x, line, col, top = FALSE) { xdoc_find_definitions <- function(x, line, col, name, xpath) { index <- attr(x, "top_level_index", exact = TRUE) if (!is.null(index$syntax)) { - signature <- grepl("/expr[FUNCTION|OP-LAMBDA]", xpath, fixed = TRUE) + signature <- grepl("/expr[FUNCTION", xpath, fixed = TRUE) mode <- if (signature) "signature" else if (grepl("/parent::expr", xpath, fixed = TRUE)) "hover" else "definition" token <- if (signature) 0L else navigation_token(list(syntax_data = index$syntax), line, col) template <- get(paste0(mode, "_xpath")) @@ -852,7 +852,7 @@ xdoc_find_token <- function(x, line, col) { line = line, col = col) tokens <- xml_find_all(x, xpath) if (!length(tokens)) { - return(xml_find_first(x, xpath)) + return(xml_find_first(x, "/*[false()]")) } # A cursor at the boundary before a string literal can match both the From 8161808143ca06c5f8199b689d60c276af08266a Mon Sep 17 00:00:00 2001 From: chiricom Date: Mon, 9 Nov 2026 07:21:10 +0000 Subject: [PATCH 2/3] Add tests for XPath branches and XML fallback paths --- R/completion.R | 6 +- R/type_hierarchy.R | 4 +- tests/testthat/test-completion-metadata.R | 41 ++++++++++-- tests/testthat/test-inline-value.R | 70 +++++++++++--------- tests/testthat/test-navigation-index.R | 25 ++++++- tests/testthat/test-range-index.R | 4 ++ tests/testthat/test-refactor.R | 56 +++++++++++++++- tests/testthat/test-references.R | 28 +++++--- tests/testthat/test-type-hierarchy-parsing.R | 38 ++++++++++- tests/testthat/test-utils.R | 3 + 10 files changed, 216 insertions(+), 59 deletions(-) diff --git a/R/completion.R b/R/completion.R index 9842dc8d..c31375f2 100644 --- a/R/completion.R +++ b/R/completion.R @@ -735,14 +735,16 @@ workspace_completion <- function(workspace, token, scope_completion_symbols_xpath <- paste( "(FUNCTION | OP-LAMBDA)/following-sibling::SYMBOL_FORMALS", - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/(LEFT_ASSIGN | EQ_ASSIGN)[not(following-sibling::expr[FUNCTION or OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/LEFT_ASSIGN[not(following-sibling::expr[FUNCTION or OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[not(preceding-sibling::expr[FUNCTION or OP-LAMBDA])]/following-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/EQ_ASSIGN[not(following-sibling::expr[FUNCTION or OP-LAMBDA])]/preceding-sibling::expr[count(*)=1]/SYMBOL", "forcond/SYMBOL", sep = "|") scope_completion_functs_xpath <- paste( - "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/(LEFT_ASSIGN | EQ_ASSIGN)[following-sibling::expr[FUNCTION or OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/LEFT_ASSIGN[following-sibling::expr[FUNCTION or OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/RIGHT_ASSIGN[preceding-sibling::expr[FUNCTION or OP-LAMBDA]]/following-sibling::expr[count(*)=1]/SYMBOL", + "(* | descendant-or-self::expr | descendant-or-self::expr_or_assign_or_help)/EQ_ASSIGN[following-sibling::expr[FUNCTION or OP-LAMBDA]]/preceding-sibling::expr[count(*)=1]/SYMBOL", sep = "|") #' Complete bindings supplied by the enclosing execution context diff --git a/R/type_hierarchy.R b/R/type_hierarchy.R index 44b416d0..7825f986 100644 --- a/R/type_hierarchy.R +++ b/R/type_hierarchy.R @@ -219,7 +219,7 @@ detect_r6class <- function(scopes, token_text, document, uri) { "(//LEFT_ASSIGN | //EQ_ASSIGN)[ preceding-sibling::expr[count(*) = 1]/SYMBOL[text() = '{token_quote}'] and following-sibling::expr[1]//SYMBOL_FUNCTION_CALL[text() = 'R6Class'] - ]/parent::expr", + ]/parent::*", token_quote = token_quote ) @@ -287,7 +287,7 @@ detect_s3class <- function(scopes, token_text, document, uri) { xpath <- glue( "(//LEFT_ASSIGN | //EQ_ASSIGN)[ preceding-sibling::expr[count(*) = 1]/SYMBOL[text() = '{token_quote}'] - ]/parent::expr", + ]/parent::*", token_quote = xml_single_quote(token_text) ) diff --git a/tests/testthat/test-completion-metadata.R b/tests/testthat/test-completion-metadata.R index f8a32a5a..0fb8ebad 100644 --- a/tests/testthat/test-completion-metadata.R +++ b/tests/testthat/test-completion-metadata.R @@ -593,18 +593,26 @@ test_that("Indexed and XML scope completions agree on local symbols", { content <- c( "outer <- function(argument) {", " local_value <- 1", + " local_eq = 2", + " 3 -> local_right", " local_fun <- function() local_value", - " local_value", + " local_eq_fun = function() local_value", + " function() local_value -> local_right_fun", + " local_lambda <- \\(local_lambda_arg) {", + " for (local_loop in 1:2) {", + " local_value", + " }", + " }", "}" ) fixture <- provider_fixture(content) - point <- list(row = 3L, col = 8L) + point <- list(row = 9L, col = 12L) indexed <- scope_completion( fixture$uri, fixture$workspace, "local_", point, snippet_support = TRUE ) - expect_length(indexed, 2L) + expect_length(indexed, 8L) limited <- scope_completion( fixture$uri, fixture$workspace, "local_", point, @@ -640,7 +648,12 @@ test_that("Indexed and XML scope completions agree on local symbols", { }) test_that("Token completion supports indexed and XML parse data", { - content <- c("object$member", "target(named = 1)", "member_other <- 2") + content <- c( + "fn <- function(mem_formal = 1) mem_call(mem_formal)", + "target(named = 1, mem_sub = 2)", + "object$member", + "member_other <- 2" + ) fixture <- provider_fixture(content) indexed <- token_completion( @@ -650,11 +663,29 @@ test_that("Token completion supports indexed and XML parse data", { expect_length(indexed, 1L) expect_equal(indexed[[1L]]$label, "member") + indexed_all <- token_completion(fixture$uri, fixture$workspace, "mem") + indexed_empty <- token_completion(fixture$uri, fixture$workspace, "") + parse_data <- fixture$document$parse_data parse_data$completion_data <- NULL legacy_workspace <- list(get_parse_data = function(...) parse_data) legacy <- token_completion(fixture$uri, legacy_workspace, "mem") - expect_true("member" %in% vapply(legacy, `[[`, character(1L), "label")) + expect_setequal( + vapply(legacy, `[[`, character(1L), "label"), + vapply(indexed_all, `[[`, character(1L), "label") + ) + expect_true(all(c("member", "mem_sub", "mem_formal", "mem_call") %in% + vapply(legacy, `[[`, character(1L), "label"))) + + legacy_empty <- token_completion(fixture$uri, legacy_workspace, "") + expect_setequal( + vapply(legacy_empty, `[[`, character(1L), "label"), + vapply(indexed_empty, `[[`, character(1L), "label") + ) + expect_setequal( + vapply(legacy_empty, `[[`, character(1L), "label"), + c("member", "named", "mem_sub") + ) parse_data$xml_doc <- NULL restored <- token_completion(fixture$uri, legacy_workspace, "mem") diff --git a/tests/testthat/test-inline-value.R b/tests/testthat/test-inline-value.R index c917818f..d294bfec 100644 --- a/tests/testthat/test-inline-value.R +++ b/tests/testthat/test-inline-value.R @@ -69,39 +69,43 @@ test_that("inline values handle empty XML, ranges, and duplicate variables", { 1L, fixture$uri, fixture$workspace, fixture$document, request )$result, 0L) - no_symbols <- provider_fixture(c("# comment", "value <- 1")) - expect_length(inline_value_reply( - 2L, - no_symbols$uri, - no_symbols$workspace, - no_symbols$document, - request - )$result, 0L) + for (indexed in c(TRUE, FALSE)) { + no_symbols <- provider_fixture(c("# comment", "value <- 1")) + if (!indexed) no_symbols$document$parse_data$range_data <- NULL + expect_length(inline_value_reply( + 2L, + no_symbols$uri, + no_symbols$workspace, + no_symbols$document, + request + )$result, 0L) - repeated <- provider_fixture("function(...) value + value") - full_range <- list( - start = list(line = 0L, character = 0L), - end = list(line = 0L, character = 30L) - ) - values <- inline_value_reply( - 3L, - repeated$uri, - repeated$workspace, - repeated$document, - full_range - )$result - expect_equal( - sum(vapply(values, `[[`, character(1L), "variableName") == "value"), - 1L - ) + repeated <- provider_fixture("function(arg, ...) arg + value + value") + if (!indexed) repeated$document$parse_data$range_data <- NULL + full_range <- list( + start = list(line = 0L, character = 0L), + end = list(line = 0L, character = 40L) + ) + values <- inline_value_reply( + 3L, + repeated$uri, + repeated$workspace, + repeated$document, + full_range + )$result + names_found <- vapply(values, `[[`, character(1L), "variableName") + expect_setequal(names_found, c("arg", "value")) + expect_equal(sum(names_found == "value"), 1L) + expect_false("..." %in% names_found) - after_first <- full_range - after_first$start$character <- 20L - expect_length(inline_value_reply( - 4L, - repeated$uri, - repeated$workspace, - repeated$document, - after_first - )$result, 1L) + after_first <- full_range + after_first$start$character <- 30L + expect_length(inline_value_reply( + 4L, + repeated$uri, + repeated$workspace, + repeated$document, + after_first + )$result, 1L) + } }) diff --git a/tests/testthat/test-navigation-index.R b/tests/testthat/test-navigation-index.R index 1ffb2387..d71ae6f6 100644 --- a/tests/testthat/test-navigation-index.R +++ b/tests/testthat/test-navigation-index.R @@ -353,7 +353,12 @@ test_that("indexed local providers preserve fallback responses without XML", { "local(argument = value)", "value", "function(argument) argument -> right_function", - "right_function(argument = value)" + "right_function(argument = value)", + "eq_fn = function(argument = 1) argument", + "lam_fn <- \\(argument = 1) argument", + "eq_fn(argument = value)", + "lam_fn(argument = value)", + "stats::median(x = value, na.rm = TRUE)" ) uri <- "file:///indexed-local-providers.R" document <- Document$new(uri, version = 1L, content = content) @@ -366,8 +371,22 @@ test_that("indexed local providers preserve fallback responses without XML", { legacy$syntax_data <- legacy$navigation_data <- NULL legacy$xml_doc <- xml2::read_xml(parsed$xml_data) attr(legacy$xml_doc, "top_level_index") <- xdoc_top_level_index(legacy$xml_doc) - points <- list(list(row = 5L, col = 2L), list(row = 4L, col = 2L), list(row = 4L, col = 9L), - list(row = 7L, col = 3L), list(row = 7L, col = 17L)) + points <- list( + list(row = 2L, col = 20L), + list(row = 5L, col = 2L), + list(row = 4L, col = 2L), + list(row = 4L, col = 9L), + list(row = 7L, col = 3L), + list(row = 7L, col = 17L), + list(row = 8L, col = 20L), + list(row = 9L, col = 15L), + list(row = 10L, col = 2L), + list(row = 10L, col = 9L), + list(row = 11L, col = 2L), + list(row = 11L, col = 10L), + list(row = 12L, col = 14L), + list(row = 12L, col = 27L) + ) replies <- function(parse_data) { document$parse_data <- parse_data lapply(points, function(point) list( diff --git a/tests/testthat/test-range-index.R b/tests/testthat/test-range-index.R index 8e2f3725..cd14a313 100644 --- a/tests/testthat/test-range-index.R +++ b/tests/testthat/test-range-index.R @@ -9,6 +9,8 @@ test_that("indexed viewport providers agree with XML for nested and Unicode call " inner(two, three))", "pkg::target(one, two)", "object$target(one, two)", + "object@target(one, two)", + "factory(target)(one, two)", "target(alpha, beta)", 'target("alpha" = one, two)', "target((alpha), beta)", @@ -121,12 +123,14 @@ test_that("folding caches use original literate content", { test_that("outline facts preserve nested delimiter and section ordering without XML", { content <- c("# Main ----", "f <- function(x) {g <- function() {", " # Inner ----", " # first", " # second", " x", "}", + " for (", " item in c(1,", " 2)", " ) {", " item", " }", " values <- list(", " x = c(1,", " 2))", "}", "# Last ----", "array[", " 1", "]", "array[[", " 2", "]]") fixture <- provider_fixture(content) parsed <- fixture$document$parse_data xdoc <- parsed$xml_doc expect_equal(parsed$outline_data$blocks, extract_document_block_lines(xdoc)) + expect_equal(get_document_blocks(NULL, parsed$outline_data), get_document_blocks(xdoc)) expect_equal(get_comment_folding_ranges(NULL, parsed$outline_data), get_comment_folding_ranges(xdoc)) for (symbol in c(TRUE, FALSE)) { expected <- get_r_document_ranges_rec(content, 1L, length(content), diff --git a/tests/testthat/test-refactor.R b/tests/testthat/test-refactor.R index 9b166f23..729c88aa 100644 --- a/tests/testthat/test-refactor.R +++ b/tests/testthat/test-refactor.R @@ -362,11 +362,16 @@ test_that("extraction preserves multiline quoted identifiers and argument names" list(content = c("outer <- function(argument) {", " result <- list(`value", " key` = argument$value + 1)", "}"), argument = list(value = 2)), list(content = c("outer <- function(argument) {", ' result <- list("value', - ' key" = argument$value + 1)', "}"), argument = list(value = 2)) + ' key" = argument$value + 1)', "}"), argument = list(value = 2)), + list(content = c("`multi", " fun` <- function(x) x + 1", "outer <- function(argument) {", + " result <- `multi", " fun`(argument$value)", "}"), + start_row = 3L, end_row = 4L, argument = list(value = 2)) ) for (case in cases) { - end <- if (is.null(case$end)) nchar(case$content[[3L]]) else case$end - selected <- list(start = list(row = 1L, col = 12L), end = list(row = 2L, col = end)) + start_row <- if (is.null(case[["start_row"]])) 1L else case[["start_row"]] + end_row <- if (is.null(case[["end_row"]])) 2L else case[["end_row"]] + end <- if (is.null(case[["end"]])) nchar(case$content[[end_row + 1L]]) else case[["end"]] + selected <- list(start = list(row = start_row, col = 12L), end = list(row = end_row, col = end)) original <- new.env(parent = baseenv()) eval(parse(text = case$content), original) for (native in c(TRUE, FALSE)) { @@ -391,6 +396,27 @@ test_that("extraction preserves multiline quoted identifiers and argument names" } } } + + multiline_tokens <- c( + "f <- function(`formal", + " name` = 1) {", + ' s <- "str', + ' val"', + " `sym", + " name` <- `call", + " name`(`sub", + " name` = 1)", + "}" + ) + fixture <- provider_fixture(multiline_tokens) + ctx <- list( + parse_data = fixture$document$parse_data, + xdoc = fixture$document$parse_data$xml_doc + ) + indexed_ranges <- refactor_multiline_quoted_ranges(ctx) + expect_length(indexed_ranges, 5L) + ctx$parse_data$syntax_data <- NULL + expect_equal(refactor_multiline_quoted_ranges(ctx), indexed_ranges) }) test_that("extraction reindents surrounding code without changing a selected literal tail", { @@ -805,6 +831,30 @@ test_that("extract refactorings reject unsafe evaluation contexts", { expect_identical(refactor_code_actions( fixture$uri, fixture$workspace, fixture$document, selected, list("refactor.extract")), list()) + + dots_symbol <- c( + "outer <- function(...) {", + " result <- list(...)", + "}" + ) + fixture <- provider_fixture(dots_symbol) + selected <- refactor_test_range(dots_symbol, 1L, "list(...)") + context <- refactor_selection_context( + fixture$uri, fixture$workspace, fixture$document, selected) + expect_null(refactor_extract_function_action( + fixture$uri, fixture$workspace, fixture$document, context)) + + dots_formal <- c( + "outer <- function(x) {", + " result <- (function(...) x + 1)()", + "}" + ) + fixture <- provider_fixture(dots_formal) + selected <- refactor_test_range(dots_formal, 1L, "(function(...) x + 1)()") + context <- refactor_selection_context( + fixture$uri, fixture$workspace, fixture$document, selected) + expect_null(refactor_extract_function_action( + fixture$uri, fixture$workspace, fixture$document, context)) }) test_that("refactor actions honor requested kinds and current parse versions", { diff --git a/tests/testthat/test-references.R b/tests/testthat/test-references.R index ef62ef9a..1200efd4 100644 --- a/tests/testthat/test-references.R +++ b/tests/testthat/test-references.R @@ -40,16 +40,24 @@ test_that("reference indexing uses syntax for spaced member and namespace operat }) test_that("references honor includeDeclaration while rename includes definitions", { - fixture <- provider_fixture(c("value <- 1", "value")) - point <- list(row = 1L, col = 2L) - for (indexed in c(TRUE, FALSE)) { - if (!indexed) fixture$document$parse_data$reference_index <- NULL - reply <- references_reply(1L, fixture$uri, fixture$workspace, fixture$document, - point, include_declaration = FALSE) - expect_length(reply$result, 1L) - expect_equal(reply$result[[1L]]$range$start$line, 1L) - renamed <- rename_reply(1L, fixture$uri, fixture$workspace, fixture$document, point, "renamed") - expect_length(renamed$result$changes[[fixture$uri]], 2L) + cases <- list( + list(content = c("value <- 1", "value"), point = list(row = 1L, col = 2L), use_line = 1L), + list(content = c("eq_val = 1", "eq_val"), point = list(row = 1L, col = 2L), use_line = 1L), + list(content = c("1 -> right_val", "right_val"), point = list(row = 1L, col = 2L), use_line = 1L), + list(content = c("f <- function(formal_val) {", " formal_val", "}"), point = list(row = 1L, col = 4L), use_line = 1L), + list(content = c("for (loop_val in 1:2) {", " loop_val", "}"), point = list(row = 1L, col = 4L), use_line = 1L) + ) + for (case in cases) { + fixture <- provider_fixture(case$content) + for (indexed in c(TRUE, FALSE)) { + if (!indexed) fixture$document$parse_data$reference_index <- NULL + reply <- references_reply(1L, fixture$uri, fixture$workspace, fixture$document, + case$point, include_declaration = FALSE) + expect_length(reply$result, 1L) + expect_equal(reply$result[[1L]]$range$start$line, case$use_line) + renamed <- rename_reply(1L, fixture$uri, fixture$workspace, fixture$document, case$point, "renamed") + expect_length(renamed$result$changes[[fixture$uri]], 2L) + } } }) diff --git a/tests/testthat/test-type-hierarchy-parsing.R b/tests/testthat/test-type-hierarchy-parsing.R index 20d46178..fbbcaa3b 100644 --- a/tests/testthat/test-type-hierarchy-parsing.R +++ b/tests/testthat/test-type-hierarchy-parsing.R @@ -184,6 +184,7 @@ test_that("R6 hierarchy parsing finds inheritance and real members", { test_that("S3 and setMethod definitions are detected without false positives", { code <- c( "print.widget <- function(x, ...) x", + "format.widget = function(x, ...) x", 'setMethod("show", "Special", function(object) object)', "plain_name <- 1" ) @@ -195,7 +196,12 @@ test_that("S3 and setMethod definitions are detected without false positives", { expect_equal(s3$name, "widget") expect_equal(s3$classType, "S3") - method_scopes <- xdoc_find_enclosing_scopes(xdoc, 2L, 20L, top = TRUE) + eq_s3_scopes <- xdoc_find_enclosing_scopes(xdoc, 2L, 2L, top = TRUE) + eq_s3 <- detect_s3class(eq_s3_scopes, "format.widget", document, document$uri) + expect_equal(eq_s3$name, "widget") + expect_equal(eq_s3$classType, "S3") + + method_scopes <- xdoc_find_enclosing_scopes(xdoc, 3L, 20L, top = TRUE) s4 <- detect_s3class(method_scopes, "Special", document, document$uri) expect_equal(s4$name, "Special") expect_equal(s4$classType, "S4") @@ -211,6 +217,36 @@ test_that("S3 and setMethod definitions are detected without false positives", { ) }) +test_that("Type detection and member extraction support = assignments, quoted names, and comments", { + code <- c( + 'Alias = R6Class("Parent", public = list(', + " field # comment before equals", + " = 1,", + ' "quoted_method" = function() field', + "))", + 'setRefClass("RefWithQuoted", fields = list("quoted_field" = "character", plain_field # comment', + ' = "numeric"), methods = list("quoted_method" = function() NULL))' + ) + uri <- "file:///eq-and-quoted-types.R" + document <- Document$new(uri, content = code) + xdoc <- parse_type_hierarchy_xdoc(code) + workspace <- list(get_parse_data = function(...) list(xml_doc = xdoc)) + + detected <- detect_type_definition(uri, workspace, document, list(row = 0L, col = 1L), "Alias") + expect_equal(detected$name, "Parent") + expect_equal(detected$classType, "R6") + + r6_alias <- detect_r6class(xdoc, "Alias", document, uri) + expect_equal(r6_alias$name, "Alias") + expect_equal(r6_alias$classType, "R6") + + r6_members <- extract_r6_members(document, xdoc, list(name = "Parent", type = "R6")) + expect_setequal(map_chr(r6_members, "name"), c("field", "quoted_method")) + + ref_members <- extract_refclass_members(document, xdoc, list(name = "RefWithQuoted", type = "RefClass")) + expect_setequal(map_chr(ref_members, "name"), c("quoted_field", "plain_field", "quoted_method")) +}) + test_that("Type detection uses the token under the cursor", { code <- c( 'Parent <- R6Class("Parent")', diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 45ccd32a..af7e8fcf 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -21,6 +21,9 @@ test_that("xdoc_find_token retains document order for other boundaries", { token <- xdoc_find_token(xdoc, line = 1, col = 3) expect_equal(xml2::xml_name(token), "OP-LEFT-PAREN") + + missing_token <- xdoc_find_token(xdoc, line = 1, col = 99) + expect_s3_class(missing_token, "xml_missing") }) test_that("indexed enclosing scope lookup preserves results", { From 1a66a1c34d4c624f58a7d0c1e1eb898552ac1b74 Mon Sep 17 00:00:00 2001 From: chiricom Date: Mon, 9 Nov 2026 08:10:53 +0000 Subject: [PATCH 3/3] Fix token sorting and R6 alias expectations in XPath tests --- tests/testthat/test-completion-metadata.R | 8 ++++---- tests/testthat/test-type-hierarchy-parsing.R | 9 +++++++-- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-completion-metadata.R b/tests/testthat/test-completion-metadata.R index 0fb8ebad..1b44215c 100644 --- a/tests/testthat/test-completion-metadata.R +++ b/tests/testthat/test-completion-metadata.R @@ -649,8 +649,8 @@ test_that("Indexed and XML scope completions agree on local symbols", { test_that("Token completion supports indexed and XML parse data", { content <- c( - "fn <- function(mem_formal = 1) mem_call(mem_formal)", - "target(named = 1, mem_sub = 2)", + "fn <- function(member_formal = 1) member_call(member_formal)", + "target(named = 1, member_sub = 2)", "object$member", "member_other <- 2" ) @@ -674,7 +674,7 @@ test_that("Token completion supports indexed and XML parse data", { vapply(legacy, `[[`, character(1L), "label"), vapply(indexed_all, `[[`, character(1L), "label") ) - expect_true(all(c("member", "mem_sub", "mem_formal", "mem_call") %in% + expect_true(all(c("member", "member_sub", "member_formal", "member_call") %in% vapply(legacy, `[[`, character(1L), "label"))) legacy_empty <- token_completion(fixture$uri, legacy_workspace, "") @@ -684,7 +684,7 @@ test_that("Token completion supports indexed and XML parse data", { ) expect_setequal( vapply(legacy_empty, `[[`, character(1L), "label"), - c("member", "named", "mem_sub") + c("member", "named", "member_sub") ) parse_data$xml_doc <- NULL diff --git a/tests/testthat/test-type-hierarchy-parsing.R b/tests/testthat/test-type-hierarchy-parsing.R index fbbcaa3b..3633068d 100644 --- a/tests/testthat/test-type-hierarchy-parsing.R +++ b/tests/testthat/test-type-hierarchy-parsing.R @@ -225,7 +225,8 @@ test_that("Type detection and member extraction support = assignments, quoted na ' "quoted_method" = function() field', "))", 'setRefClass("RefWithQuoted", fields = list("quoted_field" = "character", plain_field # comment', - ' = "numeric"), methods = list("quoted_method" = function() NULL))' + ' = "numeric"), methods = list("quoted_method" = function() NULL))', + "{ Unnamed = R6Class(public = list(x = 1)) }" ) uri <- "file:///eq-and-quoted-types.R" document <- Document$new(uri, content = code) @@ -233,9 +234,13 @@ test_that("Type detection and member extraction support = assignments, quoted na workspace <- list(get_parse_data = function(...) list(xml_doc = xdoc)) detected <- detect_type_definition(uri, workspace, document, list(row = 0L, col = 1L), "Alias") - expect_equal(detected$name, "Parent") + expect_equal(detected$name, "Alias") expect_equal(detected$classType, "R6") + unnamed_detected <- detect_type_definition(uri, workspace, document, list(row = 7L, col = 3L), "Unnamed") + expect_equal(unnamed_detected$name, "Unnamed") + expect_equal(unnamed_detected$classType, "R6") + r6_alias <- detect_r6class(xdoc, "Alias", document, uri) expect_equal(r6_alias$name, "Alias") expect_equal(r6_alias$classType, "R6")