Skip to content

Commit

Permalink
add functional test
Browse files Browse the repository at this point in the history
  • Loading branch information
randy3k committed Aug 30, 2018
1 parent 2ae9d4e commit b02e780
Show file tree
Hide file tree
Showing 10 changed files with 270 additions and 38 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
Expand Up @@ -23,6 +23,7 @@ Imports:
tools,
utils
Suggests:
processx,
testthat
Encoding: UTF-8
LazyData: true
Expand Down
2 changes: 1 addition & 1 deletion R/handlers-general.R
Expand Up @@ -4,7 +4,7 @@ on_initialize <- function(self, id, params) {
self$rootUri <- params$rootUri
self$rootPath <- path_from_uri(self$rootUri)
self$initializationOptions <- params$initializationOptions
self$capabilities <- params$capabilities
self$ClientCapabilities <- params$capabilities
self$deliver(Response$new(id = id, result = list(capabilities = ServerCapabilities)))
}

Expand Down
168 changes: 168 additions & 0 deletions R/languageclient.R
@@ -0,0 +1,168 @@
# for testing purpose

LanguageClient <- R6::R6Class("LanguageClient",
private = list(
ticket = 0
),
public = list(
process = NULL,
rootUri = NULL,
ClientCapabilities = NULL,
ServerCapabilities = NULL,

request_handlers = NULL,
notification_handlers = NULL,
response_handlers = NULL,

initialize = function(cmd, args) {
self$process <- processx::process$new(cmd, args,
stdin = "|", stdout = "|", stderr = "|", supervise = TRUE)
self$register_handlers()
self$response_handlers <- collections::Dict$new()
},

get_ticket = function() {
private$ticket <- private$ticket + 1
private$ticket
},

deliver = function(message, callback = NULL) {
if (!is.null(message)) {
self$process$write_input(message$format())
logger$info("deliver: ", class(message))
method <- message$method
if (!is.null(method)) {
logger$info("method: ", method)
}
if (inherits(message, "Request") && !is.null(callback)) {
id <- message$id
self$response_handlers$set(as.character(id), callback)
}
}
},

request = function(method, params) {
Request$new(
self$get_ticket(),
method,
params
)
},

check_connection = function() {
if (!self$process$is_alive())
stop("Server is dead.")
},

read_header = function() {
if (!self$process$is_alive() || self$process$poll_io(1)[1] != "ready") return(NULL)
header <- self$process$read_output_lines(1)
if (length(header) == 0 || nchar(header) == 0) return(NULL)

logger$info("received: ", header)
matches <- stringr::str_match(header, "Content-Length: ([0-9]+)")
if (is.na(matches[2]))
stop("Unexpected input: ", header)
as.integer(matches[2])
},

read_content = function(nbytes) {
empty_line <- self$process$read_output_lines(1)
while (length(empty_line) == 0) {
empty_line <- self$process$read_output_lines(1)
Sys.sleep(0.01)
}
if (nchar(empty_line) > 0)
stop("Unexpected non-empty line")
data <- ""
while (nbytes > 0) {
newdata <- self$process$read_output(nbytes)
if (length(newdata) > 0) {
nbytes <- nbytes - nchar(newdata, type = "bytes")
data <- paste0(data, newdata)
}
Sys.sleep(0.01)
}
data
},

fetch = function(blocking = FALSE) {
nbytes <- self$read_header()
if (is.null(nbytes)) {
if (!blocking) {
return(NULL)
} else {
while (is.null(nbytes)) {
Sys.sleep(0.1)
nbytes <- self$read_header()
}
}
}

data <- self$read_content(nbytes)
data
},

handle_raw = function(data) {
payload <- tryCatch(
jsonlite::fromJSON(data, simplifyVector = FALSE),
error = function(e) e)
if (inherits(payload, "error")) {
logger$error("error handling json: ", payload)
return(NULL)
}
pl_names <- names(payload)
logger$info("received payload.")

if ("result" %in% pl_names) {
self$handle_response(payload)
} else {
logger$error("got unexpected message")
}
},

handle_response = function(response) {
id <- response$id
callback <- self$response_handlers$pop(as.character(id))
if ("error" %in% names(response)) {
logger$info("got an error: ", response$error)
} else {
tryCatch(
callback(self, response$result),
error = function(e) logger$info("callback error: ", e))
}
},

welcome = function() {
self$deliver(
self$request(
"initialize",
list(
rootUri = self$rootUri,
capabilities = self$ClientCapabilities
)
),
callback = function(self, result) {
self$ServerCapabilities <- result$capabilities
}
)
},

start = function(working_dir = getwd(), capabilities = NULL) {
self$rootUri <- path_to_uri(working_dir)
self$ClientCapabilities <- capabilities
self$welcome()
},

stop = function() {
self$process$kill()
self$response_handlers <- NULL
}
)
)


LanguageClient$set("public", "register_handlers", function() {
self$request_handlers <- list()
self$notification_handlers <- list()
})
73 changes: 37 additions & 36 deletions R/languageserver.R
Expand Up @@ -22,7 +22,7 @@ LanguageServer <- R6::R6Class("LanguageServer",
rootUri = NULL,
rootPath = NULL,
initializationOptions = NULL,
capabilities = NULL,
ClientCapabilities = NULL,

sync_in = NULL,
sync_out = NULL,
Expand Down Expand Up @@ -64,23 +64,24 @@ LanguageServer <- R6::R6Class("LanguageServer",
deliver = function(message) {
if (!is.null(message)) {
cat(message$format(), file = self$outputcon)
if ("Notification" %in% class(message)) {
logger$info("deliver method: ", message$method)
} else {
logger$info("deliver id: ", message$id)
logger$info("deliver: ", class(message))
method <- message$method
if (!is.null(method)) {
logger$info("method: ", method)
}
}
},

handle_raw = function(data) {
tryCatch({
payload <- jsonlite::fromJSON(data, simplifyVector = FALSE)
pl_names <- names(payload)
logger$info("received payload.")
},
error = function(e){
logger$error("error handling json: ", e)
})
payload <- tryCatch(
jsonlite::fromJSON(data, simplifyVector = FALSE),
error = function(e) e)
if (inherits(payload, "error")) {
logger$error("error handling json: ", payload)
return(NULL)
}
pl_names <- names(payload)
logger$info("received payload.")
if ("id" %in% pl_names && "method" %in% pl_names) {
self$handle_request(payload)
} else if ("method" %in% pl_names) {
Expand Down Expand Up @@ -128,28 +129,6 @@ LanguageServer <- R6::R6Class("LanguageServer",
}
},

register_handlers = function() {
self$request_handlers <- list(
initialize = on_initialize,
shutdown = on_shutdown,
`textDocument/completion` = text_document_completion,
`textDocument/hover` = text_document_hover,
`textDocument/signatureHelp` = text_document_signature_help,
`textDocument/formatting` = text_document_formatting,
`textDocument/rangeFormatting` = text_document_range_formatting
)

self$notification_handlers <- list(
initialized = on_initialized,
exit = on_exit,
`textDocument/didOpen` = text_document_did_open,
`textDocument/didChange` = text_document_did_change,
`textDocument/didSave` = text_document_did_save,
`textDocument/didClose` = text_document_did_close,
`workspace/didChangeConfiguration` = workspace_did_change_configuration
)
},

process_events = function() {
self$process_sync_in()
self$process_sync_out()
Expand Down Expand Up @@ -256,7 +235,7 @@ LanguageServer <- R6::R6Class("LanguageServer",
}
data <- self$read_content(nbytes)
self$handle_raw(data)
})
}, silent = TRUE)
if (inherits(ret, "try-error")) {
logger$error(ret)
logger$error(as.list(traceback()))
Expand All @@ -272,6 +251,28 @@ LanguageServer <- R6::R6Class("LanguageServer",
)
)

LanguageServer$set("public", "register_handlers", function() {
self$request_handlers <- list(
initialize = on_initialize,
shutdown = on_shutdown,
`textDocument/completion` = text_document_completion,
`textDocument/hover` = text_document_hover,
`textDocument/signatureHelp` = text_document_signature_help,
`textDocument/formatting` = text_document_formatting,
`textDocument/rangeFormatting` = text_document_range_formatting
)

self$notification_handlers <- list(
initialized = on_initialized,
exit = on_exit,
`textDocument/didOpen` = text_document_did_open,
`textDocument/didChange` = text_document_did_change,
`textDocument/didSave` = text_document_did_save,
`textDocument/didClose` = text_document_did_close,
`workspace/didChangeConfiguration` = workspace_did_change_configuration
)
})


#' Run the R language server
#' @param debug set \code{TRUE} to show debug information in stderr;
Expand Down
2 changes: 1 addition & 1 deletion R/workspace.R
Expand Up @@ -212,7 +212,7 @@ process_sync_in <- function(self) {
item <- sync_out$pop(uri)
process <- item$process
parse <- item$parse
if (process$is_alive()) try(process$kill())
if (process$is_alive()) try(process$kill(), silent = TRUE)
temp_file <- item$temp_file
if (!is.null(temp_file) && file.exists(temp_file)) {
file.remove(temp_file)
Expand Down
12 changes: 12 additions & 0 deletions inst/projects/mypackage/DESCRIPTION
@@ -0,0 +1,12 @@
Package: languageserver
Title: What the Package Does (One Line, Title Case)
Version: 0.0.0.9000
Authors@R:
person(given = "First",
family = "Last",
role = c("aut", "cre"),
email = "first.last@example.com")
Description: What the package does (one paragraph).
License: What license it uses
Encoding: UTF-8
LazyData: true
2 changes: 2 additions & 0 deletions inst/projects/mypackage/NAMESPACE
@@ -0,0 +1,2 @@
# Generated by roxygen2: fake comment so roxygen2 overwrites silently.
exportPattern("^[^\\.]")
3 changes: 3 additions & 0 deletions inst/projects/mypackage/R/mypackage.R
@@ -0,0 +1,3 @@
nothing <- function(x, y) {
NULL
}
19 changes: 19 additions & 0 deletions tests/testthat/test-stdio.R
@@ -0,0 +1,19 @@
exec <- if (.Platform$OS.type == "windows") "Rterm" else "R"
bin <- file.path(R.home("bin"), exec)

wd <- system.file("projects", "mypackage", package = "languageserver")

# languageserver:::logger$debug_mode(TRUE)

client <- languageserver:::LanguageClient$new(
bin, c("--slave", "-e", "languageserver::run()"))

client$start(working_dir = wd)
data <- client$fetch(blocking = TRUE)
client$handle_raw(data)

context("Test STDIO connection")

test_that("initialize", {
expect_false(is.null(client$ServerCapabilities))
})
26 changes: 26 additions & 0 deletions tests/testthat/test-tcp.R
@@ -0,0 +1,26 @@
get_free_port <- function(port = 6000) {
while (TRUE) {
p <- callr::r_bg(
function(port) {
inherits(try(
socketConnection(port = port, server = TRUE), silent = TRUE),
"connection")
},
list(port = port))
q <- callr::r_bg(
function(port) {
Sys.sleep(0.1)
inherits(try(
socketConnection(port = port, server = FALSE), silent = TRUE),
"connection")
},
list(port = port))
q$wait()
p$wait()
if (q$get_result() && p$get_result()) {
return(port)
} else {
port <- port + 1
}
}
}

0 comments on commit b02e780

Please sign in to comment.