Merge pull request #364 from shrektan/promise-symbol

Recognize symbols created by delayedAssign / assign / makeActiveBinding

Author: renkun-ken

NEWS.md

@@ -1,3 +1,7 @@
+# languageserver 0.3.10
+
+- Recongize promise and active binding symbols (#362)
+
 # languageserver 0.3.9
 
 - skip tests on solaris 
@@ -7,7 +11,7 @@
 - When closing a file, "Problems" should be removed (#348)
 - Implement renameProvider (#337)
 - Hover on symbol in a function with functional argument causes parse error (#345)
-Hover on non-function symbol in other document should show definition and - documentation (#343)
+- Hover on non-function symbol in other document should show definition and - documentation (#343)
 - Check if symbol on rhs of assignment in definition (#341)
 - Implement referencesProvider (#336)
 - Add comment of notice above temp code of definition (#353)

R/document.R

@@ -181,10 +181,24 @@ parse_expr <- function(content, expr, env, level = 0L, srcref = attr(expr, "srcr
     if (length(expr) == 0L || is.symbol(expr)) {
           return(env)
     }
+    # We should handle base function specially as users may use base::fun form
+    # The reason that we only take care of `base` (not `utils`) is that only `base` calls can generate symbols
+    # Check if the lang is in base::fun form
+    is_base_call <- function(x) {
+        length(x) == 3L && as.character(x[[1L]]) %in% c("::", ":::") && as.character(x[[2L]]) == "base"
+    }
+    # Be able to handle `pkg::name` case (note `::` is a function)
+    is_symbol <- function(x) {
+        is.symbol(x) || is_base_call(x)
+    }
+    # Handle `base` function specically by removing the `base::` prefix
+    fun_string <- function(x) {
+        if (is_base_call(x)) as.character(x[[3L]]) else as.character(x)
+    }
     for (i in seq_along(expr)) {
         e <- expr[[i]]
-        if (missing(e) || !is.call(e) || !is.symbol(e[[1L]])) next
-        f <- as.character(e[[1L]])
+        if (missing(e) || !is.call(e) || !is_symbol(e[[1L]])) next
+        f <- fun_string(e[[1L]])
         cur_srcref <- if (level == 0L) srcref[[i]] else srcref
         if (f %in% c("{", "(")) {
             Recall(content, e[-1L], env, level + 1L, cur_srcref)
@@ -204,10 +218,53 @@ parse_expr <- function(content, expr, env, level = 0L, srcref = attr(expr, "srcr
             Recall(content, e[[3L]], env, level + 1L, cur_srcref)
         } else if (f == "repeat") {
             Recall(content, e[[2L]], env, level + 1L, cur_srcref)
-        } else if (f %in% c("<-", "=") && length(e) == 3L && is.symbol(e[[2L]])) {
-            symbol <- as.character(e[[2L]])
-            value <- e[[3L]]
-            type <- get_expr_type(value)
+        } else if (f %in% c("<-", "=", "delayedAssign", "makeActiveBinding", "assign")) {
+            # to see the pos/env/assign.env of assigning functions is set or not
+            # if unset, it means using the default value, which is top-level
+            # if set, we should compare to a vector of known "top-level" candidates
+            is_top_level <- function(arg_env, ...) {
+                if (is.null(arg_env)) return(TRUE)
+                default <- list(
+                    quote(parent.frame(1)), quote(parent.frame(1L)),
+                    quote(environment()),
+                    quote(.GlobalEnv), quote(globalenv())
+                )
+                extra <- substitute(list(...))[-1L]
+                top_level_envs <- c(default, as.list(extra))
+                any(vapply(top_level_envs, identical, x = arg_env, FUN.VALUE = logical(1L)))
+            }
+
+            type <- NULL
+
+            if (f %in% c("<-", "=")) {
+                if (length(e) != 3L || !is.symbol(e[[2L]])) next
+                symbol <- as.character(e[[2L]])
+                value <- e[[3L]]
+            } else if (f == "delayedAssign") {
+                call <- match.call(base::delayedAssign, as.call(e))
+                if (!is.character(call$x)) next
+                if (!is_top_level(call$assign.env)) next
+                symbol <- call$x
+                value <- call$value
+            } else if (f == "assign") {
+                call <- match.call(base::assign, as.call(e))
+                if (!is.character(call$x)) next
+                if (!is_top_level(call$pos, -1L, -1)) next # -1 is the default
+                if (!is_top_level(call$envir)) next
+                symbol <- call$x
+                value <- call$value
+            } else if (f == "makeActiveBinding") {
+                call <- match.call(base::makeActiveBinding, as.call(e))
+                if (!is.character(call$sym)) next
+                if (!is_top_level(call$env)) next
+                symbol <- call$sym
+                value <- call$fun
+                type <- "variable"
+            }
+
+            if (is.null(type)) {
+                type <- get_expr_type(value)
+            }
 
             env$objects <- c(env$objects, symbol)
 

tests/testthat/test-symbol.R

@@ -38,6 +38,43 @@ test_that("Document Symbol works", {
     )
 })
 
+test_that("Recognize symbols created by delayedAssign()/assign()/makeActiveBinding()", {
+    skip_on_cran()
+    client <- language_client()
+
+    defn_file <- withr::local_tempfile(fileext = ".R")
+    writeLines(c(
+        "delayedAssign('d1', 1)",
+        "delayedAssign(value = function() 2, x = 'd2')",
+        "base::delayedAssign(value = '3', 'd3')",
+        "delayedAssign(('d4'), 4)",
+        "delayedAssign('d5', 5, assign.env = globalenv())",
+        "delayedAssign('d6', 6, assign.env = emptyenv())",
+        "delayedAssign('d7', 7, assign.env = parent.frame(1))",
+        "makeActiveBinding('a1', function() 1, environment())",
+        "makeActiveBinding(function() '2', sym = 'a2')",
+        "base::makeActiveBinding(",
+        "   fun = function() stop('3'),",
+        "   sym = 'a3'",
+        ")",
+        "makeActiveBinding(('a4'), function() 4, environment())",
+        "makeActiveBinding('a5', function() 5, .GlobalEnv)",
+        "makeActiveBinding('a6', function() 6, new.env())",
+        "assign(value = '1', x = 'assign1')",
+        "assign('assign2', 2, pos = -1L)",
+        "assign('assign3', 3, pos = environment())",
+        "assign('assign4', 4, pos = new.env())"
+    ), defn_file)
+
+    client %>% did_save(defn_file)
+    result <- client %>% respond_document_symbol(defn_file)
+
+    expect_setequal(
+        result %>% map_chr(~ .$name),
+        c("d1", "d2", "d3", "d5", "d7", "a1", "a2", "a3", "a5", "assign1", "assign2", "assign3")
+    )
+})
+
 test_that("Document section symbol works", {
     skip_on_cran()
     client <- language_client(capabilities = list(