From c7490ce9a32f89908a688823028db28cea0c3255 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Wed, 17 Jul 2024 08:15:02 +0200 Subject: [PATCH 01/53] Draft of a mock server for testing --- test/mock-lsp-server.el | 69 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 test/mock-lsp-server.el diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el new file mode 100644 index 0000000000..6c3da2611f --- /dev/null +++ b/test/mock-lsp-server.el @@ -0,0 +1,69 @@ +#!/usr/bin/emacs --script +;; -*- lexical-binding: t; -*- +;; -*- coding: utf-8; -*- + +(defun greeting (id) + (format "Content-Length: 778 +Content-Type: application/vscode-jsonrpc; charset=utf8 + +{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"pylsp\",\"version\":\"1.3.3\"}}}" id)) + +(defun ack (id) + (format "Content-Length: 37 +Content-Type: application/vscode-jsonrpc; charset=utf8 + +{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id)) + +(defun shutdown-ack (id) + (format "Content-Length: 37 +Content-Type: application/vscode-jsonrpc; charset=utf8 + +{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id)) + +(defvar diagnostics "Content-Length: 645 +Content-Type: application/vscode-jsonrpc; charset=utf8 + +{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/\\/home\\/necto\\/proj\\/lsp-sonarlint\\/fixtures\\/sample.py\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'break' outside loop\",\"severity\":2}]}}") + + +(defun get-id (input) + (if (string-match "id\":\\([0-9]+\\)" input) + (string-to-number (match-string 1 input)) + nil)) + +;; Echo +(let (line stopped) + (while (and (not stopped) (setq line (read-string ""))) + (cond + ((string-match "method\":\"initialize\"" line) + (princ (greeting (get-id line)))) + ((string-match "method\":\"initialized\"" line) + ;; No need to acknowledge + ) + ((string-match "method\":\"exit" line) + (setq stopped t)) + ((string-match "method\":\"shutdown" line) + (princ (shutdown-ack (get-id line)))) + ((string-match "didOpen" line) + (princ diagnostics)) + ((string-match "method\":\"workspace/didChangeConfiguration" line) + ;; No need to acknowledge + ) + ((string-match "method\":\"textDocument/didClose" line) + ;; No need to acknowledge + ) + ((get-id line) + (princ (ack (get-id line)))) + ((string-match "Content-Length" line) + ;; Ignore header + ) + ((string-match "Content-Type" line) + ;; Ignore header + ) + ((string-match "^ $" line) + ;; Ignore the empty lines delimitting header and content + ) + ((string-match "^$" line) + ;; Ignore other empty lines + ) + (t (error "unexpected input '%s'" line))))) From c70df1e65857f9123f5a23188bdac1d89794cf32 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Wed, 17 Jul 2024 18:39:36 +0200 Subject: [PATCH 02/53] Spy lsp communication up close --- lsp-mode.el | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/lsp-mode.el b/lsp-mode.el index 05cac9b3c2..f4069bdf41 100644 --- a/lsp-mode.el +++ b/lsp-mode.el @@ -7040,6 +7040,7 @@ server. WORKSPACE is the active workspace." (let ((body-received 0) leftovers body-length body chunk) (lambda (_proc input) + (lsp-dump-string-to-special-buffer input "*lsp-received-messages*") (setf chunk (if (s-blank? leftovers) input (concat leftovers input))) @@ -8809,9 +8810,24 @@ When ALL is t, erase all log buffers of the running session." (when (process-live-p process) (kill-process process))) +(defun lsp-dump-string-to-special-buffer (string buffer-name) + "Dump the given STRING into a special-named buffer BUFFER-NAME, preserving the current buffer." + (with-current-buffer (get-buffer-create buffer-name) + (goto-char (point-max)) + (let* ((current-time (current-time)) + (decoded-time (decode-time current-time)) + (hours (nth 2 decoded-time)) + (minutes (nth 1 decoded-time)) + (seconds (nth 0 decoded-time)) + (milliseconds (floor (* 1000 (mod (float-time current-time) 1))))) + (insert (format "|(%02d:%02d:%02d.%03d)|" hours minutes seconds milliseconds))) + (insert string))) + (cl-defmethod lsp-process-send ((process process) message) (condition-case err - (process-send-string process (lsp--make-message message)) + (let ((msg (lsp--make-message message))) + (lsp-dump-string-to-special-buffer msg "*lsp-sent-messages*") + (process-send-string process msg)) (error (lsp--error "Sending to process failed with the following error: %s" (error-message-string err))))) From 24fbb325f6d8cdeb54e461625ebbdad8bd61574f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Wed, 17 Jul 2024 18:39:53 +0200 Subject: [PATCH 03/53] Working lsp server mock --- test/mock-lsp-server.el | 42 +++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 6c3da2611f..f6259653ea 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -2,36 +2,38 @@ ;; -*- lexical-binding: t; -*- ;; -*- coding: utf-8; -*- +(defun json-rpc-string (body) + ;; 1+ - extra new-line at the end + (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) + (defun greeting (id) - (format "Content-Length: 778 -Content-Type: application/vscode-jsonrpc; charset=utf8 - -{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"pylsp\",\"version\":\"1.3.3\"}}}" id)) + (json-rpc-string + (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" + id))) (defun ack (id) - (format "Content-Length: 37 -Content-Type: application/vscode-jsonrpc; charset=utf8 - -{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id)) + (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id))) (defun shutdown-ack (id) - (format "Content-Length: 37 -Content-Type: application/vscode-jsonrpc; charset=utf8 - -{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id)) - -(defvar diagnostics "Content-Length: 645 -Content-Type: application/vscode-jsonrpc; charset=utf8 - -{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/\\/home\\/necto\\/proj\\/lsp-sonarlint\\/fixtures\\/sample.py\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'break' outside loop\",\"severity\":2}]}}") + (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id))) +(defun diagnostics (for-file) + (json-rpc-string + (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"%s\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'broke' outside loop\",\"severity\":2}]}}" + for-file))) (defun get-id (input) - (if (string-match "id\":\\([0-9]+\\)" input) + (if (string-match "\"id\":\\([0-9]+\\)" input) (string-to-number (match-string 1 input)) nil)) -;; Echo +(setq ll "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/didOpen\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/necto/proj/lsp-mode/sample.awk\",\"languageId\":\"awk\",\"version\":0,\"text\":\"heyho! Hi I'm a new member here. I'm a 16 year old\\nline 1 is here and here\\nline 2 is here and here\\n\"}}}") + +(defun get-file-path (input) + (if (string-match "\"uri\":\"\\(file:\\/\\/[^,]+\\)\"," input) + (match-string 1 input) + nil)) + (let (line stopped) (while (and (not stopped) (setq line (read-string ""))) (cond @@ -45,7 +47,7 @@ Content-Type: application/vscode-jsonrpc; charset=utf8 ((string-match "method\":\"shutdown" line) (princ (shutdown-ack (get-id line)))) ((string-match "didOpen" line) - (princ diagnostics)) + (princ (diagnostics (get-file-path line)))) ((string-match "method\":\"workspace/didChangeConfiguration" line) ;; No need to acknowledge ) From b9a4367eca1c175693a1236f98b66e902ee05bd7 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Wed, 17 Jul 2024 18:41:01 +0200 Subject: [PATCH 04/53] lsp client definition for the mock lsp server --- test/test-mock-lsp-server.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 test/test-mock-lsp-server.el diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el new file mode 100644 index 0000000000..97f6b401b1 --- /dev/null +++ b/test/test-mock-lsp-server.el @@ -0,0 +1,14 @@ +(require 'lsp-mode) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection + '("emacs" "--script" "/home/necto/proj/lsp-mode/test/mock-lsp-server.el")) + :major-modes '(awk-mode) + :priority 1 + :request-handlers (lsp-ht) + :notification-handlers (lsp-ht) + :multi-root nil + :add-on? t + :server-id 'mock-server + :action-handlers (lsp-ht))) From d8f860a7921bbbf33893a4d1552b598f4b2232ff Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Wed, 17 Jul 2024 23:54:24 +0200 Subject: [PATCH 05/53] Working smoke test for the mock server --- test/fixtures/SamplesForMock/sample.awk | 4 +++ test/lsp-test-utils.el | 2 ++ test/test-mock-lsp-server.el | 37 +++++++++++++++++-------- 3 files changed, 31 insertions(+), 12 deletions(-) create mode 100644 test/fixtures/SamplesForMock/sample.awk diff --git a/test/fixtures/SamplesForMock/sample.awk b/test/fixtures/SamplesForMock/sample.awk new file mode 100644 index 0000000000..0ae94a2911 --- /dev/null +++ b/test/fixtures/SamplesForMock/sample.awk @@ -0,0 +1,4 @@ +heyho! Hi I'm a new member here. I'm a 16 year old +line 1 is here and here +line 2 is here and here +line 3 is here and here diff --git a/test/lsp-test-utils.el b/test/lsp-test-utils.el index 46aa6b770e..5a104770cf 100644 --- a/test/lsp-test-utils.el +++ b/test/lsp-test-utils.el @@ -26,6 +26,8 @@ ;;; Code: +(require 'deferred) + (defun lsp-test--wait-for (form &optional d) (--doto (or d (deferred:new #'identity)) (run-with-timer diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index 97f6b401b1..e235a42407 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -1,14 +1,27 @@ (require 'lsp-mode) +(require 'lsp-test-utils) -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection - '("emacs" "--script" "/home/necto/proj/lsp-mode/test/mock-lsp-server.el")) - :major-modes '(awk-mode) - :priority 1 - :request-handlers (lsp-ht) - :notification-handlers (lsp-ht) - :multi-root nil - :add-on? t - :server-id 'mock-server - :action-handlers (lsp-ht))) +;; Taken from lsp-integration-tests.el +(defconst lsp-test-location (file-name-directory (or load-file-name buffer-file-name))) + +(defun register-mock-client () + (lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection + '("emacs" "--script" "/home/necto/proj/lsp-mode/test/mock-lsp-server.el")) + :major-modes '(awk-mode) + :priority 100 + :server-id 'mock-server))) + +(ert-deftest lsp-mock-server-reports-issues () + (let ((lsp-clients (lsp-ht)) ; clear all clients + (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled + (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk"))) + (register-mock-client) ; register mock client as the one an only lsp client + (let* ((buf (find-file-noselect sample-file))) + (with-timeout (7 (error "Timeout trying to get diagnostics from mock server")) + (with-current-buffer buf + (lsp) + (let* ((chain (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) + (diagnostics (deferred:sync! chain))) + (should (eq (length diagnostics) 3)))))))) From 4259eb78564b770b5415c934380f273928649a8f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 04:50:13 +0200 Subject: [PATCH 06/53] Minimize mock server greeting --- test/mock-lsp-server.el | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index f6259653ea..5862f41970 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -2,14 +2,31 @@ ;; -*- lexical-binding: t; -*- ;; -*- coding: utf-8; -*- +(defconst server-name "mock-server") +(defconst server-version "0.0.1") + +(defconst json-rpc-header + "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n") + (defun json-rpc-string (body) ;; 1+ - extra new-line at the end - (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) + (format json-rpc-header (1+ (string-bytes body)) body)) +;; TODO: mock and check +;; - quick fixes +;; - highlighting +;; - folding +;; - formatting +;; - codeLens: go to def, go to use +;; - hover? does it involve source ranges? +;; - rename (defun greeting (id) (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" - id))) + (format + "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true}},\"serverInfo\":{\"name\":\"%s\",\"version\":\"%s\"}}}" + id + server-name + server-version))) (defun ack (id) (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id))) @@ -27,8 +44,6 @@ (string-to-number (match-string 1 input)) nil)) -(setq ll "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/didOpen\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/necto/proj/lsp-mode/sample.awk\",\"languageId\":\"awk\",\"version\":0,\"text\":\"heyho! Hi I'm a new member here. I'm a 16 year old\\nline 1 is here and here\\nline 2 is here and here\\n\"}}}") - (defun get-file-path (input) (if (string-match "\"uri\":\"\\(file:\\/\\/[^,]+\\)\"," input) (match-string 1 input) @@ -56,10 +71,8 @@ ) ((get-id line) (princ (ack (get-id line)))) - ((string-match "Content-Length" line) - ;; Ignore header - ) - ((string-match "Content-Type" line) + ((or (string-match "Content-Length" line) + (string-match "Content-Type" line)) ;; Ignore header ) ((string-match "^ $" line) From 397ecc0a476e5ad705a83221f7a7ae18e0ac6916 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 04:56:43 +0200 Subject: [PATCH 07/53] Revert "Minimize mock server greeting" This reverts commit 4259eb78564b770b5415c934380f273928649a8f. --- test/mock-lsp-server.el | 31 +++++++++---------------------- 1 file changed, 9 insertions(+), 22 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 5862f41970..f6259653ea 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -2,31 +2,14 @@ ;; -*- lexical-binding: t; -*- ;; -*- coding: utf-8; -*- -(defconst server-name "mock-server") -(defconst server-version "0.0.1") - -(defconst json-rpc-header - "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n") - (defun json-rpc-string (body) ;; 1+ - extra new-line at the end - (format json-rpc-header (1+ (string-bytes body)) body)) + (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) -;; TODO: mock and check -;; - quick fixes -;; - highlighting -;; - folding -;; - formatting -;; - codeLens: go to def, go to use -;; - hover? does it involve source ranges? -;; - rename (defun greeting (id) (json-rpc-string - (format - "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true}},\"serverInfo\":{\"name\":\"%s\",\"version\":\"%s\"}}}" - id - server-name - server-version))) + (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" + id))) (defun ack (id) (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id))) @@ -44,6 +27,8 @@ (string-to-number (match-string 1 input)) nil)) +(setq ll "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/didOpen\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/necto/proj/lsp-mode/sample.awk\",\"languageId\":\"awk\",\"version\":0,\"text\":\"heyho! Hi I'm a new member here. I'm a 16 year old\\nline 1 is here and here\\nline 2 is here and here\\n\"}}}") + (defun get-file-path (input) (if (string-match "\"uri\":\"\\(file:\\/\\/[^,]+\\)\"," input) (match-string 1 input) @@ -71,8 +56,10 @@ ) ((get-id line) (princ (ack (get-id line)))) - ((or (string-match "Content-Length" line) - (string-match "Content-Type" line)) + ((string-match "Content-Length" line) + ;; Ignore header + ) + ((string-match "Content-Type" line) ;; Ignore header ) ((string-match "^ $" line) From 1a0a69c47df500b02352c3e402643e6c2ffbb5ef Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 05:51:27 +0200 Subject: [PATCH 08/53] Make test-mock-lsp-server repeatable --- test/test-mock-lsp-server.el | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index e235a42407..8b11e9fad6 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -13,15 +13,31 @@ :priority 100 :server-id 'mock-server))) +(defun lsp-test-total-server-count () + (hash-table-count (lsp-session-folder->servers (lsp-session)))) + +;; Should I add the fixtures/SamplesForMock folder to workspace folders? (ert-deftest lsp-mock-server-reports-issues () (let ((lsp-clients (lsp-ht)) ; clear all clients (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled - (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk"))) + (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) + (initial-server-count (lsp-test-total-server-count))) (register-mock-client) ; register mock client as the one an only lsp client (let* ((buf (find-file-noselect sample-file))) - (with-timeout (7 (error "Timeout trying to get diagnostics from mock server")) - (with-current-buffer buf - (lsp) - (let* ((chain (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) - (diagnostics (deferred:sync! chain))) - (should (eq (length diagnostics) 3)))))))) + (unwind-protect + (with-timeout (15 (error "Timeout trying to get diagnostics from mock server")) + (with-current-buffer buf + (lsp) + (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) + ;; why is 'sample-file' here throwing "variable definition is void"? + ;; Why does lsp not send the "shutdown" message on error? + (let* ((chain (lsp-test-wait (gethash (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk") ;was sample-file + (lsp-diagnostics t)))) + (diagnostics (deferred:sync! chain))) + (should (eq (length diagnostics) 3))))) + (kill-buffer buf) + ;; (with-timeout (2 (error "LSP server refuses to stop")) + ;; ;; Again "initial-server-count" is void variable: + ;; ;; WTF with this deferred stuff? + ;; (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))) + )))) From 3283dac405edba177b7af1699f6934749d8c889c Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 10:58:59 +0200 Subject: [PATCH 09/53] Use lexical scope capture for lsp-test-wait --- test/lsp-test-utils.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lsp-test-utils.el b/test/lsp-test-utils.el index 5a104770cf..873b03bc49 100644 --- a/test/lsp-test-utils.el +++ b/test/lsp-test-utils.el @@ -33,12 +33,12 @@ (run-with-timer 0.001 nil (lambda () - (if-let ((result (eval form))) + (if-let ((result (funcall form))) (deferred:callback-post it result) (lsp-test--wait-for form it)))))) (defmacro lsp-test-wait (form) - `(lsp-test--wait-for '(progn ,form))) + `(lsp-test--wait-for (lambda () ,form))) (provide 'lsp-test-utils) ;;; lsp-test-utils.el ends here From 8b0d46c7ccb476ae64379a7cd42c580f7696b299 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 11:07:37 +0200 Subject: [PATCH 10/53] figured out the lexical scope. at least now the happy path shuts down properly --- test/test-mock-lsp-server.el | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index 8b11e9fad6..e6b2e61633 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -1,3 +1,5 @@ +;;; test-mock-lsp-server.el --- unit test utilities -*- lexical-binding: t -*- + (require 'lsp-mode) (require 'lsp-test-utils) @@ -29,15 +31,10 @@ (with-current-buffer buf (lsp) (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) - ;; why is 'sample-file' here throwing "variable definition is void"? ;; Why does lsp not send the "shutdown" message on error? - (let* ((chain (lsp-test-wait (gethash (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk") ;was sample-file - (lsp-diagnostics t)))) + (let* ((chain (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) (diagnostics (deferred:sync! chain))) (should (eq (length diagnostics) 3))))) (kill-buffer buf) - ;; (with-timeout (2 (error "LSP server refuses to stop")) - ;; ;; Again "initial-server-count" is void variable: - ;; ;; WTF with this deferred stuff? - ;; (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))) - )))) + (with-timeout (10 (error "LSP server refuses to stop")) + (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))))) From 7301bd1184ff4977071a24779133ae9a057f1044 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 19:17:30 +0200 Subject: [PATCH 11/53] Make mock-server test faster; kill the server more reliably --- test/mock-lsp-server.el | 6 ++---- test/test-mock-lsp-server.el | 18 ++++++++++-------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index f6259653ea..699a8522eb 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -19,7 +19,7 @@ (defun diagnostics (for-file) (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"%s\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'broke' outside loop\",\"severity\":2}]}}" + (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'broke' outside loop\",\"severity\":2}]}}" for-file))) (defun get-id (input) @@ -27,10 +27,8 @@ (string-to-number (match-string 1 input)) nil)) -(setq ll "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument/didOpen\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/necto/proj/lsp-mode/sample.awk\",\"languageId\":\"awk\",\"version\":0,\"text\":\"heyho! Hi I'm a new member here. I'm a 16 year old\\nline 1 is here and here\\nline 2 is here and here\\n\"}}}") - (defun get-file-path (input) - (if (string-match "\"uri\":\"\\(file:\\/\\/[^,]+\\)\"," input) + (if (string-match "\"uri\":\"file:\\/\\/\\([^,]+\\)\"," input) (match-string 1 input) nil)) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index e6b2e61633..5bc0b8d73e 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -18,23 +18,25 @@ (defun lsp-test-total-server-count () (hash-table-count (lsp-session-folder->servers (lsp-session)))) -;; Should I add the fixtures/SamplesForMock folder to workspace folders? (ert-deftest lsp-mock-server-reports-issues () (let ((lsp-clients (lsp-ht)) ; clear all clients (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled + (workspace-root (f-join lsp-test-location "fixtures/SamplesForMock")) (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) (initial-server-count (lsp-test-total-server-count))) (register-mock-client) ; register mock client as the one an only lsp client + (lsp-workspace-folders-add workspace-root) (let* ((buf (find-file-noselect sample-file))) (unwind-protect - (with-timeout (15 (error "Timeout trying to get diagnostics from mock server")) + (with-timeout (5 (error "Timeout trying to get diagnostics from mock server")) (with-current-buffer buf (lsp) (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) - ;; Why does lsp not send the "shutdown" message on error? - (let* ((chain (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) - (diagnostics (deferred:sync! chain))) - (should (eq (length diagnostics) 3))))) + (deferred:sync! (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) + (should (eq (length (gethash sample-file (lsp-diagnostics t))) 3)))) (kill-buffer buf) - (with-timeout (10 (error "LSP server refuses to stop")) - (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))))) + (lsp-workspace-folders-remove workspace-root))) + (message "%d" initial-server-count) + (with-timeout (5 (error "LSP server refuses to stop")) + (message "%d" initial-server-count) + (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))) From 5f816345a0d364b9a9724094f410b0ba7fd227e8 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 19:23:14 +0200 Subject: [PATCH 12/53] Minimize server capabilities advertized --- test/mock-lsp-server.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 699a8522eb..dd7ee732cc 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -6,9 +6,16 @@ ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) +;; TODO: +;; - codeActionProvider +;; - codeLensProvider +;; - document(Range)FormattingProvider? +;; - documentHighlightProvider +;; - referencesProvider? +;; - foldingRangeProvider (defun greeting (id) (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"capabilities\":{\"codeActionProvider\":true,\"codeLensProvider\":{\"resolveProvider\":false},\"completionProvider\":{\"resolveProvider\":true,\"triggerCharacters\":[\".\"]},\"documentFormattingProvider\":true,\"documentHighlightProvider\":true,\"documentRangeFormattingProvider\":true,\"documentSymbolProvider\":true,\"definitionProvider\":true,\"executeCommandProvider\":{\"commands\":[]},\"hoverProvider\":true,\"referencesProvider\":true,\"renameProvider\":true,\"foldingRangeProvider\":true,\"signatureHelpProvider\":{\"triggerCharacters\":[\"(\",\",\",\"=\"]},\"textDocumentSync\":{\"change\":2,\"save\":{\"includeText\":true},\"openClose\":true},\"workspace\":{\"workspaceFolders\":{\"supported\":true,\"changeNotifications\":true}},\"experimental\":{}},\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" + (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" id))) (defun ack (id) From f0d65ab33dc4a1a792a857360dabcf529700c846 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 20:24:28 +0200 Subject: [PATCH 13/53] Break down the mock diagnostic and assert it in the test --- test/fixtures/SamplesForMock/sample.awk | 6 ++-- test/mock-lsp-server.el | 45 +++++++++++++++++++++++-- test/test-mock-lsp-server.el | 30 +++++++++++++++-- 3 files changed, 72 insertions(+), 9 deletions(-) diff --git a/test/fixtures/SamplesForMock/sample.awk b/test/fixtures/SamplesForMock/sample.awk index 0ae94a2911..b236156403 100644 --- a/test/fixtures/SamplesForMock/sample.awk +++ b/test/fixtures/SamplesForMock/sample.awk @@ -1,4 +1,4 @@ -heyho! Hi I'm a new member here. I'm a 16 year old -line 1 is here and here -line 2 is here and here +heyho! Hi I'm a new member here. +line 1 is here broming and here +line 2 is here normalw and here line 3 is here and here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index dd7ee732cc..820c1eabb2 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -6,7 +6,7 @@ ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) -;; TODO: +;; TODO mock: ;; - codeActionProvider ;; - codeLensProvider ;; - document(Range)FormattingProvider? @@ -24,10 +24,49 @@ (defun shutdown-ack (id) (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id))) +(defun loc-to-json (loc) + (format "{\"line\":%d,\"character\":%d}" (plist-get loc :line) (plist-get loc :character))) + +(defun range-to-json (range) + (format "{\"start\":%s,\"end\":%s}" + (loc-to-json (plist-get range :start)) + (loc-to-json (plist-get range :end)))) + +(defun diagnostic-to-json (diagnostic) + (format "{\"source\":\"%s\",\"code\":\"%s\",\"range\":%s,\"message\":\"%s\",\"severity\":%d}" + (plist-get diagnostic :source) + (plist-get diagnostic :code) + (range-to-json (plist-get diagnostic :range)) + (plist-get diagnostic :message) + (plist-get diagnostic :severity))) + +(defun point-to-loc (point) + (goto-char point) + (list :line (- (line-number-at-pos point) 1) :character (- (current-column) 1))) + +(defun make-diagnostics (for-file) + (let ((forbidden-word "broming")) + (with-current-buffer (find-file-noselect for-file) + (goto-char (point-min)) + (let (diagnostics) + (while (re-search-forward forbidden-word nil t) + (let ((line (- (line-number-at-pos (point)) 1)) + (end-col (current-column)) + (start-col (- (current-column) (length forbidden-word)))) + (push (list :source "mockS" + :code "E001" + :range (list :start (list :line line :character start-col) + :end (list :line line :character end-col)) + :message (format "Do not use word '%s'" forbidden-word) + :severity 2) + diagnostics))) + diagnostics)))) + (defun diagnostics (for-file) (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":3},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'true'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F821\",\"range\":{\"start\":{\"line\":2,\"character\":11},\"end\":{\"line\":2,\"character\":18}},\"message\":\"F821 undefined name 'false'\",\"severity\":2},{\"source\":\"flake8\",\"code\":\"F701\",\"range\":{\"start\":{\"line\":3,\"character\":4},\"end\":{\"line\":3,\"character\":10}},\"message\":\"F701 'broke' outside loop\",\"severity\":2}]}}" - for-file))) + (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}}" + for-file + (mapconcat #'diagnostic-to-json (make-diagnostics for-file) ",")))) (defun get-id (input) (if (string-match "\"id\":\\([0-9]+\\)" input) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index 5bc0b8d73e..dcdf412828 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -18,6 +18,26 @@ (defun lsp-test-total-server-count () (hash-table-count (lsp-session-folder->servers (lsp-session)))) +(defun lsp-test-diag-make-summary (file-content line-number line marker) + (with-temp-buffer + (insert file-content) + (goto-char (point-min)) + (forward-line line-number) + ;; Make sure line-number is correct + (should (string-equal (string-trim-right (thing-at-point 'line t)) line))) + (should (eq (length marker) (length line))) + (should (string-match "^ *\\(\\^+\\) *$" marker)) + (list :line line-number :from (match-beginning 1) :to (match-end 1))) + +(defun lsp-test-diag-get-summary (diagnostic) + (let* ((range (ht-get diagnostic "range")) + (start (ht-get range "start")) + (end (ht-get range "end"))) + (should (eq (ht-get start "line") (ht-get end "line"))) + (list :line (ht-get start "line") + :from (ht-get start "character") + :to (ht-get end "character")))) + (ert-deftest lsp-mock-server-reports-issues () (let ((lsp-clients (lsp-ht)) ; clear all clients (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled @@ -31,12 +51,16 @@ (with-timeout (5 (error "Timeout trying to get diagnostics from mock server")) (with-current-buffer buf (lsp) + ;; Make sure the server started (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) (deferred:sync! (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) - (should (eq (length (gethash sample-file (lsp-diagnostics t))) 3)))) + (should (eq (length (gethash sample-file (lsp-diagnostics t))) 1)) + (should (equal (lsp-test-diag-get-summary (car (gethash sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make-summary (buffer-string) 1 + "line 1 is here broming and here" + " ^^^^^^^ "))))) (kill-buffer buf) (lsp-workspace-folders-remove workspace-root))) - (message "%d" initial-server-count) (with-timeout (5 (error "LSP server refuses to stop")) - (message "%d" initial-server-count) + ;; Make sure the server stopped (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))) From c5c77a49bed8503e75c3ed1cd74078a363432d3c Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Thu, 18 Jul 2024 20:38:47 +0200 Subject: [PATCH 14/53] Obviate the line number in lsp-test-diag-make --- test/test-mock-lsp-server.el | 39 ++++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index dcdf412828..ccfca07102 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -18,18 +18,27 @@ (defun lsp-test-total-server-count () (hash-table-count (lsp-session-folder->servers (lsp-session)))) -(defun lsp-test-diag-make-summary (file-content line-number line marker) - (with-temp-buffer - (insert file-content) - (goto-char (point-min)) - (forward-line line-number) - ;; Make sure line-number is correct - (should (string-equal (string-trim-right (thing-at-point 'line t)) line))) - (should (eq (length marker) (length line))) - (should (string-match "^ *\\(\\^+\\) *$" marker)) - (list :line line-number :from (match-beginning 1) :to (match-end 1))) +(defun lsp-test--find-line (file-content line) + (let ((lines (split-string file-content "\n")) + (line-number 0) + (found nil)) + (while (and lines (not found)) + (when (string= (car lines) line) + (setq found line-number)) + (setq lines (cdr lines)) + (setq line-number (1+ line-number))) + (when (not found) + (error "Line %s not found" line)) + found)) -(defun lsp-test-diag-get-summary (diagnostic) +(defun lsp-test-diag-make (file-content line marker) + (let ((line-number (lsp-test--find-line file-content line))) + (should-not (null line-number)) + (should (eq (length marker) (length line))) + (should (string-match "^ *\\(\\^+\\) *$" marker)) + (list :line line-number :from (match-beginning 1) :to (match-end 1)))) + +(defun lsp-test-diag-get (diagnostic) (let* ((range (ht-get diagnostic "range")) (start (ht-get range "start")) (end (ht-get range "end"))) @@ -55,10 +64,10 @@ (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) (deferred:sync! (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) (should (eq (length (gethash sample-file (lsp-diagnostics t))) 1)) - (should (equal (lsp-test-diag-get-summary (car (gethash sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make-summary (buffer-string) 1 - "line 1 is here broming and here" - " ^^^^^^^ "))))) + (should (equal (lsp-test-diag-get (car (gethash sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 is here broming and here" + " ^^^^^^^ "))))) (kill-buffer buf) (lsp-workspace-folders-remove workspace-root))) (with-timeout (5 (error "LSP server refuses to stop")) From 491b2438c42a548c2f0e39e6c1df84e935d0c210 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 11:34:22 +0200 Subject: [PATCH 15/53] Small tweaks to the mock server script --- test/mock-lsp-server.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 820c1eabb2..74ad53b506 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -1,7 +1,8 @@ -#!/usr/bin/emacs --script ;; -*- lexical-binding: t; -*- ;; -*- coding: utf-8; -*- +(setq debug-on-error t) + (defun json-rpc-string (body) ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) @@ -78,8 +79,8 @@ (match-string 1 input) nil)) -(let (line stopped) - (while (and (not stopped) (setq line (read-string ""))) +(while t + (let ((line (read-string ""))) (cond ((string-match "method\":\"initialize\"" line) (princ (greeting (get-id line)))) @@ -87,7 +88,7 @@ ;; No need to acknowledge ) ((string-match "method\":\"exit" line) - (setq stopped t)) + (kill-emacs 0)) ((string-match "method\":\"shutdown" line) (princ (shutdown-ack (get-id line)))) ((string-match "didOpen" line) @@ -100,10 +101,8 @@ ) ((get-id line) (princ (ack (get-id line)))) - ((string-match "Content-Length" line) - ;; Ignore header - ) - ((string-match "Content-Type" line) + ((or (string-match "Content-Length" line) + (string-match "Content-Type" line)) ;; Ignore header ) ((string-match "^ $" line) From aeea93d4780111b86fc7409f649658cb5c81704c Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 12:40:17 +0200 Subject: [PATCH 16/53] Enable external command execution in the mock server --- test/mock-lsp-server.el | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 74ad53b506..085d3ca92e 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -3,6 +3,16 @@ (setq debug-on-error t) +(defconst command-file + (expand-file-name "mock-server-commands.el" + (file-name-directory load-file-name))) + +(defun run-command-from-file-if-any () + (if (file-exists-p command-file) + (progn + (load command-file) + (delete-file command-file)))) + (defun json-rpc-string (body) ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) @@ -79,7 +89,7 @@ (match-string 1 input) nil)) -(while t +(defun handle-lsp-client () (let ((line (read-string ""))) (cond ((string-match "method\":\"initialize\"" line) @@ -112,3 +122,7 @@ ;; Ignore other empty lines ) (t (error "unexpected input '%s'" line))))) + +(while t + (run-command-from-file-if-any) + (handle-lsp-client)) From b01f8b2a3ab8e587e01f1b9415fbb7b7b18bc290 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 14:20:40 +0200 Subject: [PATCH 17/53] Move the diagnostic generation from mock server to the test file --- test/mock-lsp-server.el | 45 ++++++++++------------------ test/test-mock-lsp-server.el | 58 ++++++++++++++++++++++++++++++++++-- 2 files changed, 70 insertions(+), 33 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 085d3ca92e..19ca555e85 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -51,33 +51,12 @@ (plist-get diagnostic :message) (plist-get diagnostic :severity))) -(defun point-to-loc (point) - (goto-char point) - (list :line (- (line-number-at-pos point) 1) :character (- (current-column) 1))) - -(defun make-diagnostics (for-file) - (let ((forbidden-word "broming")) - (with-current-buffer (find-file-noselect for-file) - (goto-char (point-min)) - (let (diagnostics) - (while (re-search-forward forbidden-word nil t) - (let ((line (- (line-number-at-pos (point)) 1)) - (end-col (current-column)) - (start-col (- (current-column) (length forbidden-word)))) - (push (list :source "mockS" - :code "E001" - :range (list :start (list :line line :character start-col) - :end (list :line line :character end-col)) - :message (format "Do not use word '%s'" forbidden-word) - :severity 2) - diagnostics))) - diagnostics)))) - -(defun diagnostics (for-file) - (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}}" - for-file - (mapconcat #'diagnostic-to-json (make-diagnostics for-file) ",")))) +(defun publish-diagnostics (diagnostics) + (princ + (json-rpc-string + (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}}" + (plist-get diagnostics :path) + (mapconcat #'diagnostic-to-json (plist-get diagnostics :diags) ","))))) (defun get-id (input) (if (string-match "\"id\":\\([0-9]+\\)" input) @@ -89,7 +68,7 @@ (match-string 1 input) nil)) -(defun handle-lsp-client () +(defun handle-lsp-client-input () (let ((line (read-string ""))) (cond ((string-match "method\":\"initialize\"" line) @@ -102,13 +81,19 @@ ((string-match "method\":\"shutdown" line) (princ (shutdown-ack (get-id line)))) ((string-match "didOpen" line) - (princ (diagnostics (get-file-path line)))) + ;; (princ (diagnostics (get-file-path line))) + ) ((string-match "method\":\"workspace/didChangeConfiguration" line) ;; No need to acknowledge ) ((string-match "method\":\"textDocument/didClose" line) ;; No need to acknowledge ) + ((string-match "$/setTrace" line) + ;; Used as a way to wakt up the server and + ;; execute a command in the command file if any + ;; No need to acknowledge + ) ((get-id line) (princ (ack (get-id line)))) ((or (string-match "Content-Length" line) @@ -125,4 +110,4 @@ (while t (run-command-from-file-if-any) - (handle-lsp-client)) + (handle-lsp-client-input)) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index ccfca07102..bae9745d46 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -6,11 +6,24 @@ ;; Taken from lsp-integration-tests.el (defconst lsp-test-location (file-name-directory (or load-file-name buffer-file-name))) +(defconst lsp-test-mock-server-location + (expand-file-name "mock-lsp-server.el" lsp-test-location)) + +(defconst lsp-test-mock-server-command-file + (expand-file-name "mock-server-commands.el" lsp-test-location)) + +(defun lsp-test-send-command-to-mock-server (command) + ;; Can run only one command at a time + (should (not (file-exists-p lsp-test-mock-server-command-file))) + (write-region command nil lsp-test-mock-server-command-file nil nil nil 'excl) + ;; Nudge the server to find and execute the command + (lsp-notify "$/setTrace" '(:value "messages"))) + (defun register-mock-client () (lsp-register-client (make-lsp-client :new-connection (lsp-stdio-connection - '("emacs" "--script" "/home/necto/proj/lsp-mode/test/mock-lsp-server.el")) + `("emacs" "--script" ,lsp-test-mock-server-location)) :major-modes '(awk-mode) :priority 100 :server-id 'mock-server))) @@ -47,8 +60,34 @@ :from (ht-get start "character") :to (ht-get end "character")))) +(defun lsp-test-make-diagnostics (for-file contents) + (let ((forbidden-word "broming")) + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (let (diagnostics) + (while (re-search-forward forbidden-word nil t) + (let ((line (- (line-number-at-pos (point)) 1)) + (end-col (current-column)) + (start-col (- (current-column) (length forbidden-word)))) + (push (list :source "mockS" + :code "E001" + :range (list :start (list :line line :character start-col) + :end (list :line line :character end-col)) + :message (format "Do not use word '%s'" forbidden-word) + :severity 2) + diagnostics))) + `(:path ,for-file :diags ,diagnostics))))) + +(defun lsp-test-command-send-diags (file-path file-contents) + (let ((diags (lsp-test-make-diagnostics file-path file-contents))) + (lsp-test-send-command-to-mock-server + (format "(publish-diagnostics '%s)" + (prin1-to-string diags))))) + (ert-deftest lsp-mock-server-reports-issues () (let ((lsp-clients (lsp-ht)) ; clear all clients + (lsp-diagnostic-package :none) (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled (workspace-root (f-join lsp-test-location "fixtures/SamplesForMock")) (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) @@ -62,14 +101,27 @@ (lsp) ;; Make sure the server started (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) - (deferred:sync! (lsp-test-wait (gethash sample-file (lsp-diagnostics t)))) + + (lsp-test-wait (eq 'initialized + (lsp--workspace-status (cl-first (lsp-workspaces))))) + (lsp-test-command-send-diags sample-file (buffer-string)) + ;; FIXME: in the case of a failed test, this will hang forever, + ;; need to find a way to terminate it cleanly + (deferred:sync! (lsp-test-wait (progn + ;; TODO: check workspace still exists + ;; If I crash the server, I get a type error + ;; ~~ wrong type of argument lsp--workspace + (gethash sample-file (lsp-diagnostics t))))) (should (eq (length (gethash sample-file (lsp-diagnostics t))) 1)) (should (equal (lsp-test-diag-get (car (gethash sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) "line 1 is here broming and here" " ^^^^^^^ "))))) (kill-buffer buf) - (lsp-workspace-folders-remove workspace-root))) + (lsp-workspace-folders-remove workspace-root) + ;; Remove possibly unhandled commands + (when (file-exists-p lsp-test-mock-server-command-file) + (delete-file lsp-test-mock-server-command-file)))) (with-timeout (5 (error "LSP server refuses to stop")) ;; Make sure the server stopped (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))) From d724adc1d2741c36a87d8d603052b45a72cab343 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 17:38:15 +0200 Subject: [PATCH 18/53] Use sync wait, add a test for crashing a server --- test/test-mock-lsp-server.el | 81 +++++++++++++++++++++++++----------- 1 file changed, 57 insertions(+), 24 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index bae9745d46..bd27062f53 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -12,6 +12,9 @@ (defconst lsp-test-mock-server-command-file (expand-file-name "mock-server-commands.el" lsp-test-location)) +(defconst lsp-test-sample-file + (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) + (defun lsp-test-send-command-to-mock-server (command) ;; Can run only one command at a time (should (not (file-exists-p lsp-test-mock-server-command-file))) @@ -85,43 +88,73 @@ (format "(publish-diagnostics '%s)" (prin1-to-string diags))))) -(ert-deftest lsp-mock-server-reports-issues () +(defun lsp-test-crash-server-with-message (message) + (lsp-test-send-command-to-mock-server (format "(error %S)" message))) + +(defun lsp-test--sync-wait-for (condition-func) + (let ((result (funcall condition-func))) + (while (not result) + (sleep-for 0.05) + (setq result (funcall condition-func))) + result)) + +(defmacro lsp-test-sync-wait (condition) + `(lsp-test--sync-wait-for (lambda () ,condition))) + +(defun lsp-mock--run-with-mock-server (test-body) (let ((lsp-clients (lsp-ht)) ; clear all clients - (lsp-diagnostic-package :none) + (lsp-diagnostic-package :none) ; focus on LSP itself, not its UI integration + (lsp-restart 'ignore) ; Avoid restarting the server or prompting user on a crash (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled - (workspace-root (f-join lsp-test-location "fixtures/SamplesForMock")) - (sample-file (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) + (workspace-root (file-name-directory lsp-test-sample-file)) (initial-server-count (lsp-test-total-server-count))) (register-mock-client) ; register mock client as the one an only lsp client (lsp-workspace-folders-add workspace-root) - (let* ((buf (find-file-noselect sample-file))) + (let* ((buf (find-file-noselect lsp-test-sample-file))) (unwind-protect - (with-timeout (5 (error "Timeout trying to get diagnostics from mock server")) + (with-timeout (5 (error "Timeout running a test with mock server")) (with-current-buffer buf (lsp) ;; Make sure the server started (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) - - (lsp-test-wait (eq 'initialized - (lsp--workspace-status (cl-first (lsp-workspaces))))) - (lsp-test-command-send-diags sample-file (buffer-string)) - ;; FIXME: in the case of a failed test, this will hang forever, - ;; need to find a way to terminate it cleanly - (deferred:sync! (lsp-test-wait (progn - ;; TODO: check workspace still exists - ;; If I crash the server, I get a type error - ;; ~~ wrong type of argument lsp--workspace - (gethash sample-file (lsp-diagnostics t))))) - (should (eq (length (gethash sample-file (lsp-diagnostics t))) 1)) - (should (equal (lsp-test-diag-get (car (gethash sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 is here broming and here" - " ^^^^^^^ "))))) + (lsp-test-sync-wait (eq 'initialized + (lsp--workspace-status (cl-first (lsp-workspaces))))) + (funcall test-body))) (kill-buffer buf) (lsp-workspace-folders-remove workspace-root) ;; Remove possibly unhandled commands (when (file-exists-p lsp-test-mock-server-command-file) (delete-file lsp-test-mock-server-command-file)))) - (with-timeout (5 (error "LSP server refuses to stop")) + (with-timeout (5 (error "LSP mock server refuses to stop")) ;; Make sure the server stopped - (deferred:sync! (lsp-test-wait (= initial-server-count (lsp-test-total-server-count))))))) + (lsp-test-sync-wait (= initial-server-count (lsp-test-total-server-count)))))) + +(defmacro lsp-mock-run-with-mock-server (&rest test-body) + `(lsp-mock--run-with-mock-server (lambda () ,@test-body))) + +(ert-deftest lsp-mock-server-reports-issues () + (lsp-mock-run-with-mock-server + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string)) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 is here broming and here" + " ^^^^^^^ "))))) + +(ert-deftest lsp-mock-server-crashes () + (let ((initial-serv-count (lsp-test-total-server-count))) + (when-let ((buffer (get-buffer "*mock-server::stderr*"))) + (kill-buffer buffer)) + + (lsp-mock-run-with-mock-server + (should (eq (lsp-test-total-server-count) (1+ initial-serv-count))) + (lsp-test-crash-server-with-message "crashed by command") + (lsp-test-sync-wait (eq initial-serv-count (lsp-test-total-server-count))) + (let ((buffer (get-buffer "*mock-server::stderr*"))) + (should buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (should (search-forward "crashed by command")) + (goto-char (point-max))))))) From 8c6b7ae2f5ec8a3a674c4175ffa2e94a29cb2997 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 17:56:45 +0200 Subject: [PATCH 19/53] Add test for diagnostic update --- test/test-mock-lsp-server.el | 83 ++++++++++++++++++++++++++---------- 1 file changed, 60 insertions(+), 23 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index bd27062f53..2d10e36d40 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -63,27 +63,26 @@ :from (ht-get start "character") :to (ht-get end "character")))) -(defun lsp-test-make-diagnostics (for-file contents) - (let ((forbidden-word "broming")) - (with-temp-buffer - (insert contents) - (goto-char (point-min)) - (let (diagnostics) - (while (re-search-forward forbidden-word nil t) - (let ((line (- (line-number-at-pos (point)) 1)) - (end-col (current-column)) - (start-col (- (current-column) (length forbidden-word)))) - (push (list :source "mockS" - :code "E001" - :range (list :start (list :line line :character start-col) - :end (list :line line :character end-col)) - :message (format "Do not use word '%s'" forbidden-word) - :severity 2) - diagnostics))) - `(:path ,for-file :diags ,diagnostics))))) - -(defun lsp-test-command-send-diags (file-path file-contents) - (let ((diags (lsp-test-make-diagnostics file-path file-contents))) +(defun lsp-test-make-diagnostics (for-file contents forbidden-word) + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (let (diagnostics) + (while (re-search-forward forbidden-word nil t) + (let ((line (- (line-number-at-pos (point)) 1)) + (end-col (current-column)) + (start-col (- (current-column) (length forbidden-word)))) + (push (list :source "mockS" + :code "E001" + :range (list :start (list :line line :character start-col) + :end (list :line line :character end-col)) + :message (format "Do not use word '%s'" forbidden-word) + :severity 2) + diagnostics))) + `(:path ,for-file :diags ,diagnostics)))) + +(defun lsp-test-command-send-diags (file-path file-contents forbidden-word) + (let ((diags (lsp-test-make-diagnostics file-path file-contents forbidden-word))) (lsp-test-send-command-to-mock-server (format "(publish-diagnostics '%s)" (prin1-to-string diags))))) @@ -134,7 +133,8 @@ (ert-deftest lsp-mock-server-reports-issues () (lsp-mock-run-with-mock-server - (lsp-test-command-send-diags lsp-test-sample-file (buffer-string)) + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") (lsp-test-sync-wait (progn (should (lsp-workspaces)) (gethash lsp-test-sample-file (lsp-diagnostics t)))) (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) @@ -147,7 +147,6 @@ (let ((initial-serv-count (lsp-test-total-server-count))) (when-let ((buffer (get-buffer "*mock-server::stderr*"))) (kill-buffer buffer)) - (lsp-mock-run-with-mock-server (should (eq (lsp-test-total-server-count) (1+ initial-serv-count))) (lsp-test-crash-server-with-message "crashed by command") @@ -158,3 +157,41 @@ (goto-char (point-min)) (should (search-forward "crashed by command")) (goto-char (point-max))))))) + +(defun lsp-mock-get-first-diagnostic-line () + (let ((diags (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (when diags + (let* ((diag (car diags)) + (range (ht-get diag "range")) + (start (ht-get range "start"))) + (ht-get start "line"))))) + +(ert-deftest lsp-mock-server-updates-issues () + (lsp-mock-run-with-mock-server + ;; There are no diagnostics at first + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) + + ;; Server found diagnostic + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) + + ;; The diagnostic is properly received + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 is here broming and here" + " ^^^^^^^ "))) + + ;; Server found a different diagnostic + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "member") + (let ((old-line (lsp-mock-get-first-diagnostic-line))) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (not (equal old-line (lsp-mock-get-first-diagnostic-line)))))) + + ;; The new diagnostics is properly displayed instead of the old one + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "heyho! Hi I'm a new member here." + " ^^^^^^ "))))) From dcead048fd017d8196c2f28caf3f538c1f901c4d Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 18:28:03 +0200 Subject: [PATCH 20/53] Demonstrate how diagnostics get stale --- test/test-mock-lsp-server.el | 57 ++++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 5 deletions(-) diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index 2d10e36d40..44d2ee8d1a 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -1,7 +1,6 @@ ;;; test-mock-lsp-server.el --- unit test utilities -*- lexical-binding: t -*- (require 'lsp-mode) -(require 'lsp-test-utils) ;; Taken from lsp-integration-tests.el (defconst lsp-test-location (file-name-directory (or load-file-name buffer-file-name))) @@ -102,9 +101,9 @@ (defun lsp-mock--run-with-mock-server (test-body) (let ((lsp-clients (lsp-ht)) ; clear all clients - (lsp-diagnostic-package :none) ; focus on LSP itself, not its UI integration + (lsp-diagnostics-provider :none) ; focus on LSP itself, not its UI integration (lsp-restart 'ignore) ; Avoid restarting the server or prompting user on a crash - (lsp-enable-snippets nil) ; Avoid warning that lsp-yasnippet is not intalled + (lsp-enable-snippet nil) ; Avoid warning that lsp-yasnippet is not intalled (workspace-root (file-name-directory lsp-test-sample-file)) (initial-server-count (lsp-test-total-server-count))) (register-mock-client) ; register mock client as the one an only lsp client @@ -119,7 +118,9 @@ (lsp-test-sync-wait (eq 'initialized (lsp--workspace-status (cl-first (lsp-workspaces))))) (funcall test-body))) - (kill-buffer buf) + (with-current-buffer buf + (set-buffer-modified-p nil); Inhibut the "kill unsaved buffer"p prompt + (kill-buffer buf)) (lsp-workspace-folders-remove workspace-root) ;; Remove possibly unhandled commands (when (file-exists-p lsp-test-mock-server-command-file) @@ -166,7 +167,7 @@ (start (ht-get range "start"))) (ht-get start "line"))))) -(ert-deftest lsp-mock-server-updates-issues () +(ert-deftest lsp-mock-server-updates-diagnostics () (lsp-mock-run-with-mock-server ;; There are no diagnostics at first (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) @@ -195,3 +196,49 @@ (lsp-test-diag-make (buffer-string) "heyho! Hi I'm a new member here." " ^^^^^^ "))))) + +(ert-deftest lsp-mock-server-updates-diags-with-delay () + (lsp-mock-run-with-mock-server + ;; There are no diagnostics at first + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) + + ;; Server found diagnostic + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) + + ;; The diagnostic is properly received + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 is here broming and here" + " ^^^^^^^ "))) + + ;; Change the text: remove the first line + (goto-char (point-min)) + (kill-line 1) + (should (string-equal (buffer-string) + "line 1 is here broming and here +line 2 is here normalw and here +line 3 is here and here +")) + ;; Give it some time to update + (sleep-for 0.5) + ;; The diagnostic is not updated and now points to a wrong line + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 2 is here normalw and here" + " ^^^^^^^ "))) + + ;; Server sent an update + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") + + (let ((old-line (lsp-mock-get-first-diagnostic-line))) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (not (equal old-line (lsp-mock-get-first-diagnostic-line)))))) + + ;; Now the diagnostic is correct again + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 is here broming and here" + " ^^^^^^^ "))))) From 3cdd1c9d96d779cdeb023ccb4fecc0c2583867a1 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 18:47:39 +0200 Subject: [PATCH 21/53] Rename sample.awk to sample.txt and use prog-mode; reasonable content --- test/fixtures/SamplesForMock/sample.awk | 4 --- test/fixtures/SamplesForMock/sample.txt | 4 +++ test/test-mock-lsp-server.el | 38 +++++++++++++------------ 3 files changed, 24 insertions(+), 22 deletions(-) delete mode 100644 test/fixtures/SamplesForMock/sample.awk create mode 100644 test/fixtures/SamplesForMock/sample.txt diff --git a/test/fixtures/SamplesForMock/sample.awk b/test/fixtures/SamplesForMock/sample.awk deleted file mode 100644 index b236156403..0000000000 --- a/test/fixtures/SamplesForMock/sample.awk +++ /dev/null @@ -1,4 +0,0 @@ -heyho! Hi I'm a new member here. -line 1 is here broming and here -line 2 is here normalw and here -line 3 is here and here diff --git a/test/fixtures/SamplesForMock/sample.txt b/test/fixtures/SamplesForMock/sample.txt new file mode 100644 index 0000000000..c2e6b1ec30 --- /dev/null +++ b/test/fixtures/SamplesForMock/sample.txt @@ -0,0 +1,4 @@ +Line 0 unique word fegam and common +line 1 unique word broming + common +line 2 unique word normalw common here +line 3 words here and here diff --git a/test/test-mock-lsp-server.el b/test/test-mock-lsp-server.el index 44d2ee8d1a..d26b13851c 100644 --- a/test/test-mock-lsp-server.el +++ b/test/test-mock-lsp-server.el @@ -12,7 +12,7 @@ (expand-file-name "mock-server-commands.el" lsp-test-location)) (defconst lsp-test-sample-file - (f-join lsp-test-location "fixtures/SamplesForMock/sample.awk")) + (f-join lsp-test-location "fixtures/SamplesForMock/sample.txt")) (defun lsp-test-send-command-to-mock-server (command) ;; Can run only one command at a time @@ -26,7 +26,7 @@ (make-lsp-client :new-connection (lsp-stdio-connection `("emacs" "--script" ,lsp-test-mock-server-location)) - :major-modes '(awk-mode) + :major-modes '(prog-mode) :priority 100 :server-id 'mock-server))) @@ -104,6 +104,7 @@ (lsp-diagnostics-provider :none) ; focus on LSP itself, not its UI integration (lsp-restart 'ignore) ; Avoid restarting the server or prompting user on a crash (lsp-enable-snippet nil) ; Avoid warning that lsp-yasnippet is not intalled + (lsp-warn-no-matched-clients nil) ; Mute warning LSP can't figure out src lang (workspace-root (file-name-directory lsp-test-sample-file)) (initial-server-count (lsp-test-total-server-count))) (register-mock-client) ; register mock client as the one an only lsp client @@ -112,6 +113,7 @@ (unwind-protect (with-timeout (5 (error "Timeout running a test with mock server")) (with-current-buffer buf + (prog-mode) (lsp) ;; Make sure the server started (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) @@ -141,8 +143,8 @@ (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "line 1 is here broming and here" - " ^^^^^^^ "))))) + "line 1 unique word broming + common" + " ^^^^^^^ "))))) (ert-deftest lsp-mock-server-crashes () (let ((initial-serv-count (lsp-test-total-server-count))) @@ -181,11 +183,11 @@ ;; The diagnostic is properly received (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "line 1 is here broming and here" - " ^^^^^^^ "))) + "line 1 unique word broming + common" + " ^^^^^^^ "))) ;; Server found a different diagnostic - (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "member") + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "fegam") (let ((old-line (lsp-mock-get-first-diagnostic-line))) (lsp-test-sync-wait (progn (should (lsp-workspaces)) (not (equal old-line (lsp-mock-get-first-diagnostic-line)))))) @@ -194,8 +196,8 @@ (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "heyho! Hi I'm a new member here." - " ^^^^^^ "))))) + "Line 0 unique word fegam and common" + " ^^^^^ "))))) (ert-deftest lsp-mock-server-updates-diags-with-delay () (lsp-mock-run-with-mock-server @@ -211,24 +213,24 @@ ;; The diagnostic is properly received (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "line 1 is here broming and here" - " ^^^^^^^ "))) + "line 1 unique word broming + common" + " ^^^^^^^ "))) ;; Change the text: remove the first line (goto-char (point-min)) (kill-line 1) (should (string-equal (buffer-string) - "line 1 is here broming and here -line 2 is here normalw and here -line 3 is here and here + "line 1 unique word broming + common +line 2 unique word normalw common here +line 3 words here and here ")) ;; Give it some time to update (sleep-for 0.5) ;; The diagnostic is not updated and now points to a wrong line (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "line 2 is here normalw and here" - " ^^^^^^^ "))) + "line 2 unique word normalw common here" + " ^^^^^^^ "))) ;; Server sent an update (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") @@ -240,5 +242,5 @@ line 3 is here and here ;; Now the diagnostic is correct again (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) (lsp-test-diag-make (buffer-string) - "line 1 is here broming and here" - " ^^^^^^^ "))))) + "line 1 unique word broming + common" + " ^^^^^^^ "))))) From eeedabbfdb06a1fb739d06be3a54e3064c83620c Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 19:08:56 +0200 Subject: [PATCH 22/53] Factor out the list of ignored notifications in the mock lsp server --- test/mock-lsp-server.el | 41 ++++++++++++++++++++--------------------- 1 file changed, 20 insertions(+), 21 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 19ca555e85..92c0d7801f 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -26,7 +26,7 @@ ;; - foldingRangeProvider (defun greeting (id) (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"serverInfo\":{\"name\":\"mockS\",\"version\":\"1.3.3\"}}}" + (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"serverInfo\":{\"name\":\"mockS\",\"version\":\"0.0.1\"}}}" id))) (defun ack (id) @@ -68,42 +68,41 @@ (match-string 1 input) nil)) +(defconst notification-methods '("\"method\":\"initialized\"" + "\"method\":\"textDocument/didOpen\"" + "\"method\":\"textDocument/didClose\"" + "\"method\":\"$/setTrace\"" + "\"method\":\"workspace/didChangeConfiguration\"")) + +(defun is-notification (input) + (catch 'found + (dolist (n notification-methods) + (when (string-match-p n input) + (throw 'found t))) + nil)) + (defun handle-lsp-client-input () (let ((line (read-string ""))) (cond ((string-match "method\":\"initialize\"" line) (princ (greeting (get-id line)))) - ((string-match "method\":\"initialized\"" line) - ;; No need to acknowledge - ) ((string-match "method\":\"exit" line) (kill-emacs 0)) ((string-match "method\":\"shutdown" line) (princ (shutdown-ack (get-id line)))) - ((string-match "didOpen" line) - ;; (princ (diagnostics (get-file-path line))) - ) - ((string-match "method\":\"workspace/didChangeConfiguration" line) - ;; No need to acknowledge - ) - ((string-match "method\":\"textDocument/didClose" line) - ;; No need to acknowledge - ) - ((string-match "$/setTrace" line) - ;; Used as a way to wakt up the server and - ;; execute a command in the command file if any - ;; No need to acknowledge + ((is-notification line) + ;; No need to acknowledge a notification ) ((get-id line) + ;; It has an id, probably some request + ;; Acknowledge that it is received (princ (ack (get-id line)))) ((or (string-match "Content-Length" line) (string-match "Content-Type" line)) ;; Ignore header ) - ((string-match "^ $" line) - ;; Ignore the empty lines delimitting header and content - ) - ((string-match "^$" line) + ((or (string-match "^ $" line) + (string-match "^$" line)) ;; Ignore other empty lines ) (t (error "unexpected input '%s'" line))))) From aa81a5e4203b7d0d6cb8113d482c80ec04abe780 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 19:19:55 +0200 Subject: [PATCH 23/53] Follow the convention in the test file name --- test/{test-mock-lsp-server.el => lsp-test-mock-server.el} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test/{test-mock-lsp-server.el => lsp-test-mock-server.el} (100%) diff --git a/test/test-mock-lsp-server.el b/test/lsp-test-mock-server.el similarity index 100% rename from test/test-mock-lsp-server.el rename to test/lsp-test-mock-server.el From 0505bbadf41bfa5e3d505d4e7bd7a551e5d6152f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 19:20:50 +0200 Subject: [PATCH 24/53] Better name for the mock lsp server test file --- test/{lsp-test-mock-server.el => lsp-mock-server-test.el} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename test/{lsp-test-mock-server.el => lsp-mock-server-test.el} (100%) diff --git a/test/lsp-test-mock-server.el b/test/lsp-mock-server-test.el similarity index 100% rename from test/lsp-test-mock-server.el rename to test/lsp-mock-server-test.el From bf489d578a127ba876537f0ce938674ce43177e5 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 19:35:56 +0200 Subject: [PATCH 25/53] Add a header comment --- test/mock-lsp-server.el | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 92c0d7801f..57ed581b0d 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -1,5 +1,35 @@ -;; -*- lexical-binding: t; -*- -;; -*- coding: utf-8; -*- +;;; mock-lsp-server.el --- Mock LSP server -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2024 emacs-lsp maintainers + +;; Author: Arseniy Zaostrovnykh +;; Package-Requires: ((emacs "27.1")) +;; Version: 0.0.1 +;; License: GPL-3.0-or-later + +;; URL: https://github.com/emacs-lsp/lsp-mode +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; A mock implementation of a Language Server Protocol server for testing +;; of the LSP client in lsp-mode. +;; The server reads commands from a file `mock-server-commands.el` in the +;; same directory as this file. The commands are elisp code that is loaded +;; and executed by the server. + +;;; Code: (setq debug-on-error t) @@ -110,3 +140,5 @@ (while t (run-command-from-file-if-any) (handle-lsp-client-input)) + +;;; mock-lsp-server.el ends here From be4404d577752acd0ff0fc0619ddde588b142d90 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 19:41:19 +0200 Subject: [PATCH 26/53] Add header comment --- test/lsp-mock-server-test.el | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index d26b13851c..1fa024cac2 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -1,4 +1,35 @@ -;;; test-mock-lsp-server.el --- unit test utilities -*- lexical-binding: t -*- +;;; lsp-mock-server-test.el --- Unit test utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2024-2024 emacs-lsp maintainers + +;; Author: Arseniy Zaostrovnykh +;; Package-Requires: ((emacs "27.1")) +;; Version: 0.0.1 +;; License: GPL-3.0-or-later + +;; URL: https://github.com/emacs-lsp/lsp-mode +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; A collection of tests that check lsp-mode interaction with +;; an lsp server mocked by mock-lsp-server.el +;; The tests define a custom lsp client execute scenarios +;; such as opening a file, chagning it, or receiving updated diagnostics +;; and assert how lsp-mode updates the diagnostics. + +;;; Code: (require 'lsp-mode) @@ -244,3 +275,6 @@ line 3 words here and here (lsp-test-diag-make (buffer-string) "line 1 unique word broming + common" " ^^^^^^^ "))))) + +(provide 'lsp-mock-server-test) +;;; lsp-mock-server-test.el ends here From b99bfb25a170e94d70f12b6414a66dae62a496f9 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 22:14:12 +0200 Subject: [PATCH 27/53] Test demonstrating diagnostic clearup after a change --- test/lsp-mock-server-test.el | 41 +++++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 1fa024cac2..b79da4af57 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -276,5 +276,44 @@ line 3 words here and here "line 1 unique word broming + common" " ^^^^^^^ "))))) -(provide 'lsp-mock-server-test) +(ert-deftest lsp-mock-server-updates-diags-clears-up () + "Test ensuring diagnostics are cleared after a change." + (let ((lsp-diagnostic-clean-after-change t)) + (lsp-mock-run-with-mock-server + ;; There are no diagnostics at first + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) + + ;; Server found diagnostic + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) + + ;; The diagnostic is properly received + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))) + + ;; Change the text: remove the first line + (goto-char (point-min)) + (kill-line 1) + + ;; After a short while, diagnostics are cleared up + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (null (gethash lsp-test-sample-file (lsp-diagnostics t))))) + + ;; Server sent an update + (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") + + (let ((old-line (lsp-mock-get-first-diagnostic-line))) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (not (equal old-line (lsp-mock-get-first-diagnostic-line)))))) + + ;; Now the diagnostic is correct again + (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) + (lsp-test-diag-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ ")))))) + ;;; lsp-mock-server-test.el ends here From 58d58ea454158c9a65b55c696dec815d02f74063 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Fri, 19 Jul 2024 22:14:26 +0200 Subject: [PATCH 28/53] Doc strings for the mock server test --- test/lsp-mock-server-test.el | 89 +++++++++++++++++++++++++++++++----- 1 file changed, 78 insertions(+), 11 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index b79da4af57..2792db2084 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -34,18 +34,27 @@ (require 'lsp-mode) ;; Taken from lsp-integration-tests.el -(defconst lsp-test-location (file-name-directory (or load-file-name buffer-file-name))) +(defconst lsp-test-location (file-name-directory (or load-file-name buffer-file-name)) + "Directory of the tests containing mock server and fixtures.") (defconst lsp-test-mock-server-location - (expand-file-name "mock-lsp-server.el" lsp-test-location)) + (expand-file-name "mock-lsp-server.el" lsp-test-location) + "Path to the mock server script.") (defconst lsp-test-mock-server-command-file - (expand-file-name "mock-server-commands.el" lsp-test-location)) + (expand-file-name "mock-server-commands.el" lsp-test-location) + "File mock server reads commands from.") (defconst lsp-test-sample-file - (f-join lsp-test-location "fixtures/SamplesForMock/sample.txt")) + (f-join lsp-test-location "fixtures/SamplesForMock/sample.txt") + "The sample file used to conduct tests upon.") (defun lsp-test-send-command-to-mock-server (command) + "Pass the given COMMAND to the mock server. + +It uses the pre-configured file to write command to, then sends a +notification to the server so that it looks into the file and +executes the command." ;; Can run only one command at a time (should (not (file-exists-p lsp-test-mock-server-command-file))) (write-region command nil lsp-test-mock-server-command-file nil nil nil 'excl) @@ -53,6 +62,7 @@ (lsp-notify "$/setTrace" '(:value "messages"))) (defun register-mock-client () + "Register mock client that spawns the mock server." (lsp-register-client (make-lsp-client :new-connection (lsp-stdio-connection @@ -61,10 +71,12 @@ :priority 100 :server-id 'mock-server))) -(defun lsp-test-total-server-count () +(defun lsp-test-total-folder-count () + "Count total number of active root folders in the session." (hash-table-count (lsp-session-folder->servers (lsp-session)))) (defun lsp-test--find-line (file-content line) + "Find LINE in the multi-line FILE-CONTENT string." (let ((lines (split-string file-content "\n")) (line-number 0) (found nil)) @@ -78,6 +90,20 @@ found)) (defun lsp-test-diag-make (file-content line marker) + "Create a single-line diagnostics range summary. + +Find LINE in FILE-CONTENT and take that as the line number. +Set the :from and :to characters to reflect the position of +`^^^^' in the MARKER. + +Example (suppose line #3 of current buffer is \"full line\"): + +(lsp-test-diag-make (buffer-string) + \"full line\" + \" ^^^^\") + +-> (:line 3 :from 5 :to 8) +" (let ((line-number (lsp-test--find-line file-content line))) (should-not (null line-number)) (should (eq (length marker) (length line))) @@ -85,6 +111,10 @@ (list :line line-number :from (match-beginning 1) :to (match-end 1)))) (defun lsp-test-diag-get (diagnostic) + "Get the single-line diagnostics range summary of DIAGNOSTIC. + +DIAGNOSTIC must have a single-line range. +Returns its range converted to `(:line .. :from .. :to ..)' format." (let* ((range (ht-get diagnostic "range")) (start (ht-get range "start")) (end (ht-get range "end"))) @@ -94,6 +124,14 @@ :to (ht-get end "character")))) (defun lsp-test-make-diagnostics (for-file contents forbidden-word) + "Come up with a diagnostic highlighting FORBIDDEN-WORD. + +Scan CONTENTS for FORBIDDEN-WORD and produce diagnostics for each occurence. +Returns a p-list compatible with the mock server. + +FOR-FILE is the path to the file to include in the diagnostics. +It might not contain exactly CONTENTS because it the diagnostic +might be generated for a modified and not saved buffer content." (with-temp-buffer (insert contents) (goto-char (point-min)) @@ -112,15 +150,26 @@ `(:path ,for-file :diags ,diagnostics)))) (defun lsp-test-command-send-diags (file-path file-contents forbidden-word) + "Generate and command the mock server to publish diagnostics. + +Command the mock server to publish diagnostics highlighting every occurence of +FORBIDDEN-WORD in FILE-CONTENTS that corresponds to FILE-PATH." (let ((diags (lsp-test-make-diagnostics file-path file-contents forbidden-word))) (lsp-test-send-command-to-mock-server (format "(publish-diagnostics '%s)" (prin1-to-string diags))))) (defun lsp-test-crash-server-with-message (message) + "Command the mock server to crash with MESSAGE." (lsp-test-send-command-to-mock-server (format "(error %S)" message))) +;; I could not figure out how to use lsp-test-wait safely +;; (e.g., aborting it after a failed test), so I use a simpler +;; version. (defun lsp-test--sync-wait-for (condition-func) + "Synchronously waiting for CONDITION-FUNC to return non-nil. + +Returns the non-nil return value of CONDITION-FUNC." (let ((result (funcall condition-func))) (while (not result) (sleep-for 0.05) @@ -128,16 +177,21 @@ result)) (defmacro lsp-test-sync-wait (condition) + "Wait for the CONDITION to become non-nil and return it." `(lsp-test--sync-wait-for (lambda () ,condition))) (defun lsp-mock--run-with-mock-server (test-body) + "Run TEST-BODY function with mock LSP client connected to the mock server. + +This is an environment function that configures lsp-mode, mock lsp-client, +opens the `lsp-test-sample-file' and starts the mock server." (let ((lsp-clients (lsp-ht)) ; clear all clients (lsp-diagnostics-provider :none) ; focus on LSP itself, not its UI integration (lsp-restart 'ignore) ; Avoid restarting the server or prompting user on a crash (lsp-enable-snippet nil) ; Avoid warning that lsp-yasnippet is not intalled (lsp-warn-no-matched-clients nil) ; Mute warning LSP can't figure out src lang (workspace-root (file-name-directory lsp-test-sample-file)) - (initial-server-count (lsp-test-total-server-count))) + (initial-server-count (lsp-test-total-folder-count))) (register-mock-client) ; register mock client as the one an only lsp client (lsp-workspace-folders-add workspace-root) (let* ((buf (find-file-noselect lsp-test-sample-file))) @@ -147,7 +201,7 @@ (prog-mode) (lsp) ;; Make sure the server started - (should (eq (lsp-test-total-server-count) (1+ initial-server-count))) + (should (eq (lsp-test-total-folder-count) (1+ initial-server-count))) (lsp-test-sync-wait (eq 'initialized (lsp--workspace-status (cl-first (lsp-workspaces))))) (funcall test-body))) @@ -160,9 +214,13 @@ (delete-file lsp-test-mock-server-command-file)))) (with-timeout (5 (error "LSP mock server refuses to stop")) ;; Make sure the server stopped - (lsp-test-sync-wait (= initial-server-count (lsp-test-total-server-count)))))) + (lsp-test-sync-wait (= initial-server-count (lsp-test-total-folder-count)))))) (defmacro lsp-mock-run-with-mock-server (&rest test-body) + "Evaluate TEST-BODY in the context of a mock client connected to mock server. + +Opens the `lsp-test-sample-file' and initiates the LSP session. +TEST-BODY can interact with the mock server." `(lsp-mock--run-with-mock-server (lambda () ,@test-body))) (ert-deftest lsp-mock-server-reports-issues () @@ -178,13 +236,14 @@ " ^^^^^^^ "))))) (ert-deftest lsp-mock-server-crashes () - (let ((initial-serv-count (lsp-test-total-server-count))) + "Test that the mock server crashes when instructed so." + (let ((initial-serv-count (lsp-test-total-folder-count))) (when-let ((buffer (get-buffer "*mock-server::stderr*"))) (kill-buffer buffer)) (lsp-mock-run-with-mock-server - (should (eq (lsp-test-total-server-count) (1+ initial-serv-count))) + (should (eq (lsp-test-total-folder-count) (1+ initial-serv-count))) (lsp-test-crash-server-with-message "crashed by command") - (lsp-test-sync-wait (eq initial-serv-count (lsp-test-total-server-count))) + (lsp-test-sync-wait (eq initial-serv-count (lsp-test-total-folder-count))) (let ((buffer (get-buffer "*mock-server::stderr*"))) (should buffer) (with-current-buffer buffer @@ -193,6 +252,7 @@ (goto-char (point-max))))))) (defun lsp-mock-get-first-diagnostic-line () + "Get the line number of the first diagnostic on `lsp-test-sample-file'." (let ((diags (gethash lsp-test-sample-file (lsp-diagnostics t)))) (when diags (let* ((diag (car diags)) @@ -201,6 +261,7 @@ (ht-get start "line"))))) (ert-deftest lsp-mock-server-updates-diagnostics () + "Test that mock server can update diagnostics and lsp-mode reflects that." (lsp-mock-run-with-mock-server ;; There are no diagnostics at first (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) @@ -231,6 +292,12 @@ " ^^^^^ "))))) (ert-deftest lsp-mock-server-updates-diags-with-delay () + "Test demonstrating delay in the diagnostics update. + +If server takes noticeable time to update diagnostics after a +document change, and `lsp-diagnostic-clean-after-change' is +nil (default), diagnostic ranges will be off until server +publishes the update. This test demonstrates this behavior." (lsp-mock-run-with-mock-server ;; There are no diagnostics at first (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 0)) From 45631dc690cf4e72f3c99b47022b3730595eeb2a Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 05:33:20 +0200 Subject: [PATCH 29/53] Doc strings for mock lsp server --- test/mock-lsp-server.el | 63 ++++++++++++++++++++++++++++++----------- 1 file changed, 47 insertions(+), 16 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 57ed581b0d..973af4a6f5 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -25,25 +25,41 @@ ;; A mock implementation of a Language Server Protocol server for testing ;; of the LSP client in lsp-mode. -;; The server reads commands from a file `mock-server-commands.el` in the -;; same directory as this file. The commands are elisp code that is loaded -;; and executed by the server. +;; +;; The server reads commands from a file `mock-server-commands.el` in the same +;; directory as this file. The commands are elisp code that is loaded and +;; executed by the server. It deletes the file after executing the command +;; indicating readiness for the next one. +;; +;; Due to `emacs --script` limitations, the server cannot watch two inputs +;; concurrently: +;; - stdin for the client input +;; - the mock-server-commands.el file for the commands +;; +;; Therefore, the server alternates between the two. It waits for the next +;; client input, and only after processing one can take and execute a command. +;; As a consequence, you should make sure to send a notification from the client +;; once you have created the command file with a command. ;;; Code: +;; To ease debugging, print the stack trace on failure (setq debug-on-error t) (defconst command-file (expand-file-name "mock-server-commands.el" - (file-name-directory load-file-name))) + (file-name-directory load-file-name)) + "Path to the file where the server expects external commands.") (defun run-command-from-file-if-any () + "If there is the `command-file', execute and delete it." (if (file-exists-p command-file) (progn (load command-file) (delete-file command-file)))) (defun json-rpc-string (body) + "Format BODY as a JSON RPC message suitable for LSP." ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) @@ -55,33 +71,44 @@ ;; - referencesProvider? ;; - foldingRangeProvider (defun greeting (id) + "Compose the greeting message in response to `initialize' request with id ID." (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"serverInfo\":{\"name\":\"mockS\",\"version\":\"0.0.1\"}}}" id))) (defun ack (id) + "Acknowledge a request with id ID." (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id))) (defun shutdown-ack (id) + "Acknowledge a `shutdown' request with id ID." (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id))) (defun loc-to-json (loc) + "Convert (:line .. :character ..) LOC to a serialized JSON object." (format "{\"line\":%d,\"character\":%d}" (plist-get loc :line) (plist-get loc :character))) (defun range-to-json (range) + "Convert (:start .. :end ..) RANGE to a serialized JSON object." (format "{\"start\":%s,\"end\":%s}" (loc-to-json (plist-get range :start)) (loc-to-json (plist-get range :end)))) (defun diagnostic-to-json (diagnostic) - (format "{\"source\":\"%s\",\"code\":\"%s\",\"range\":%s,\"message\":\"%s\",\"severity\":%d}" - (plist-get diagnostic :source) - (plist-get diagnostic :code) - (range-to-json (plist-get diagnostic :range)) - (plist-get diagnostic :message) - (plist-get diagnostic :severity))) + "Convert DIAGNOSTIC to a serialized JSON object." + (format "{\"source\":\"%s\",\"code\":\"%s\",\"range\":%s,\"message\":\"%s\",\"severity\":%d}" + (plist-get diagnostic :source) + (plist-get diagnostic :code) + (range-to-json (plist-get diagnostic :range)) + (plist-get diagnostic :message) + (plist-get diagnostic :severity))) (defun publish-diagnostics (diagnostics) + "Send JSON RPC message textDocument/PublishDiagnostics with DAGNOSTICS. + +DIAGNOSICS must be a p-list (:path PATH :diags DIAGS), +where DIAGS is a list of p-lists in the form +(:source .. :code .. :range .. :message .. :severity ..)." (princ (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}}" @@ -89,22 +116,22 @@ (mapconcat #'diagnostic-to-json (plist-get diagnostics :diags) ","))))) (defun get-id (input) + "Extract request id from INPUT JSON message." (if (string-match "\"id\":\\([0-9]+\\)" input) (string-to-number (match-string 1 input)) nil)) -(defun get-file-path (input) - (if (string-match "\"uri\":\"file:\\/\\/\\([^,]+\\)\"," input) - (match-string 1 input) - nil)) - (defconst notification-methods '("\"method\":\"initialized\"" "\"method\":\"textDocument/didOpen\"" "\"method\":\"textDocument/didClose\"" "\"method\":\"$/setTrace\"" - "\"method\":\"workspace/didChangeConfiguration\"")) + "\"method\":\"workspace/didChangeConfiguration\"") + "These are expected notifications that do not require any acknowledgement.") (defun is-notification (input) + "Check if INPUT is a notification message. + +See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#notificationMessage" (catch 'found (dolist (n notification-methods) (when (string-match-p n input) @@ -112,6 +139,7 @@ nil)) (defun handle-lsp-client-input () + "Read and handle one line of te input from the LSP client." (let ((line (read-string ""))) (cond ((string-match "method\":\"initialize\"" line) @@ -137,6 +165,9 @@ ) (t (error "unexpected input '%s'" line))))) +;; Keep alternating from executing a command to handling client input. +;; If emacs --script had concurrency support, +;; it would have been executed concurrently. (while t (run-command-from-file-if-any) (handle-lsp-client-input)) From 4c22a23b1b1a7a9cf0107765760578154c765503 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 05:41:40 +0200 Subject: [PATCH 30/53] Use escape sequence for \r instead of unicode value --- test/mock-lsp-server.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 973af4a6f5..665aa4a43e 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -159,7 +159,7 @@ See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17 (string-match "Content-Type" line)) ;; Ignore header ) - ((or (string-match "^ $" line) + ((or (string-match "^\r$" line) (string-match "^$" line)) ;; Ignore other empty lines ) From 21715ec520ba005180613d08a586b9fe45e02bda Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 05:42:14 +0200 Subject: [PATCH 31/53] Remove the todo list from mock server comments --- test/mock-lsp-server.el | 7 ------- 1 file changed, 7 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 665aa4a43e..3e78c3ce17 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -63,13 +63,6 @@ ;; 1+ - extra new-line at the end (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) -;; TODO mock: -;; - codeActionProvider -;; - codeLensProvider -;; - document(Range)FormattingProvider? -;; - documentHighlightProvider -;; - referencesProvider? -;; - foldingRangeProvider (defun greeting (id) "Compose the greeting message in response to `initialize' request with id ID." (json-rpc-string From d620e5e8be302c1a88460b9e6fbb23dfa90aa395 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 05:42:52 +0200 Subject: [PATCH 32/53] Undo unnecessary modifications --- lsp-mode.el | 18 +----------------- test/lsp-test-utils.el | 6 ++---- 2 files changed, 3 insertions(+), 21 deletions(-) diff --git a/lsp-mode.el b/lsp-mode.el index f4069bdf41..05cac9b3c2 100644 --- a/lsp-mode.el +++ b/lsp-mode.el @@ -7040,7 +7040,6 @@ server. WORKSPACE is the active workspace." (let ((body-received 0) leftovers body-length body chunk) (lambda (_proc input) - (lsp-dump-string-to-special-buffer input "*lsp-received-messages*") (setf chunk (if (s-blank? leftovers) input (concat leftovers input))) @@ -8810,24 +8809,9 @@ When ALL is t, erase all log buffers of the running session." (when (process-live-p process) (kill-process process))) -(defun lsp-dump-string-to-special-buffer (string buffer-name) - "Dump the given STRING into a special-named buffer BUFFER-NAME, preserving the current buffer." - (with-current-buffer (get-buffer-create buffer-name) - (goto-char (point-max)) - (let* ((current-time (current-time)) - (decoded-time (decode-time current-time)) - (hours (nth 2 decoded-time)) - (minutes (nth 1 decoded-time)) - (seconds (nth 0 decoded-time)) - (milliseconds (floor (* 1000 (mod (float-time current-time) 1))))) - (insert (format "|(%02d:%02d:%02d.%03d)|" hours minutes seconds milliseconds))) - (insert string))) - (cl-defmethod lsp-process-send ((process process) message) (condition-case err - (let ((msg (lsp--make-message message))) - (lsp-dump-string-to-special-buffer msg "*lsp-sent-messages*") - (process-send-string process msg)) + (process-send-string process (lsp--make-message message)) (error (lsp--error "Sending to process failed with the following error: %s" (error-message-string err))))) diff --git a/test/lsp-test-utils.el b/test/lsp-test-utils.el index 873b03bc49..46aa6b770e 100644 --- a/test/lsp-test-utils.el +++ b/test/lsp-test-utils.el @@ -26,19 +26,17 @@ ;;; Code: -(require 'deferred) - (defun lsp-test--wait-for (form &optional d) (--doto (or d (deferred:new #'identity)) (run-with-timer 0.001 nil (lambda () - (if-let ((result (funcall form))) + (if-let ((result (eval form))) (deferred:callback-post it result) (lsp-test--wait-for form it)))))) (defmacro lsp-test-wait (form) - `(lsp-test--wait-for (lambda () ,form))) + `(lsp-test--wait-for '(progn ,form))) (provide 'lsp-test-utils) ;;; lsp-test-utils.el ends here From 0d36de3d113404f4cc2c4bcd853dbc1f074ebc15 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 05:59:00 +0200 Subject: [PATCH 33/53] Shrink lsp server lines to fit 80 chars, mostly --- test/mock-lsp-server.el | 47 ++++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 3e78c3ce17..6e3042008f 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -61,13 +61,22 @@ (defun json-rpc-string (body) "Format BODY as a JSON RPC message suitable for LSP." ;; 1+ - extra new-line at the end - (format "Content-Length: %d\r\nContent-Type: application/vscode-jsonrpc; charset=utf8\r\n\r\n%s\n" (1+ (string-bytes body)) body)) + (let ((content-length-header + (format "Content-Length: %d" (1+ (string-bytes body)))) + (content-type-header + "Content-Type: application/vscode-jsonrpc; charset=utf8")) + (concat content-length-header "\r\n" + content-type-header "\r\n\r\n" + body "\n"))) + +(defconst server-info + "\"serverInfo\":{\"name\":\"mockS\",\"version\":\"0.0.1\"}" + "Basic server information: name and version.") (defun greeting (id) "Compose the greeting message in response to `initialize' request with id ID." (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{\"serverInfo\":{\"name\":\"mockS\",\"version\":\"0.0.1\"}}}" - id))) + (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{%s}}" id server-info))) (defun ack (id) "Acknowledge a request with id ID." @@ -79,7 +88,9 @@ (defun loc-to-json (loc) "Convert (:line .. :character ..) LOC to a serialized JSON object." - (format "{\"line\":%d,\"character\":%d}" (plist-get loc :line) (plist-get loc :character))) + (format "{\"line\":%d,\"character\":%d}" + (plist-get loc :line) + (plist-get loc :character))) (defun range-to-json (range) "Convert (:start .. :end ..) RANGE to a serialized JSON object." @@ -102,11 +113,16 @@ DIAGNOSICS must be a p-list (:path PATH :diags DIAGS), where DIAGS is a list of p-lists in the form (:source .. :code .. :range .. :message .. :severity ..)." - (princ - (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"method\":\"textDocument\\/publishDiagnostics\",\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}}" - (plist-get diagnostics :path) - (mapconcat #'diagnostic-to-json (plist-get diagnostics :diags) ","))))) + (let ((params + (format + "\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}" + (plist-get diagnostics :path) + (mapconcat #'diagnostic-to-json + (plist-get diagnostics :diags) ","))) + (method "\"method\":\"textDocument\\/publishDiagnostics\"")) + (princ + (json-rpc-string + (format "{\"jsonrpc\":\"2.0\",%s,%s}" method params))))) (defun get-id (input) "Extract request id from INPUT JSON message." @@ -114,12 +130,13 @@ where DIAGS is a list of p-lists in the form (string-to-number (match-string 1 input)) nil)) -(defconst notification-methods '("\"method\":\"initialized\"" - "\"method\":\"textDocument/didOpen\"" - "\"method\":\"textDocument/didClose\"" - "\"method\":\"$/setTrace\"" - "\"method\":\"workspace/didChangeConfiguration\"") - "These are expected notifications that do not require any acknowledgement.") +(defconst notification-methods + '("\"method\":\"initialized\"" + "\"method\":\"textDocument/didOpen\"" + "\"method\":\"textDocument/didClose\"" + "\"method\":\"$/setTrace\"" + "\"method\":\"workspace/didChangeConfiguration\"") + "Expected notification methods that require no acknowledgement.") (defun is-notification (input) "Check if INPUT is a notification message. From 80d7eee783e378cf7b828b345d87300735119d7f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 07:17:29 +0200 Subject: [PATCH 34/53] Simplify mcok server by using json-encode --- test/lsp-mock-server-test.el | 3 +- test/mock-lsp-server.el | 59 ++++++++++-------------------------- 2 files changed, 18 insertions(+), 44 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 2792db2084..e290df492b 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -147,7 +147,8 @@ might be generated for a modified and not saved buffer content." :message (format "Do not use word '%s'" forbidden-word) :severity 2) diagnostics))) - `(:path ,for-file :diags ,diagnostics)))) + ;; Use vconcat diagnostics to ensure proper JSON serialization of the list + `(:uri ,(concat "file://" for-file) :diagnostics ,(vconcat diagnostics))))) (defun lsp-test-command-send-diags (file-path file-contents forbidden-word) "Generate and command the mock server to publish diagnostics. diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 6e3042008f..79fd1acc86 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -43,6 +43,8 @@ ;;; Code: +(require 'json) + ;; To ease debugging, print the stack trace on failure (setq debug-on-error t) @@ -59,53 +61,32 @@ (delete-file command-file)))) (defun json-rpc-string (body) - "Format BODY as a JSON RPC message suitable for LSP." + "Format BODY p-list as a JSON RPC message suitable for LSP." ;; 1+ - extra new-line at the end - (let ((content-length-header - (format "Content-Length: %d" (1+ (string-bytes body)))) + (let* ((encoded-body (json-encode `(:jsonrpc "2.0" ,@body))) + (content-length-header + (format "Content-Length: %d" (1+ (string-bytes encoded-body)))) (content-type-header "Content-Type: application/vscode-jsonrpc; charset=utf8")) (concat content-length-header "\r\n" content-type-header "\r\n\r\n" - body "\n"))) + encoded-body "\n"))) (defconst server-info - "\"serverInfo\":{\"name\":\"mockS\",\"version\":\"0.0.1\"}" + '(:name "mockS" :version "0.0.1") "Basic server information: name and version.") (defun greeting (id) "Compose the greeting message in response to `initialize' request with id ID." - (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":{%s}}" id server-info))) + (json-rpc-string `(:id ,id :result (:serverInfo ,server-info)))) (defun ack (id) "Acknowledge a request with id ID." - (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":[]}" id))) + (json-rpc-string `(:id ,id :result []))) (defun shutdown-ack (id) "Acknowledge a `shutdown' request with id ID." - (json-rpc-string (format "{\"jsonrpc\":\"2.0\",\"id\":%d,\"result\":null}" id))) - -(defun loc-to-json (loc) - "Convert (:line .. :character ..) LOC to a serialized JSON object." - (format "{\"line\":%d,\"character\":%d}" - (plist-get loc :line) - (plist-get loc :character))) - -(defun range-to-json (range) - "Convert (:start .. :end ..) RANGE to a serialized JSON object." - (format "{\"start\":%s,\"end\":%s}" - (loc-to-json (plist-get range :start)) - (loc-to-json (plist-get range :end)))) - -(defun diagnostic-to-json (diagnostic) - "Convert DIAGNOSTIC to a serialized JSON object." - (format "{\"source\":\"%s\",\"code\":\"%s\",\"range\":%s,\"message\":\"%s\",\"severity\":%d}" - (plist-get diagnostic :source) - (plist-get diagnostic :code) - (range-to-json (plist-get diagnostic :range)) - (plist-get diagnostic :message) - (plist-get diagnostic :severity))) + (json-rpc-string `(:id ,id :result nil))) (defun publish-diagnostics (diagnostics) "Send JSON RPC message textDocument/PublishDiagnostics with DAGNOSTICS. @@ -113,22 +94,14 @@ DIAGNOSICS must be a p-list (:path PATH :diags DIAGS), where DIAGS is a list of p-lists in the form (:source .. :code .. :range .. :message .. :severity ..)." - (let ((params - (format - "\"params\":{\"uri\":\"file:\\/\\/%s\",\"diagnostics\":[%s]}" - (plist-get diagnostics :path) - (mapconcat #'diagnostic-to-json - (plist-get diagnostics :diags) ","))) - (method "\"method\":\"textDocument\\/publishDiagnostics\"")) - (princ - (json-rpc-string - (format "{\"jsonrpc\":\"2.0\",%s,%s}" method params))))) + (princ + (json-rpc-string `(:method "textDocument/publishDiagnostics" + :params ,diagnostics)))) (defun get-id (input) "Extract request id from INPUT JSON message." - (if (string-match "\"id\":\\([0-9]+\\)" input) - (string-to-number (match-string 1 input)) - nil)) + (when (string-match "\"id\":\\([0-9]+\\)" input) + (string-to-number (match-string 1 input)))) (defconst notification-methods '("\"method\":\"initialized\"" From e8cc4249fffc8c6cc7bb9b9a975b83ad61c9bf73 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 07:19:34 +0200 Subject: [PATCH 35/53] Clarify comment --- test/mock-lsp-server.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 79fd1acc86..a7ac87f957 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -144,7 +144,7 @@ See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17 ) ((or (string-match "^\r$" line) (string-match "^$" line)) - ;; Ignore other empty lines + ;; Ignore empty lines and header/content separators ) (t (error "unexpected input '%s'" line))))) From 8506e5749c34f5b259321366fabcf139a444d04a Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 12:06:22 +0200 Subject: [PATCH 36/53] Mock and test references --- test/lsp-mock-server-test.el | 138 +++++++++++++++++++++++------------ test/mock-lsp-server.el | 60 ++++++++++++--- 2 files changed, 142 insertions(+), 56 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index e290df492b..2fb0e5ea2f 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -89,7 +89,7 @@ executes the command." (error "Line %s not found" line)) found)) -(defun lsp-test-diag-make (file-content line marker) +(defun lsp-test-range-make (file-content line marker) "Create a single-line diagnostics range summary. Find LINE in FILE-CONTENT and take that as the line number. @@ -98,9 +98,9 @@ Set the :from and :to characters to reflect the position of Example (suppose line #3 of current buffer is \"full line\"): -(lsp-test-diag-make (buffer-string) - \"full line\" - \" ^^^^\") +(lsp-test-range-make (buffer-string) + \"full line\" + \" ^^^^\") -> (:line 3 :from 5 :to 8) " @@ -123,6 +123,21 @@ Returns its range converted to `(:line .. :from .. :to ..)' format." :from (ht-get start "character") :to (ht-get end "character")))) +(defun lsp-test-find-all-words (contents word) + "Find all occurences of WORD in CONTENTS and return a list of ranges." + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (let (locs) + (while (re-search-forward word nil t) + (let ((line (- (line-number-at-pos (point)) 1)) + (end-col (current-column)) + (start-col (- (current-column) (length word)))) + (push (list :start (list :line line :character start-col) + :end (list :line line :character end-col)) + locs))) + locs))) + (defun lsp-test-make-diagnostics (for-file contents forbidden-word) "Come up with a diagnostic highlighting FORBIDDEN-WORD. @@ -132,23 +147,15 @@ Returns a p-list compatible with the mock server. FOR-FILE is the path to the file to include in the diagnostics. It might not contain exactly CONTENTS because it the diagnostic might be generated for a modified and not saved buffer content." - (with-temp-buffer - (insert contents) - (goto-char (point-min)) - (let (diagnostics) - (while (re-search-forward forbidden-word nil t) - (let ((line (- (line-number-at-pos (point)) 1)) - (end-col (current-column)) - (start-col (- (current-column) (length forbidden-word)))) - (push (list :source "mockS" - :code "E001" - :range (list :start (list :line line :character start-col) - :end (list :line line :character end-col)) - :message (format "Do not use word '%s'" forbidden-word) - :severity 2) - diagnostics))) - ;; Use vconcat diagnostics to ensure proper JSON serialization of the list - `(:uri ,(concat "file://" for-file) :diagnostics ,(vconcat diagnostics))))) + (let ((diagnostics (mapcar (lambda (loc) + (list :source "mockS" + :code "E001" + :range loc + :message (format "Do not use word '%s'" forbidden-word) + :severity 2)) + (lsp-test-find-all-words contents forbidden-word)))) + ;; Use vconcat diagnostics to ensure proper JSON serialization of the list + `(:uri ,(concat "file://" for-file) :diagnostics ,(vconcat diagnostics)))) (defun lsp-test-command-send-diags (file-path file-contents forbidden-word) "Generate and command the mock server to publish diagnostics. @@ -232,9 +239,9 @@ TEST-BODY can interact with the mock server." (gethash lsp-test-sample-file (lsp-diagnostics t)))) (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ "))))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))))) (ert-deftest lsp-mock-server-crashes () "Test that the mock server crashes when instructed so." @@ -275,9 +282,9 @@ TEST-BODY can interact with the mock server." ;; The diagnostic is properly received (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ "))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))) ;; Server found a different diagnostic (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "fegam") @@ -288,9 +295,9 @@ TEST-BODY can interact with the mock server." ;; The new diagnostics is properly displayed instead of the old one (should (eq (length (gethash lsp-test-sample-file (lsp-diagnostics t))) 1)) (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "Line 0 unique word fegam and common" - " ^^^^^ "))))) + (lsp-test-range-make (buffer-string) + "Line 0 unique word fegam and common" + " ^^^^^ "))))) (ert-deftest lsp-mock-server-updates-diags-with-delay () "Test demonstrating delay in the diagnostics update. @@ -311,9 +318,9 @@ publishes the update. This test demonstrates this behavior." ;; The diagnostic is properly received (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ "))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))) ;; Change the text: remove the first line (goto-char (point-min)) @@ -327,9 +334,9 @@ line 3 words here and here (sleep-for 0.5) ;; The diagnostic is not updated and now points to a wrong line (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 2 unique word normalw common here" - " ^^^^^^^ "))) + (lsp-test-range-make (buffer-string) + "line 2 unique word normalw common here" + " ^^^^^^^ "))) ;; Server sent an update (lsp-test-command-send-diags lsp-test-sample-file (buffer-string) "broming") @@ -340,9 +347,9 @@ line 3 words here and here ;; Now the diagnostic is correct again (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ "))))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))))) (ert-deftest lsp-mock-server-updates-diags-clears-up () "Test ensuring diagnostics are cleared after a change." @@ -359,9 +366,9 @@ line 3 words here and here ;; The diagnostic is properly received (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ "))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))) ;; Change the text: remove the first line (goto-char (point-min)) @@ -380,8 +387,49 @@ line 3 words here and here ;; Now the diagnostic is correct again (should (equal (lsp-test-diag-get (car (gethash lsp-test-sample-file (lsp-diagnostics t)))) - (lsp-test-diag-make (buffer-string) - "line 1 unique word broming + common" - " ^^^^^^^ ")))))) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ ")))))) + +(defun lsp-test-xref-loc-to-range (xref-loc) + (let ((line (- (xref-location-line (xref-item-location xref-loc)) 1)) + (len (xref-match-length xref-loc)) + (col (xref-file-location-column (xref-item-location xref-loc)))) + (list :line line :from col :to (+ col len)))) + +(defun lsp-test-make-references (for-file contents word) + "Come up with a list of references to WORD in CONTENTS. + +Scan CONTENTS for all occurences of WORD and compose a list of references." + (let ((add-uri (lambda (range) `(:uri ,(concat "file://" for-file) + :range ,range)))) + (vconcat (mapcar add-uri (lsp-test-find-all-words contents word))))) + +(ert-deftest lsp-mock-server-provides-referencs () + "Test ensuring that lsp-mode accepts correct locations for references." + (let* (found-xrefs + (xref-show-xrefs-function (lambda (fetcher &rest _params) + (setq found-xrefs (funcall fetcher))))) + (lsp-mock-run-with-mock-server + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/references\" '%s)" + (lsp-test-make-references + lsp-test-sample-file (buffer-string) "unique"))) + (lsp-find-references) + (message "%s" found-xrefs) + (should found-xrefs) + (should (eq (length found-xrefs) 3)) + (should (equal (lsp-test-xref-loc-to-range (nth 0 found-xrefs)) + (lsp-test-range-make (buffer-string) + "Line 0 unique word fegam and common" + " ^^^^^^ "))) + (should (equal (lsp-test-xref-loc-to-range (nth 1 found-xrefs)) + (lsp-test-range-make (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^ "))) + (should (equal (lsp-test-xref-loc-to-range (nth 2 found-xrefs)) + (lsp-test-range-make (buffer-string) + "line 2 unique word normalw common here" + " ^^^^^^ ")))))) ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index a7ac87f957..5e890566c8 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -4,7 +4,7 @@ ;; Author: Arseniy Zaostrovnykh ;; Package-Requires: ((emacs "27.1")) -;; Version: 0.0.1 +;; Version: 0.1.0 ;; License: GPL-3.0-or-later ;; URL: https://github.com/emacs-lsp/lsp-mode @@ -73,20 +73,21 @@ encoded-body "\n"))) (defconst server-info - '(:name "mockS" :version "0.0.1") + '(:name "mockS" :version "0.1.0") "Basic server information: name and version.") + +(defconst server-capabilities '(:referencesProvider t) + "Capabilities of the server.") + (defun greeting (id) "Compose the greeting message in response to `initialize' request with id ID." - (json-rpc-string `(:id ,id :result (:serverInfo ,server-info)))) + (json-rpc-string `(:id ,id :result (:capabilities ,server-capabilities + :serverInfo ,server-info)))) -(defun ack (id) +(defun respond (id result) "Acknowledge a request with id ID." - (json-rpc-string `(:id ,id :result []))) - -(defun shutdown-ack (id) - "Acknowledge a `shutdown' request with id ID." - (json-rpc-string `(:id ,id :result nil))) + (json-rpc-string `(:id ,id :result ,result))) (defun publish-diagnostics (diagnostics) "Send JSON RPC message textDocument/PublishDiagnostics with DAGNOSTICS. @@ -121,6 +122,41 @@ See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17 (throw 'found t))) nil)) +(defvar scheduled-responses (make-hash-table :test 'equal) + "Keep the planned response for the requiest of the given method. + +Can contain only one planned response per method. +Key is the method, and value is the `result' field in the response.") + +(defun schedule-response (method result) + "Next time request of METHOD comes respond with `result' RESULT. + +This function is useful for external commands, +allowing control over the server responses. + +You can schedule only one response for a method at a time." + (when (gethash method scheduled-responses) + (error "Response for method %s is already scheduled" method)) + (puthash method result scheduled-responses)) + +(defun get-method (input) + "Retrieve the method of the request in INPUT. + +Returns nil if no method is found." + (when (string-match "\"method\":\"\\([^\"]+\\)\"" input) + (match-string 1 input))) + +(defun pop-response-for-request (method) + "Find and erase a scheduled response for METHOD request. + +Returns empty array if not found: + empty array is the usual representation of empty result." + (if-let ((response (gethash method scheduled-responses))) + (progn + (remhash method scheduled-responses) + response) + [])) + (defun handle-lsp-client-input () "Read and handle one line of te input from the LSP client." (let ((line (read-string ""))) @@ -130,14 +166,16 @@ See https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17 ((string-match "method\":\"exit" line) (kill-emacs 0)) ((string-match "method\":\"shutdown" line) - (princ (shutdown-ack (get-id line)))) + (princ (respond (get-id line) nil))) ((is-notification line) ;; No need to acknowledge a notification ) ((get-id line) ;; It has an id, probably some request ;; Acknowledge that it is received - (princ (ack (get-id line)))) + (princ (respond + (get-id line) + (pop-response-for-request (get-method line))))) ((or (string-match "Content-Length" line) (string-match "Content-Type" line)) ;; Ignore header From 48a0dd6b5bd8876139b5f88ca19553bb9be2a5bd Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 12:30:46 +0200 Subject: [PATCH 37/53] Missing doc comment --- test/lsp-mock-server-test.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 2fb0e5ea2f..90c718ff0b 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -392,6 +392,10 @@ line 3 words here and here " ^^^^^^^ ")))))) (defun lsp-test-xref-loc-to-range (xref-loc) + "Convert XREF-LOC to a range p-list. + +XREF-LOC is an xref-location object. The function returns a p-list +in the form of `(:line .. :from .. :to ..)'." (let ((line (- (xref-location-line (xref-item-location xref-loc)) 1)) (len (xref-match-length xref-loc)) (col (xref-file-location-column (xref-item-location xref-loc)))) From 80d8801e34579ac1b5c5da2211f5b9f6d0e810fd Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Tue, 23 Jul 2024 20:35:28 +0200 Subject: [PATCH 38/53] Fix lsp-mock-server-provides-references for emacs 27.2 --- test/lsp-mock-server-test.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 90c718ff0b..c2a684b8a4 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -409,7 +409,7 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." :range ,range)))) (vconcat (mapcar add-uri (lsp-test-find-all-words contents word))))) -(ert-deftest lsp-mock-server-provides-referencs () +(ert-deftest lsp-mock-server-provides-references () "Test ensuring that lsp-mode accepts correct locations for references." (let* (found-xrefs (xref-show-xrefs-function (lambda (fetcher &rest _params) @@ -419,8 +419,13 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." (format "(schedule-response \"textDocument/references\" '%s)" (lsp-test-make-references lsp-test-sample-file (buffer-string) "unique"))) + + ;; xref in emacs 27.2 does not have this var, + ;; but lsp-mode uses it in lsp-show-xrefs. + ;; For the purpose of this test, it does not matter. + (unless (boundp 'xref-auto-jump-to-first-xref) + (defvar xref-auto-jump-to-first-xref nil)) (lsp-find-references) - (message "%s" found-xrefs) (should found-xrefs) (should (eq (length found-xrefs) 3)) (should (equal (lsp-test-xref-loc-to-range (nth 0 found-xrefs)) From ebc7c4caa3cf41f9f15a5a86ac729197bd7271c6 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 15:39:12 +0200 Subject: [PATCH 39/53] Test folding ranges line numbers --- test/lsp-mock-server-test.el | 38 ++++++++++++++++++++++++++++++++++++ test/mock-lsp-server.el | 3 ++- 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index c2a684b8a4..d039dc1d3e 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -441,4 +441,42 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." "line 2 unique word normalw common here" " ^^^^^^ ")))))) +(ert-deftest lsp-mock-server-provides-folding-ranges () + "Test ensuring that lsp-mode accepts correct locations for folding ranges." + (lsp-mock-run-with-mock-server + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/foldingRange\" '%s)" + [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1) + (:kind "region" :startLine 1 :startCharacter 5 :endLine 2)])) + (let ((folding-ranges (lsp--get-folding-ranges))) + (should (eq (length folding-ranges) 2)) + ;; LSP line numbers are 0-based, Emacs line numbers are 1-based + ;; henace the +1 + (should (equal (line-number-at-pos + (lsp--folding-range-beg (nth 0 folding-ranges))) + 1)) + (should (equal (line-number-at-pos + (lsp--folding-range-end (nth 0 folding-ranges))) + 2)) + (should (equal (line-number-at-pos + (lsp--folding-range-beg (nth 1 folding-ranges))) + 2)) + (should (equal (line-number-at-pos + (lsp--folding-range-end (nth 1 folding-ranges))) + 3))))) + +(ert-deftest lsp-mock-server-lsp-caches-folding-ranges () + "Test ensuring that lsp-mode accepts correct locations for folding ranges." + (lsp-mock-run-with-mock-server + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/references\" '%s)" + (lsp-test-make-references + lsp-test-sample-file (buffer-string) "unique"))) + (should (eq (lsp--get-folding-ranges) nil)) + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/foldingRange\" '%s)" + [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1)])) + ;; Folding ranges are cached from the first request + (should (eq (lsp--get-folding-ranges) nil)))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 5e890566c8..70927813de 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -77,7 +77,8 @@ "Basic server information: name and version.") -(defconst server-capabilities '(:referencesProvider t) +(defconst server-capabilities '(:referencesProvider t + :foldingRangeProvider t) "Capabilities of the server.") (defun greeting (id) From e1172e2481f1fcb7596939890cd3680db077d0f5 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 17:35:27 +0200 Subject: [PATCH 40/53] Test highlighting ranges --- test/lsp-mock-server-test.el | 75 ++++++++++++++++++++++++++++++++++++ test/mock-lsp-server.el | 3 +- 2 files changed, 77 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index d039dc1d3e..9a1503afb4 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -31,6 +31,7 @@ ;;; Code: +(require 'seq) (require 'lsp-mode) ;; Taken from lsp-integration-tests.el @@ -479,4 +480,78 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." ;; Folding ranges are cached from the first request (should (eq (lsp--get-folding-ranges) nil)))) +(defun lsp-test-all-overlays-as-ranges (tag) + "Return all overlays tagged TAG in the current buffer as ranges. + +Tagged overlays have the property TAG set to t." + (let ((overlays (overlays-in (point-min) (point-max))) + (to-range + (lambda (overlay) + (let* ((beg (overlay-start overlay)) + (end (overlay-end overlay)) + (beg-line (line-number-at-pos beg)) + (end-line (line-number-at-pos end)) + (beg-col (progn (goto-char beg) (current-column))) + (end-col (progn (goto-char end) (current-column)))) + (should (equal beg-line end-line)) + (list :line (- beg-line 1) :from beg-col :to end-col))))) + (save-excursion + (mapcar to-range (seq-filter (lambda (overlay) + (overlay-get overlay tag)) + overlays))))) + +(defun lsp-test-make-highlights (contents word) + "Come up with a list of highlights of WORD in CONTENTS. + +Scan CONTENTS for all occurences of WORD and compose a list of highlights." + (let ((add-uri (lambda (range) `(:kind 1 :range ,range)))) + (vconcat (mapcar add-uri (lsp-test-find-all-words contents word))))) + +(defun lsp-mock-with-temp-window (buffer-name test-fn) + "Create a temporary window displaying BUFFER-NAME and call TEST-FN. +BUFFER-NAME is the name of the buffer to display. +TEST-FN is a function to call with the temporary window." + (let ((original-window (selected-window)) + (temp-window (split-window))) + (unwind-protect + (progn + ;; Display the buffer in the temporary window + (set-window-buffer temp-window buffer-name) + ;; Switch to the temporary window + (select-window temp-window) + ;; Call the test function + (funcall test-fn)) + ;; Clean up: Delete the temporary window and select the original window + (delete-window temp-window) + (select-window original-window)))) + +(ert-deftest lsp-mock-server-provides-symbol-highlights () + "Test ensuring that lsp-mode accepts correct locations for highlights." + (lsp-mock-run-with-mock-server + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/documentHighlight\" '%s)" + (lsp-test-make-highlights (buffer-string) "here"))) + ;; The highlight overlays are created only if visible in a window + (lsp-mock-with-temp-window + (current-buffer) + (lambda () + (lsp-document-highlight) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (lsp-test-all-overlays-as-ranges + 'lsp-highlight))) + (let ((highlights (lsp-test-all-overlays-as-ranges 'lsp-highlight))) + (should (eq (length highlights) 3)) + (should (equal (nth 0 highlights) + (lsp-test-range-make (buffer-string) + "line 2 unique word normalw common here" + " ^^^^"))) + (should (equal (nth 1 highlights) + (lsp-test-range-make (buffer-string) + "line 3 words here and here" + " ^^^^ "))) + (should (equal (nth 2 highlights) + (lsp-test-range-make (buffer-string) + "line 3 words here and here" + " ^^^^")))))))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 70927813de..ea34d7771d 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -78,7 +78,8 @@ (defconst server-capabilities '(:referencesProvider t - :foldingRangeProvider t) + :foldingRangeProvider t + :documentHighlightProvider t) "Capabilities of the server.") (defun greeting (id) From a0132b175e7b5be8dbff05dcc206fb5298d382f8 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sat, 20 Jul 2024 19:30:17 +0200 Subject: [PATCH 41/53] Test document formatting action --- test/lsp-mock-server-test.el | 104 +++++++++++++++++++++++++++++++++++ test/mock-lsp-server.el | 3 +- 2 files changed, 106 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 9a1503afb4..2fe10d7382 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -554,4 +554,108 @@ TEST-FN is a function to call with the temporary window." "line 3 words here and here" " ^^^^")))))))) +(defun lsp-test-index-to-pos (idx) + "Convert 0-based integer IDX to a position in the corrent buffer. + +Retruns the position p-list." + (lsp-point-to-position (1+ idx))) + +(defun lsp-test-make-edits (marked-up) + "Create a list of edits to transform current buffer according to MARKED-UP. + +MARKED-UP string uses a simple markup syntax to indicate +insertions and deletions. The function returns a list of edits +each in the form `(:range .. :newText ..)' + +The markup syntax is as follows: +- - indicates an insertion of the text `word' +- ####### - indicates a deletion of the text that was in place of each `#' + +All edits must be single line: deletion must not cross a line break +and insertion must not contain a line break." + (let ((edits nil) + (original (buffer-string)) + (orig-idx 0) + (marked-idx 0)) + (while (and (< orig-idx (length original)) + (< marked-idx (length marked-up))) + (let ((orig-char (aref original orig-idx)) + (marked-char (aref marked-up marked-idx))) + (cond + ((eq marked-char ?<) ; Insertion + (let ((marked-idx-start marked-idx)) + (while (and (< marked-idx (length marked-up)) + (not (eq (aref marked-up marked-idx) ?>))) + (setq marked-idx (1+ marked-idx))) + (should (< marked-idx (length marked-up))) + (push `(:range (:start ,(lsp-test-index-to-pos orig-idx) + :end ,(lsp-test-index-to-pos orig-idx)) + :newText ,(substring marked-up (1+ marked-idx-start) marked-idx)) + edits) + (setq marked-idx (1+ marked-idx)) ; Skip the closing > + )) + ((eq marked-char ?#) ; Deletion + (let ((orig-idx-start orig-idx)) + (while (and (< marked-idx (length marked-up)) + (< orig-idx (length original)) + (eq (aref marked-up marked-idx) ?#)) + (setq orig-idx (1+ orig-idx)) + (setq marked-idx (1+ marked-idx))) + (should (and (< marked-idx (length marked-up)) + (< orig-idx (length original)))) + (push `(:range (:start ,(lsp-test-index-to-pos orig-idx-start) + :end ,(lsp-test-index-to-pos orig-idx)) + :newText "") + edits))) + (t (should (eq orig-char marked-char)) + (setq orig-idx (1+ orig-idx)) + (setq marked-idx (1+ marked-idx)))))) + (should (and (= orig-idx (length original)) + (= marked-idx (length marked-up)))) + (vconcat (reverse edits)))) + +(ert-deftest lsp-mock-make-edits-sane () + "Check the test-utility function `lsp-mock-make-edits'." + (with-temp-buffer + (insert "line 0 common deleted common") + (should (equal (lsp-test-make-edits + "line 0 common deleted common") + [(:range (:start (:line 0 :character 0) + :end (:line 0 :character 0)) + :newText "inserted") + ])) + (should (equal (lsp-test-make-edits + "line 0 common deleted common") + [(:range (:start (:line 0 :character 1) + :end (:line 0 :character 1)) + :newText "inserted") + ])) + (should (equal (lsp-test-make-edits + "line 0 common ####### common") + [(:range (:start (:line 0 :character 7) + :end (:line 0 :character 7)) + :newText "inserted") + (:range (:start (:line 0 :character 14) + :end (:line 0 :character 21)) + :newText "")])))) + +(ert-deftest lsp-mock-server-formats-with-edits () + "Test ensuring that lsp-mode requests and applies formatting correctly." + (lsp-mock-run-with-mock-server + (lsp-test-send-command-to-mock-server + (format "(schedule-response \"textDocument/formatting\" %S)" + (lsp-test-make-edits + "Line 0 ###### word fegam and common +line 1 unique word ######### common +line 2 unique word #ormalw common here +line 3 words here and here +"))) + (lsp-format-buffer) + (should (equal (buffer-string) + "Line 0 word fegam and common +line 1 unique doubleword common +line 2 unique word ormalw common here +line 3 words here and here +")))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index ea34d7771d..fd14023110 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -79,7 +79,8 @@ (defconst server-capabilities '(:referencesProvider t :foldingRangeProvider t - :documentHighlightProvider t) + :documentHighlightProvider t + :documentFormattingProvider t) "Capabilities of the server.") (defun greeting (id) From f797d1d7f45094b3e7d43cab7eed626b1f10c1fe Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 10:11:38 +0200 Subject: [PATCH 42/53] [NFC] Factor out lsp-test-schedule-response, remove useless bits --- test/lsp-mock-server-test.el | 48 ++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 2fe10d7382..24f504dcb0 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -410,17 +410,20 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." :range ,range)))) (vconcat (mapcar add-uri (lsp-test-find-all-words contents word))))) +(defun lsp-test-schedule-response (method response) + "Schedule a RESPONSE to be sent in response to METHOD." + (lsp-test-send-command-to-mock-server + (format "(schedule-response %S %S)" method response))) + (ert-deftest lsp-mock-server-provides-references () "Test ensuring that lsp-mode accepts correct locations for references." (let* (found-xrefs (xref-show-xrefs-function (lambda (fetcher &rest _params) (setq found-xrefs (funcall fetcher))))) (lsp-mock-run-with-mock-server - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/references\" '%s)" - (lsp-test-make-references - lsp-test-sample-file (buffer-string) "unique"))) - + (lsp-test-schedule-response "textDocument/references" + (lsp-test-make-references + lsp-test-sample-file (buffer-string) "unique")) ;; xref in emacs 27.2 does not have this var, ;; but lsp-mode uses it in lsp-show-xrefs. ;; For the purpose of this test, it does not matter. @@ -445,10 +448,11 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." (ert-deftest lsp-mock-server-provides-folding-ranges () "Test ensuring that lsp-mode accepts correct locations for folding ranges." (lsp-mock-run-with-mock-server - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/foldingRange\" '%s)" - [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1) - (:kind "region" :startLine 1 :startCharacter 5 :endLine 2)])) + (lsp-test-schedule-response + "textDocument/foldingRange" + [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1) + (:kind "region" :startLine 1 :startCharacter 5 :endLine 2)]) + (let ((folding-ranges (lsp--get-folding-ranges))) (should (eq (length folding-ranges) 2)) ;; LSP line numbers are 0-based, Emacs line numbers are 1-based @@ -469,14 +473,10 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." (ert-deftest lsp-mock-server-lsp-caches-folding-ranges () "Test ensuring that lsp-mode accepts correct locations for folding ranges." (lsp-mock-run-with-mock-server - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/references\" '%s)" - (lsp-test-make-references - lsp-test-sample-file (buffer-string) "unique"))) (should (eq (lsp--get-folding-ranges) nil)) - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/foldingRange\" '%s)" - [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1)])) + (lsp-test-schedule-response + "textDocument/foldingRange" + [(:kind "region" :startLine 0 :startCharacter 10 :endLine 1)]) ;; Folding ranges are cached from the first request (should (eq (lsp--get-folding-ranges) nil)))) @@ -528,9 +528,9 @@ TEST-FN is a function to call with the temporary window." (ert-deftest lsp-mock-server-provides-symbol-highlights () "Test ensuring that lsp-mode accepts correct locations for highlights." (lsp-mock-run-with-mock-server - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/documentHighlight\" '%s)" - (lsp-test-make-highlights (buffer-string) "here"))) + (lsp-test-schedule-response + "textDocument/documentHighlight" + (lsp-test-make-highlights (buffer-string) "here")) ;; The highlight overlays are created only if visible in a window (lsp-mock-with-temp-window (current-buffer) @@ -642,14 +642,14 @@ and insertion must not contain a line break." (ert-deftest lsp-mock-server-formats-with-edits () "Test ensuring that lsp-mode requests and applies formatting correctly." (lsp-mock-run-with-mock-server - (lsp-test-send-command-to-mock-server - (format "(schedule-response \"textDocument/formatting\" %S)" - (lsp-test-make-edits - "Line 0 ###### word fegam and common + (lsp-test-schedule-response + "textDocument/formatting" + (lsp-test-make-edits + "Line 0 ###### word fegam and common line 1 unique word ######### common line 2 unique word #ormalw common here line 3 words here and here -"))) +")) (lsp-format-buffer) (should (equal (buffer-string) "Line 0 word fegam and common From a8c800542fe0d0dfe91ff573d8639863a476f7d1 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 10:51:50 +0200 Subject: [PATCH 43/53] Test codeAction with edits --- test/lsp-mock-server-test.el | 26 ++++++++++++++++++++++++++ test/mock-lsp-server.el | 3 ++- 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 24f504dcb0..9b313af082 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -658,4 +658,30 @@ line 2 unique word ormalw common here line 3 words here and here ")))) +(ert-deftest lsp-mock-server-suggests-action-with-simple-changes () + "Test ensuring that lsp-mode applies code action simple edits correctly." + (lsp-mock-run-with-mock-server + (lsp-test-schedule-response + "textDocument/codeAction" + (vconcat (list `(:title "Some edits" + :kind "quickfix" + :isPreferred t + :edit + (:changes + ((,(concat "file://" lsp-test-sample-file) + . + ,(lsp-test-make-edits + "Line 0 unique word ######### common +line # unique word broming + common +line # unique word normalw common here +line #<81> words here and here +")))))))) + (lsp-execute-code-action-by-kind "quickfix") + (should (equal (buffer-string) + "Line 0 unique word common +line unique word broming + common +line unique word normalw common here +line 81 words here and here +")))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index fd14023110..e3176fb987 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -80,7 +80,8 @@ (defconst server-capabilities '(:referencesProvider t :foldingRangeProvider t :documentHighlightProvider t - :documentFormattingProvider t) + :documentFormattingProvider t + :codeActionProvider t) "Capabilities of the server.") (defun greeting (id) From 360b394c8b063aec18685638006b49329648807f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 11:09:36 +0200 Subject: [PATCH 44/53] Test documentChanges edit kind --- test/lsp-mock-server-test.el | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 9b313af082..137d0758b8 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -684,4 +684,34 @@ line unique word normalw common here line 81 words here and here ")))) +(ert-deftest lsp-mock-server-suggests-action-with-doc-changes () + "Test ensuring that lsp-mode applies code action document edits correctly." + (lsp-mock-run-with-mock-server + (let ((docChanges + (vconcat (list `(:textDocument + (:version 0 ; document was never changed + :uri ,(concat "file://" lsp-test-sample-file)) + :edits + ,(lsp-test-make-edits + "Line 0 ########### ######### common +line 1<00> unique word broming + common +line # ###### word normalw common here +line #<81> words here and here +")))))) + (lsp-test-schedule-response + "textDocument/codeAction" + (vconcat (list `(:title "Some edits" + :kind "quickfix" + :isPreferred t + :edit + (:changes #s(hash-table data ()) ; empty obj + :documentChanges ,docChanges))))) + (lsp-execute-code-action-by-kind "quickfix") + (should (equal (buffer-string) + "Line 0 common +line 100 unique word broming + common +line word normalw common here +line 81 words here and here +"))))) + ;;; lsp-mock-server-test.el ends here From 68e6891d1f125e3d97757a024c296324b0133371 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 11:18:28 +0200 Subject: [PATCH 45/53] Test documentEdit with wrong version --- test/lsp-mock-server-test.el | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 137d0758b8..99620bdee9 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -714,4 +714,28 @@ line word normalw common here line 81 words here and here "))))) +(ert-deftest lsp-mock-doc-changes-wrong-version () + "Test ensuring that lsp-mode applies code action document edits correctly." + (lsp-mock-run-with-mock-server + (let ((docChanges + (vconcat (list `(:textDocument + (:version 1 ; This version does not exist + :uri ,(concat "file://" lsp-test-sample-file)) + :edits + ,(lsp-test-make-edits + "Line 0 ########### ######### common +line 1<00> unique word broming + common +line # ###### word normalw common here +line #<81> words here and here +")))))) + (lsp-test-schedule-response + "textDocument/codeAction" + (vconcat (list `(:title "Some edits" + :kind "quickfix" + :isPreferred t + :edit + (:changes #s(hash-table data ()) ; empty obj + :documentChanges ,docChanges))))) + (should-error (lsp-execute-code-action-by-kind "quickfix"))))) + ;;; lsp-mock-server-test.el ends here From 43cd5b505a81722263c68a0d3092bc42ed49c2ab Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 11:40:37 +0200 Subject: [PATCH 46/53] Simplify the wrong-version doc edit test --- test/lsp-mock-server-test.el | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 99620bdee9..e883f29ff9 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -721,13 +721,7 @@ line 81 words here and here (vconcat (list `(:textDocument (:version 1 ; This version does not exist :uri ,(concat "file://" lsp-test-sample-file)) - :edits - ,(lsp-test-make-edits - "Line 0 ########### ######### common -line 1<00> unique word broming + common -line # ###### word normalw common here -line #<81> words here and here -")))))) + :edits []))))) (lsp-test-schedule-response "textDocument/codeAction" (vconcat (list `(:title "Some edits" From 14989d93b236d898758e40d160e8b58eb7b228ed Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 11:46:34 +0200 Subject: [PATCH 47/53] Test with mcok server spontaneously requesting edits --- test/lsp-mock-server-test.el | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index e883f29ff9..bf1fa63194 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -732,4 +732,35 @@ line 81 words here and here :documentChanges ,docChanges))))) (should-error (lsp-execute-code-action-by-kind "quickfix"))))) +;; Some actions are executed partially by the server: +;; after the user selects the action, lsp-mode sends a request +;; to exute the associated command. +;; Only after that, server sends a request to perform edits +;; in the editor. +;; This test simulates only the last bit. +(ert-deftest lsp-mock-server-request-edits () + "Test ensuring that lsp-mode honors server's request for edits." + (lsp-mock-run-with-mock-server + (let ((initial-content (buffer-string))) + (lsp-test-send-command-to-mock-server + (format "(princ (json-rpc-string '(:id 1 :method \"workspace/applyEdit\" + :params (:edit + (:changes + ((%S . %S)))))))" + (concat "file://" lsp-test-sample-file) + (lsp-test-make-edits + "#### <8>0 unique word fegam and common +line 1 unique word broming + common +line 2 unique word normalw common here +line 3 words here and here +"))) + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (not (equal initial-content (buffer-string))))) + (should (equal (buffer-string) + " 80 unique word fegam and common +line 1 unique word broming + common +line 2 unique word normalw common here +line 3 words here and here +"))))) + ;;; lsp-mock-server-test.el ends here From ae1305eed146614404258bf1848ee9b20eb998ca Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 12:19:34 +0200 Subject: [PATCH 48/53] Test go to declaration --- test/lsp-mock-server-test.el | 31 +++++++++++++++++++++++++++++++ test/mock-lsp-server.el | 3 ++- 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index bf1fa63194..bc4e6357bd 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -111,6 +111,16 @@ Example (suppose line #3 of current buffer is \"full line\"): (should (string-match "^ *\\(\\^+\\) *$" marker)) (list :line line-number :from (match-beginning 1) :to (match-end 1)))) +(defun lsp-test-full-range (short-range) + "Convert SHORT-RANGE to a full range. + +SHORT-RANGE is a p-list with :line, :from, and :to keys. +Returns a full range p-list with :start and :end keys." + (list :start (list :line (plist-get short-range :line) + :character (plist-get short-range :from)) + :end (list :line (plist-get short-range :line) + :character (plist-get short-range :to)))) + (defun lsp-test-diag-get (diagnostic) "Get the single-line diagnostics range summary of DIAGNOSTIC. @@ -763,4 +773,25 @@ line 2 unique word normalw common here line 3 words here and here "))))) +(ert-deftest lsp-mock-server-no-declaration-found () + "Test checking that lsp-mode reports when server returns no declaration." + (lsp-mock-run-with-mock-server + (should (string-match-p "not found" (lsp-find-declaration))))) + +(ert-deftest lsp-mock-server-goto-declaration () + "Test checking that lsp-mode can follow the symbol declaration." + (lsp-mock-run-with-mock-server + (let ((decl-range (lsp-test-range-make + (buffer-string) + "line 1 unique word broming + common" + " ^^^^^^^ "))) + (lsp-test-schedule-response + "textDocument/declaration" + (vconcat (list `(:uri ,(concat "file://" lsp-test-sample-file) + :range ,(lsp-test-full-range decl-range))))) + (lsp-find-declaration) + ;; 1+ to convert 0-based LSP line number to 1-based Emacs line number + (should (equal (1+ (plist-get decl-range :line)) (line-number-at-pos))) + (should (equal (plist-get decl-range :from) (current-column)))))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index e3176fb987..7fff8a9444 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -81,7 +81,8 @@ :foldingRangeProvider t :documentHighlightProvider t :documentFormattingProvider t - :codeActionProvider t) + :codeActionProvider t + :declarationProvider t) "Capabilities of the server.") (defun greeting (id) From 99a6efda985c35675d0e6a5dff2f815e208ec3ff Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 12:22:34 +0200 Subject: [PATCH 49/53] Test for go to definition --- test/lsp-mock-server-test.el | 16 ++++++++++++++++ test/mock-lsp-server.el | 3 ++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index bc4e6357bd..f00c4c98be 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -794,4 +794,20 @@ line 3 words here and here (should (equal (1+ (plist-get decl-range :line)) (line-number-at-pos))) (should (equal (plist-get decl-range :from) (current-column)))))) +(ert-deftest lsp-mock-server-goto-definition () + "Test checking that lsp-mode can follow the symbol definition." + (lsp-mock-run-with-mock-server + (let ((decl-range (lsp-test-range-make + (buffer-string) + "line 3 words here and here" + " ^^^^^^^ "))) + (lsp-test-schedule-response + "textDocument/definition" + (vconcat (list `(:uri ,(concat "file://" lsp-test-sample-file) + :range ,(lsp-test-full-range decl-range))))) + (lsp-find-definition) + ;; 1+ to convert 0-based LSP line number to 1-based Emacs line number + (should (equal (1+ (plist-get decl-range :line)) (line-number-at-pos))) + (should (equal (plist-get decl-range :from) (current-column)))))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 7fff8a9444..6af0269b41 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -82,7 +82,8 @@ :documentHighlightProvider t :documentFormattingProvider t :codeActionProvider t - :declarationProvider t) + :declarationProvider t + :definitionProvider t) "Capabilities of the server.") (defun greeting (id) From 2ef41df5ad6cff934fb16f2a59bf1d7cd817ac33 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 13:05:03 +0200 Subject: [PATCH 50/53] Test inlayHint display --- test/lsp-mock-server-test.el | 40 +++++++++++++++++++++++++++++++----- test/mock-lsp-server.el | 3 ++- 2 files changed, 37 insertions(+), 6 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index f00c4c98be..23c0d0d40c 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -490,12 +490,18 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." ;; Folding ranges are cached from the first request (should (eq (lsp--get-folding-ranges) nil)))) +(defun lsp-test-all-overlays (tag) + "Return all overlays tagged TAG in the current buffer." + (let ((overlays (overlays-in (point-min) (point-max)))) + (seq-filter (lambda (overlay) + (overlay-get overlay tag)) + overlays))) + (defun lsp-test-all-overlays-as-ranges (tag) "Return all overlays tagged TAG in the current buffer as ranges. Tagged overlays have the property TAG set to t." - (let ((overlays (overlays-in (point-min) (point-max))) - (to-range + (let ((to-range (lambda (overlay) (let* ((beg (overlay-start overlay)) (end (overlay-end overlay)) @@ -506,9 +512,7 @@ Tagged overlays have the property TAG set to t." (should (equal beg-line end-line)) (list :line (- beg-line 1) :from beg-col :to end-col))))) (save-excursion - (mapcar to-range (seq-filter (lambda (overlay) - (overlay-get overlay tag)) - overlays))))) + (mapcar to-range (lsp-test-all-overlays tag))))) (defun lsp-test-make-highlights (contents word) "Come up with a list of highlights of WORD in CONTENTS. @@ -810,4 +814,30 @@ line 3 words here and here (should (equal (1+ (plist-get decl-range :line)) (line-number-at-pos))) (should (equal (plist-get decl-range :from) (current-column)))))) +(ert-deftest lsp-test-server-provides-inlay-hints () + "lsp-mode accepts inlay hints from the server and displays them." + (let ((lsp-inlay-hint-enable t) + (hint-line 2) + (hint-col 10)) + (lsp-mock-run-with-mock-server + (lsp-mock-with-temp-window + (current-buffer) + (lambda () + (lsp-test-schedule-response + "textDocument/inlayHint" + (vconcat (list `(:kind 2 + :position (:line ,hint-line :character ,hint-col) + :paddingLeft () + :label "my hint")))) + ;; Lsp will update inlay hints on idling + (lsp-test-sync-wait (progn (should (lsp-workspaces)) + (lsp-test-all-overlays 'lsp-inlay-hint))) + (let ((hints (lsp-test-all-overlays 'lsp-inlay-hint))) + (should (eq (length hints) 1)) + (should (equal (overlay-get (car hints) 'before-string) "my hint")) + (goto-char (overlay-start (car hints))) + ; 1+ to convert 0-based LSP line number to 1-based Emacs line number + (should (equal (line-number-at-pos) (1+ hint-line))) + (should (equal (current-column) hint-col)))))))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 6af0269b41..745ad0f87c 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -83,7 +83,8 @@ :documentFormattingProvider t :codeActionProvider t :declarationProvider t - :definitionProvider t) + :definitionProvider t + :inlayHintProvider t) "Capabilities of the server.") (defun greeting (id) From c78329f64f964e3128046d848be63a793b2fcbe5 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Sun, 21 Jul 2024 13:36:11 +0200 Subject: [PATCH 51/53] Test display of code lens --- test/lsp-mock-server-test.el | 19 +++++++++++++++++++ test/mock-lsp-server.el | 3 ++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 23c0d0d40c..1b744e01e2 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -840,4 +840,23 @@ line 3 words here and here (should (equal (line-number-at-pos) (1+ hint-line))) (should (equal (current-column) hint-col)))))))) +(ert-deftest lsp-test-server-provides-code-lens () + "lsp-mode accepts code lenses from the server and displays them." + (let ((line 2)) + (lsp-test-schedule-response + "textDocument/codeLens" + (vconcat (list `(:range (:start (:line ,line :character 0) + :end (:line ,line :character 1)) + :command (:title "My command" + :command "myCommand"))))) + (lsp-mock-run-with-mock-server + (lsp-test-sync-wait (lsp-test-all-overlays 'lsp-lens)) + (let ((lenses (lsp-test-all-overlays 'lsp-lens))) + (should (eq (length lenses) 1)) + (message "%s" (overlay-properties (car lenses))) + (should (string-match-p "My command" + (overlay-get (car lenses) 'after-string))) + (goto-char (overlay-start (car lenses))) + (should (equal (line-number-at-pos) (- line 1))))))) + ;;; lsp-mock-server-test.el ends here diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index 745ad0f87c..b83ac4aedb 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -84,7 +84,8 @@ :codeActionProvider t :declarationProvider t :definitionProvider t - :inlayHintProvider t) + :inlayHintProvider t + :codeLensProvider (:resolveProvider ())) "Capabilities of the server.") (defun greeting (id) From 2f5e5cf9c64b14989f7d1bda832fc1b300345c43 Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Tue, 23 Jul 2024 20:58:24 +0200 Subject: [PATCH 52/53] Fix xref-related tests for emacs 27.2 --- test/lsp-mock-server-test.el | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index 1b744e01e2..f71a0a3ae3 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -212,6 +212,15 @@ opens the `lsp-test-sample-file' and starts the mock server." (workspace-root (file-name-directory lsp-test-sample-file)) (initial-server-count (lsp-test-total-folder-count))) (register-mock-client) ; register mock client as the one an only lsp client + + ;; xref in emacs 27.2 does not have these vars, + ;; but lsp-mode uses them in lsp-show-xrefs. + ;; For the purpose of this test, it does not matter. + (unless (boundp 'xref-auto-jump-to-first-xref) + (defvar xref-auto-jump-to-first-xref nil)) + (unless (boundp 'xref-auto-jump-to-first-definition) + (defvar xref-auto-jump-to-first-definition nil)) + (lsp-workspace-folders-add workspace-root) (let* ((buf (find-file-noselect lsp-test-sample-file))) (unwind-protect @@ -434,11 +443,6 @@ Scan CONTENTS for all occurences of WORD and compose a list of references." (lsp-test-schedule-response "textDocument/references" (lsp-test-make-references lsp-test-sample-file (buffer-string) "unique")) - ;; xref in emacs 27.2 does not have this var, - ;; but lsp-mode uses it in lsp-show-xrefs. - ;; For the purpose of this test, it does not matter. - (unless (boundp 'xref-auto-jump-to-first-xref) - (defvar xref-auto-jump-to-first-xref nil)) (lsp-find-references) (should found-xrefs) (should (eq (length found-xrefs) 3)) From c06d8c9ed5b272d8a6a01261db8f36856da7e97f Mon Sep 17 00:00:00 2001 From: Arseniy Zaostrovnykh Date: Tue, 23 Jul 2024 21:30:20 +0200 Subject: [PATCH 53/53] Fix race condition affecting lsp-mock-server-provides-inlay-hints test --- test/lsp-mock-server-test.el | 5 +++-- test/mock-lsp-server.el | 16 ++++++++-------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/test/lsp-mock-server-test.el b/test/lsp-mock-server-test.el index f71a0a3ae3..7d3323c7d7 100644 --- a/test/lsp-mock-server-test.el +++ b/test/lsp-mock-server-test.el @@ -818,7 +818,7 @@ line 3 words here and here (should (equal (1+ (plist-get decl-range :line)) (line-number-at-pos))) (should (equal (plist-get decl-range :from) (current-column)))))) -(ert-deftest lsp-test-server-provides-inlay-hints () +(ert-deftest lsp-mock-server-provides-inlay-hints () "lsp-mode accepts inlay hints from the server and displays them." (let ((lsp-inlay-hint-enable t) (hint-line 2) @@ -834,6 +834,7 @@ line 3 words here and here :paddingLeft () :label "my hint")))) ;; Lsp will update inlay hints on idling + (run-hooks 'lsp-on-idle-hook) (lsp-test-sync-wait (progn (should (lsp-workspaces)) (lsp-test-all-overlays 'lsp-inlay-hint))) (let ((hints (lsp-test-all-overlays 'lsp-inlay-hint))) @@ -844,7 +845,7 @@ line 3 words here and here (should (equal (line-number-at-pos) (1+ hint-line))) (should (equal (current-column) hint-col)))))))) -(ert-deftest lsp-test-server-provides-code-lens () +(ert-deftest lsp-mock-server-provides-code-lens () "lsp-mode accepts code lenses from the server and displays them." (let ((line 2)) (lsp-test-schedule-response diff --git a/test/mock-lsp-server.el b/test/mock-lsp-server.el index b83ac4aedb..aa2d690952 100644 --- a/test/mock-lsp-server.el +++ b/test/mock-lsp-server.el @@ -142,7 +142,7 @@ Key is the method, and value is the `result' field in the response.") This function is useful for external commands, allowing control over the server responses. -You can schedule only one response for a method at a time." +You can schedule only one response for a method for the entire session." (when (gethash method scheduled-responses) (error "Response for method %s is already scheduled" method)) (puthash method result scheduled-responses)) @@ -154,15 +154,15 @@ Returns nil if no method is found." (when (string-match "\"method\":\"\\([^\"]+\\)\"" input) (match-string 1 input))) -(defun pop-response-for-request (method) - "Find and erase a scheduled response for METHOD request. +(defun get-response-for-request (method) + "Find the scheduled response for METHOD request. Returns empty array if not found: - empty array is the usual representation of empty result." + empty array is the usual representation of empty result. + +The response is not removed to cover for potential plural requests." (if-let ((response (gethash method scheduled-responses))) - (progn - (remhash method scheduled-responses) - response) + response [])) (defun handle-lsp-client-input () @@ -183,7 +183,7 @@ Returns empty array if not found: ;; Acknowledge that it is received (princ (respond (get-id line) - (pop-response-for-request (get-method line))))) + (get-response-for-request (get-method line))))) ((or (string-match "Content-Length" line) (string-match "Content-Type" line)) ;; Ignore header