From 9c0d7bb73bb6a8d81b476d3fa497569c3061bdca Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Dec 2022 18:10:43 +0000 Subject: [PATCH] Add automated tests for Eglot Most of the tests require a specific LSP server to do their thing, and skip themselves if this server isn't found. This file is a modified/overhauled version of the original Eglot automated tests that were developed in the old GitHub upstream. * test/lisp/progmodes/eglot-tests.el: New file. --- test/lisp/progmodes/eglot-tests.el | 1308 ++++++++++++++++++++++++++++ 1 file changed, 1308 insertions(+) create mode 100644 test/lisp/progmodes/eglot-tests.el diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el new file mode 100644 index 00000000000..2b4de8c27d0 --- /dev/null +++ b/test/lisp/progmodes/eglot-tests.el @@ -0,0 +1,1308 @@ +;;; eglot-tests.el --- Tests for eglot.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2018-2022 Free Software Foundation, Inc. + +;; Author: João Távora +;; Keywords: tests + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for lisp/progmodes/eglot.el +;; +;; Many of these tests rely on the availability of third-party LSP +;; servers. They are automatically skipped if the program is not +;; available. +;; +;; Some of these tests rely on the GNU ELPA package company.el and +;; yasnippet.el being available. + +;;; Code: +(require 'eglot) +(require 'cl-lib) +(require 'ert) +(require 'ert-x) ; ert-simulate-command +(require 'edebug) +(require 'python) ; some tests use pylsp +(require 'cc-mode) ; c-mode-hook +(require 'company nil t) +(require 'yasnippet nil t) +(require 'tramp) +(require 'tramp-sh) +(require 'subr-x) +(require 'flymake) ; project-diagnostics + +;;; Helpers + +(defmacro eglot--with-fixture (fixture &rest body) + "Setup FIXTURE, call BODY, teardown FIXTURE. +FIXTURE is a list. Its elements are of the form (FILE . CONTENT) +to create a readable FILE with CONTENT. FILE may be a directory +name and CONTENT another (FILE . CONTENT) list to specify a +directory hierarchy. FIXTURE's elements can also be (SYMBOL +VALUE) meaning SYMBOL should be bound to VALUE during BODY and +then restored." + (declare (indent 1) (debug t)) + `(eglot--call-with-fixture + ,fixture #'(lambda () ,@body))) + +(defun eglot--make-file-or-dir (ass) + (let ((file-or-dir-name (car ass)) + (content (cdr ass))) + (cond ((listp content) + (make-directory file-or-dir-name 'parents) + (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (mapcan #'eglot--make-file-or-dir content))) + ((stringp content) + (with-temp-buffer + (insert content) + (write-region nil nil file-or-dir-name nil 'nomessage)) + (list (expand-file-name file-or-dir-name))) + (t + (eglot--error "Expected a string or a directory spec"))))) + +(defun eglot--call-with-fixture (fixture fn) + "Helper for `eglot--with-fixture'. Run FN under FIXTURE." + (let* ((fixture-directory (make-temp-file "eglot--fixture" t)) + (default-directory fixture-directory) + file-specs created-files + syms-to-restore + new-servers + test-body-successful-p) + (dolist (spec fixture) + (cond ((symbolp spec) + (push (cons spec (symbol-value spec)) syms-to-restore) + (set spec nil)) + ((symbolp (car spec)) + (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) + (set (car spec) (cadr spec))) + ((stringp (car spec)) (push spec file-specs)))) + (unwind-protect + (let* ((home (getenv "HOME")) + (process-environment + (append + `(;; Set XDF_CONFIG_HOME to /dev/null to prevent + ;; user-configuration to have an influence on + ;; language servers. (See github#441) + "XDG_CONFIG_HOME=/dev/null" + ;; ... on the flip-side, a similar technique by + ;; Emacs's test makefiles means that HOME is set to + ;; /nonexistent. This breaks some common + ;; installations for LSP servers like pylsp, making + ;; these tests mostly useless, so we hack around it + ;; here with a great big hack. + ,(format "HOME=%s" + (if (file-exists-p home) home + (format "/home/%s" (getenv "USER"))))) + process-environment)) + ;; Prevent "Can't guess python-indent-offset ..." messages. + (python-indent-guess-indent-offset-verbose . nil) + (eglot-server-initialized-hook + (lambda (server) (push server new-servers)))) + (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) + (prog1 (funcall fn) + (setq test-body-successful-p t))) + (eglot--message + "Test body was %s" (if test-body-successful-p "OK" "A FAILURE")) + (unwind-protect + (let ((eglot-autoreconnect nil)) + (dolist (server new-servers) + (when (jsonrpc-running-p server) + (condition-case oops + (eglot-shutdown + server nil 3 (not test-body-successful-p)) + (error + (eglot--message "Non-critical shutdown error after test: %S" + oops)))) + (when (not test-body-successful-p) + ;; We want to do this after the sockets have + ;; shut down such that any pending data has been + ;; consumed and is available in the process + ;; buffers. + (let ((buffers (delq nil (list + ;; FIXME: Accessing "internal" symbol here. + (process-buffer (jsonrpc--process server)) + (jsonrpc-stderr-buffer server) + (jsonrpc-events-buffer server))))) + (cond (noninteractive + (dolist (buffer buffers) + (eglot--message "%s:" (buffer-name buffer)) + (princ (with-current-buffer buffer (buffer-string)) + 'external-debugging-output))) + (t + (eglot--message "Preserved for inspection: %s" + (mapconcat #'buffer-name buffers ", ")))))))) + (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) + +(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) + (let ((buffers-to-delete + (delete nil (mapcar #'find-buffer-visiting created-files)))) + (eglot--message "Killing %s, wiping %s, restoring %s" + buffers-to-delete + fixture-directory + (mapcar #'car syms-to-restore)) + (cl-loop for (sym . val) in syms-to-restore + do (set sym val)) + (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted + (with-current-buffer buf (save-buffer) (kill-buffer))) + (delete-directory fixture-directory 'recursive))) + +(cl-defmacro eglot--with-timeout (timeout &body body) + (declare (indent 1) (debug t)) + `(eglot--call-with-timeout ,timeout (lambda () ,@body))) + +(defun eglot--call-with-timeout (timeout fn) + (let* ((tag (gensym "eglot-test-timeout")) + (timed-out (make-symbol "timeout")) + (timeout-and-message + (if (listp timeout) timeout + (list timeout "waiting for test to finish"))) + (timeout (car timeout-and-message)) + (message (cadr timeout-and-message)) + (timer) + (retval)) + (unwind-protect + (setq retval + (catch tag + (setq timer + (run-with-timer timeout nil + (lambda () + (unless edebug-active + (throw tag timed-out))))) + (funcall fn))) + (cancel-timer timer) + (when (eq retval timed-out) + (error "%s" (concat "Timed out " message)))))) + +(defun eglot--find-file-noselect (file &optional noerror) + (unless (or noerror + (file-readable-p file)) (error "%s does not exist" file)) + (find-file-noselect file)) + +(cl-defmacro eglot--sniffing ((&key server-requests + server-notifications + server-replies + client-requests + client-notifications + client-replies) + &rest body) + "Run BODY saving LSP JSON messages in variables, most recent first." + (declare (indent 1) (debug (sexp &rest form))) + (let ((log-event-ad-sym (make-symbol "eglot--event-sniff"))) + `(unwind-protect + (let ,(delq nil (list server-requests + server-notifications + server-replies + client-requests + client-notifications + client-replies)) + (advice-add + #'jsonrpc--log-event :before + (lambda (_proc message &optional type) + (cl-destructuring-bind (&key method id _error &allow-other-keys) + message + (let ((req-p (and method id)) + (notif-p method) + (reply-p id)) + (cond + ((eq type 'server) + (cond (req-p ,(when server-requests + `(push message ,server-requests))) + (notif-p ,(when server-notifications + `(push message ,server-notifications))) + (reply-p ,(when server-replies + `(push message ,server-replies))))) + ((eq type 'client) + (cond (req-p ,(when client-requests + `(push message ,client-requests))) + (notif-p ,(when client-notifications + `(push message ,client-notifications))) + (reply-p ,(when client-replies + `(push message ,client-replies))))))))) + '((name . ,log-event-ad-sym))) + ,@body) + (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) + +(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) + "Spin until FN match in EVENTS-SYM, flush events after it. +Pass TIMEOUT to `eglot--with-timeout'." + (declare (indent 2) (debug (sexp sexp sexp &rest form))) + `(eglot--with-timeout '(,timeout ,(or message + (format "waiting for:\n%s" (pp-to-string body)))) + (let ((event + (cl-loop thereis (cl-loop for json in ,events-sym + for method = (plist-get json :method) + when (keywordp method) + do (plist-put json :method + (substring + (symbol-name method) + 1)) + when (funcall + (jsonrpc-lambda ,args ,@body) json) + return (cons json before) + collect json into before) + for i from 0 + when (zerop (mod i 5)) + ;; do (eglot--message "still struggling to find in %s" + ;; ,events-sym) + do + ;; `read-event' is essential to have the file + ;; watchers come through. + (read-event "[eglot] Waiting a bit..." nil 0.1) + (accept-process-output nil 0.1)))) + (setq ,events-sym (cdr event)) + (eglot--message "Event detected:\n%s" + (pp-to-string (car event)))))) + +;; `rust-mode' is not a part of Emacs, so we define these two shims +;; which should be more than enough for testing. +(unless (functionp 'rust-mode) + (define-derived-mode rust-mode prog-mode "Rust") + (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))) + +;; `typescript-mode' is not a part of Emacs, so we define these two +;; shims which should be more than enough for testing. +(unless (functionp 'typescript-mode) + (define-derived-mode typescript-mode prog-mode "TypeScript") + (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode))) + +(defun eglot--tests-connect (&optional timeout) + (let* ((timeout (or timeout 10)) + (eglot-sync-connect t) + (eglot-connect-timeout timeout)) + (apply #'eglot--connect (eglot--guess-contact)))) + +(defun eglot--simulate-key-event (char) + "Like (execute-kbd-macro (vector char)), but with `call-interactively'." + ;; Also, this is a bit similar to what electric-tests.el does. + (setq last-input-event char) + (setq last-command-event char) + (call-interactively (key-binding (vector char)))) + + +;;; Unit tests + +(ert-deftest eclipse-connect () + "Connect to eclipse.jdt.ls server." + (skip-unless (executable-find "jdtls")) + (eglot--with-fixture + '(("project/src/main/java/foo" . (("Main.java" . ""))) + ("project/.git/" . nil)) + (with-current-buffer + (eglot--find-file-noselect "project/src/main/java/foo/Main.java") + (eglot--sniffing (:server-notifications s-notifs) + (should (eglot--tests-connect 20)) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "language/status")))))) + +(defun eglot-tests--auto-detect-running-server-1 () + (let (server) + (eglot--with-fixture + `(("project" . (("coiso.c" . "bla") + ("merdix.c" . "bla"))) + ("anotherproject" . (("cena.c" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "project/coiso.c") + (should (setq server (eglot--tests-connect))) + (should (eglot-current-server))) + (with-current-buffer + (eglot--find-file-noselect "project/merdix.c") + (should (eglot-current-server)) + (should (eq (eglot-current-server) server))) + (with-current-buffer + (eglot--find-file-noselect "anotherproject/cena.c") + (should-error (eglot--current-server-or-lose)))))) + +(ert-deftest auto-detect-running-server () + "Visit a file and \\[eglot], then visit a neighbour." + (skip-unless (executable-find "clangd")) + (eglot-tests--auto-detect-running-server-1)) + +(ert-deftest auto-shutdown () + "Visit a file and \\[eglot], then kill buffer." + (skip-unless (executable-find "clangd")) + (let (server + buffer) + (eglot--with-fixture + `(("project" . (("thingy.c" . "int main() {return 0;}")))) + (with-current-buffer + (setq buffer (eglot--find-file-noselect "project/thingy.c")) + (should (setq server (eglot--tests-connect))) + (should (eglot-current-server)) + (let ((eglot-autoshutdown nil)) (kill-buffer buffer)) + (should (jsonrpc-running-p server)) + ;; re-find file... + (setq buffer (eglot--find-file-noselect (buffer-file-name buffer))) + ;; ;; but now kill it with `eglot-autoshutdown' set to t + (let ((eglot-autoshutdown t)) (kill-buffer buffer)) + (should (not (jsonrpc-running-p server))))))) + +(ert-deftest auto-reconnect () + "Start a server. Kill it. Watch it reconnect." + (skip-unless (executable-find "clangd")) + (let (server (eglot-autoreconnect 1)) + (eglot--with-fixture + `(("project" . (("thingy.c" . "bla") + ("thingy2.c" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "project/thingy.c") + (should (setq server (eglot--tests-connect))) + ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We + ;; should have a automatic reconnection. + (run-with-timer 1.2 nil (lambda () (delete-process + (jsonrpc--process server)))) + (while (jsonrpc-running-p server) (accept-process-output nil 0.5)) + (should (eglot-current-server)) + ;; Now try again too quickly + (setq server (eglot-current-server)) + (let ((proc (jsonrpc--process server))) + (run-with-timer 0.5 nil (lambda () (delete-process proc))) + (while (process-live-p proc) (accept-process-output nil 0.5))) + (should (not (eglot-current-server))))))) + +(ert-deftest rust-analyzer-watches-files () + "Start rust-analyzer. Notify it when a critical file changes." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (let ((eglot-autoreconnect 1)) + (eglot--with-fixture + '(("watch-project" . (("coiso.rs" . "bla") + ("merdix.rs" . "bla")))) + (with-current-buffer + (eglot--find-file-noselect "watch-project/coiso.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing ( + :server-requests s-requests + :client-notifications c-notifs + :client-replies c-replies + ) + (should (eglot--tests-connect)) + (let (register-id) + (eglot--wait-for (s-requests 1) + (&key id method &allow-other-keys) + (setq register-id id) + (string= method "client/registerCapability")) + (eglot--wait-for (c-replies 1) + (&key id error &allow-other-keys) + (and (eq id register-id) (null error)))) + (delete-file "Cargo.toml") + (eglot--wait-for + (c-notifs 3 "waiting for didChangeWatchedFiles notification") + (&key method params &allow-other-keys) + (and (string= method "workspace/didChangeWatchedFiles") + (cl-destructuring-bind (&key uri type) + (elt (plist-get params :changes) 0) + (and (string= (eglot--path-to-uri "Cargo.toml") uri) + (= type 3)))))))))) + +(ert-deftest basic-diagnostics () + "Test basic diagnostics." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("diag-project" . + (("main.c" . "int main(){froat a = 42.2; return 0;}")))) + (with-current-buffer + (eglot--find-file-noselect "diag-project/main.c") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (eglot--wait-for (s-notifs 2) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (flymake-start) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'flymake-error (face-at-point))))))) + +(ert-deftest diagnostic-tags-unnecessary-code () + "Test rendering of diagnostics tagged \"unnecessary\"." + (skip-unless (executable-find "rust-analyzer")) + (eglot--with-fixture + '(("diagnostic-tag-project" . + (("main.rs" . + "fn main() -> () { let test=3; }")))) + (with-current-buffer + (eglot--find-file-noselect "diagnostic-tag-project/main.rs") + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (flymake-start) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'eglot-diagnostic-tag-unnecessary-face (face-at-point)))))))) + +(defun eglot--eldoc-on-demand () + ;; Trick Eldoc 1.1.0 into accepting on-demand calls. + (eldoc t)) + +(defun eglot--tests-force-full-eldoc () + ;; FIXME: This uses some Eldoc implementation defatils. + (when (buffer-live-p eldoc--doc-buffer) + (with-current-buffer eldoc--doc-buffer + (let ((inhibit-read-only t)) + (erase-buffer)))) + (eglot--eldoc-on-demand) + (cl-loop + repeat 10 + for retval = (and (buffer-live-p eldoc--doc-buffer) + (with-current-buffer eldoc--doc-buffer + (let ((bs (buffer-string))) + (unless (zerop (length bs)) bs)))) + when retval return retval + do (sit-for 0.5) + finally (error "eglot--tests-force-full-eldoc didn't deliver"))) + +(ert-deftest rust-analyzer-hover-after-edit () + "Hover and highlightChanges." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (eglot--with-fixture + '(("hover-project" . + (("main.rs" . + "fn test() -> i32 { let test=3; return te; }")))) + (with-current-buffer + (eglot--find-file-noselect "hover-project/main.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing ( + :server-replies s-replies + :client-requests c-reqs + ) + (eglot--tests-connect) + (goto-char (point-min)) + (search-forward "return te") + (insert "st") + (progn + ;; simulate these two which don't happen when buffer isn't + ;; visible in a window. + (eglot--signal-textDocument/didChange) + (eglot--eldoc-on-demand)) + (let (pending-id) + (eglot--wait-for (c-reqs 2) + (&key id method &allow-other-keys) + (setq pending-id id) + (string= method "textDocument/documentHighlight")) + (eglot--wait-for (s-replies 2) + (&key id &allow-other-keys) + (eq id pending-id))))))) + +(ert-deftest rename-a-symbol () + "Test basic symbol renaming." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("rename-project" + . (("main.c" . + "int foo() {return 42;} int main() {return foo();}")))) + (with-current-buffer + (eglot--find-file-noselect "rename-project/main.c") + (eglot--tests-connect) + (goto-char (point-min)) (search-forward "foo") + (eglot-rename "bar") + (should (equal (buffer-string) + "int bar() {return 42;} int main() {return bar();}"))))) + +(ert-deftest basic-completions () + "Test basic autocompletion in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "import sys\nsys.exi")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point) + (should (looking-back "sys.exit"))))) + +(ert-deftest non-unique-completions () + "Test completion resulting in 'Complete, but not unique'." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point)) + ;; FIXME: `current-message' doesn't work here :-( + (with-current-buffer (messages-buffer) + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (should (looking-at "Complete, but not unique")))))) + +(ert-deftest basic-xref () + "Test basic xref functionality in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (search-forward "bar(): f") + (call-interactively 'xref-find-definitions) + (should (looking-at "foo(): pass"))))) + +(defvar eglot--test-python-buffer + "\ +def foobarquux(a, b, c=True): pass +def foobazquuz(d, e, f): pass +") + +(declare-function yas-minor-mode nil) + +(ert-deftest snippet-completions () + "Test simple snippet completion in a python LSP." + (skip-unless (and (executable-find "pylsp") + (functionp 'yas-minor-mode))) + (eglot--with-fixture + `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (yas-minor-mode 1) + (let ((eglot-workspace-configuration + `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) + (should (eglot--tests-connect))) + (goto-char (point-max)) + (insert "foobar") + (completion-at-point) + (should (looking-back "foobarquux(")) + (should (looking-at "a, b)"))))) + +(defvar company-candidates) +(declare-function company-mode nil) +(declare-function company-complete nil) + +(ert-deftest snippet-completions-with-company () + "Test simple snippet completion in a python LSP." + (skip-unless (and (executable-find "pylsp") + (functionp 'yas-minor-mode) + (functionp 'company-complete))) + (eglot--with-fixture + `(("project" . (("something.py" . ,eglot--test-python-buffer)))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (yas-minor-mode 1) + (let ((eglot-workspace-configuration + `((:pylsp . (:plugins (:jedi_completion (:include_params t))))))) + (should (eglot--tests-connect))) + (goto-char (point-max)) + (insert "foo") + (company-mode) + (company-complete) + (should (looking-back "fooba")) + (should (= 2 (length company-candidates))) + ;; this last one is brittle, since there it is possible that + ;; pylsp will change the representation of this candidate + (should (member "foobazquuz(d, e, f)" company-candidates))))) + +(ert-deftest eglot-eldoc-after-completions () + "Test documentation echo in a python LSP." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("something.py" . "import sys\nsys.exi")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + (completion-at-point) + (should (looking-back "sys.exit")) + (should (string-match "^exit" (eglot--tests-force-full-eldoc)))))) + +(ert-deftest eglot-multiline-eldoc () + "Test if suitable amount of lines of hover info are shown." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("hover-first.py" . "from datetime import datetime")))) + (with-current-buffer + (eglot--find-file-noselect "project/hover-first.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + ;; one-line + (let* ((eldoc-echo-area-use-multiline-p t) + (captured-message (eglot--tests-force-full-eldoc))) + (should (string-match "datetim" captured-message)) + (should (cl-find ?\n captured-message)))))) + +(ert-deftest eglot-single-line-eldoc () + "Test if suitable amount of lines of hover info are shown." + (skip-unless (executable-find "pylsp")) + (eglot--with-fixture + `(("project" . (("hover-first.py" . "from datetime import datetime")))) + (with-current-buffer + (eglot--find-file-noselect "project/hover-first.py") + (should (eglot--tests-connect)) + (goto-char (point-max)) + ;; one-line + (let* ((eldoc-echo-area-use-multiline-p nil) + (captured-message (eglot--tests-force-full-eldoc))) + (should (string-match "datetim" captured-message)) + (should (not (cl-find ?\n eldoc-last-message))))))) + +(ert-deftest python-autopep-formatting () + "Test formatting in the pylsp python LSP. +pylsp prefers autopep over yafp, despite its README stating the contrary." + ;; Beware, default autopep rules can change over time, which may + ;; affect this test. + (skip-unless (and (executable-find "pylsp") + (executable-find "autopep8"))) + (eglot--with-fixture + `(("project" . (("something.py" . "def a():pass\n\ndef b():pass")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + ;; Try to format just the second line + (search-forward "b():pa") + (eglot-format (line-beginning-position) (line-end-position)) + (should (looking-at "ss")) + (should + (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n")) + ;; now format the whole buffer + (eglot-format-buffer) + (should + (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n"))))) + +(ert-deftest python-yapf-formatting () + "Test formatting in the pylsp python LSP." + (skip-unless (and (executable-find "pylsp") + (not (executable-find "autopep8")) + (or (executable-find "yapf") + (executable-find "yapf3")))) + (eglot--with-fixture + `(("project" . (("something.py" . "def a():pass\ndef b():pass")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.py") + (should (eglot--tests-connect)) + ;; Try to format just the second line + (search-forward "b():pa") + (eglot-format (line-beginning-position) (line-end-position)) + (should (looking-at "ss")) + (should + (string= (buffer-string) "def a():pass\n\n\ndef b():\n pass\n")) + ;; now format the whole buffer + (eglot-format-buffer) + (should + (string= (buffer-string) "def a():\n pass\n\n\ndef b():\n pass\n"))))) + +(ert-deftest rust-on-type-formatting () + "Test textDocument/onTypeFormatting agains rust-analyzer." + (skip-unless (executable-find "rust-analyzer")) + (skip-unless (executable-find "cargo")) + (eglot--with-fixture + '(("on-type-formatting-project" . + (("main.rs" . + "fn main() -> () {\n foo\n .bar()\n ")))) + (with-current-buffer + (eglot--find-file-noselect "on-type-formatting-project/main.rs") + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (should (eglot--tests-connect)) + (eglot--wait-for (s-notifs 10) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics"))) + (goto-char (point-max)) + (eglot--simulate-key-event ?.) + (should (looking-back "^ \\.")))))) + +(ert-deftest javascript-basic () + "Test basic autocompletion in a JavaScript LSP." + (skip-unless (executable-find "typescript-language-server")) + (eglot--with-fixture + '(("project" . (("hello.js" . "console.log('Hello world!');")))) + (with-current-buffer + (eglot--find-file-noselect "project/hello.js") + (let ((eglot-server-programs + '((js-mode . ("typescript-language-server" "--stdio"))))) + (goto-char (point-max)) + (eglot--sniffing (:server-notifications + s-notifs + :client-notifications + c-notifs) + (should (eglot--tests-connect)) + (eglot--wait-for (s-notifs 2) (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (not (eq 'flymake-error (face-at-point)))) + (insert "{") + (eglot--signal-textDocument/didChange) + (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys) + (string= method "textDocument/didChange")) + (eglot--wait-for (s-notifs 2) (&key params method &allow-other-keys) + (and (string= method "textDocument/publishDiagnostics") + (cl-destructuring-bind (&key _uri diagnostics) params + (cl-find-if (jsonrpc-lambda (&key severity &allow-other-keys) + (= severity 1)) + diagnostics))))))))) + +(ert-deftest project-wide-diagnostics-typescript () + "Test diagnostics through multiple files in a TypeScript LSP." + (skip-unless (executable-find "typescript-language-server")) + (eglot--with-fixture + '(("project" . (("hello.ts" . "const thing = 5;\nexport { thin }") + ("hello2.ts" . "import { thing } from './hello'")))) + (eglot--make-file-or-dir '(".git")) + (let ((eglot-server-programs + '((typescript-mode . ("typescript-language-server" "--stdio"))))) + ;; Check both files because typescript-language-server doesn't + ;; report all errors on startup, at least not with such a simple + ;; setup. + (with-current-buffer (eglot--find-file-noselect "project/hello2.ts") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (= 2 (length (flymake--project-diagnostics))))) + (with-current-buffer (eglot--find-file-noselect "hello.ts") + (eglot--sniffing (:server-notifications s-notifs) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (should (= 4 (length (flymake--project-diagnostics)))))))))) + +(ert-deftest project-wide-diagnostics-rust-analyzer () + "Test diagnostics through multiple files in a TypeScript LSP." + (skip-unless (executable-find "rust-analyzer")) + (eglot--with-fixture + '(("project" . + (("main.rs" . + "fn main() -> () { let test=3; }") + ("other-file.rs" . + "fn foo() -> () { let hi=3; }")))) + (eglot--make-file-or-dir '(".git")) + (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) + ;; Open other-file, and see diagnostics arrive for main.rs + (with-current-buffer (eglot--find-file-noselect "project/other-file.rs") + (should (zerop (shell-command "cargo init"))) + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect) + (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key _id method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) + (let ((diags (flymake--project-diagnostics))) + (should (= 2 (length diags))) + ;; Check that we really get a diagnostic from main.rs, and + ;; not from other-file.rs + (should (string-suffix-p + "main.rs" + (flymake-diagnostic-buffer (car diags)))))))))) + +(ert-deftest json-basic () + "Test basic autocompletion in vscode-json-languageserver." + (skip-unless (executable-find "vscode-json-languageserver")) + (eglot--with-fixture + '(("project" . + (("p.json" . "{\"foo.b") + ("s.json" . "{\"properties\":{\"foo.bar\":{\"default\":\"fb\"}}}") + (".git" . nil)))) + (with-current-buffer + (eglot--find-file-noselect "project/p.json") + (yas-minor-mode) + (goto-char 2) + (insert "\"$schema\": \"file://" + (file-name-directory buffer-file-name) "s.json\",") + (let ((eglot-server-programs + '((js-mode . ("vscode-json-languageserver" "--stdio"))))) + (goto-char (point-max)) + (should (eglot--tests-connect)) + (completion-at-point) + (should (looking-back "\"foo.bar\": \"")) + (should (looking-at "fb\"$")))))) + +(defun eglot-tests--lsp-abiding-column-1 () + (eglot--with-fixture + '(("project" . + (("foo.c" . "const char write_data[] = u8\"🚂🚃🚄🚅🚆🚈🚇🚈🚉🚊🚋🚌🚎🚝🚞🚟🚠🚡🛤🛲\";")))) + (let ((eglot-server-programs + '((c-mode . ("clangd"))))) + (with-current-buffer + (eglot--find-file-noselect "project/foo.c") + (setq-local eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column) + (setq-local eglot-current-column-function #'eglot-lsp-abiding-column) + (eglot--sniffing (:client-notifications c-notifs) + (eglot--tests-connect) + (end-of-line) + (insert "p ") + (eglot--signal-textDocument/didChange) + (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys) + (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0)))))) + (beginning-of-line) + (should (eq eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column)) + (funcall eglot-move-to-column-function 71) + (should (looking-at "p"))))))) + +(ert-deftest eglot-lsp-abiding-column () + "Test basic `eglot-lsp-abiding-column' and `eglot-move-to-lsp-abiding-column'." + (skip-unless (executable-find "clangd")) + (eglot-tests--lsp-abiding-column-1)) + +(ert-deftest eglot-ensure () + "Test basic `eglot-ensure' functionality." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("foo.c" . "int foo() {return 42;}") + ("bar.c" . "int bar() {return 42;}"))) + (c-mode-hook (eglot-ensure))) + (let (server) + ;; need `ert-simulate-command' because `eglot-ensure' + ;; relies on `post-command-hook'. + (with-current-buffer + (ert-simulate-command + '(find-file "project/foo.c")) + ;; FIXME: This test fails without this sleep on my machine. + ;; Figure out why and solve this more cleanly. + (sleep-for 0.1) + (should (setq server (eglot-current-server)))) + (with-current-buffer + (ert-simulate-command + '(find-file "project/bar.c")) + (should (eq server (eglot-current-server))))))) + +(ert-deftest slow-sync-connection-wait () + "Connect with `eglot-sync-connect' set to t." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect t) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) + (should (eglot--tests-connect 3)))))) + +(ert-deftest slow-sync-connection-intime () + "Connect synchronously with `eglot-sync-connect' set to 2." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect 2) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) + (should (eglot--tests-connect 3)))))) + +(ert-deftest slow-async-connection () + "Connect asynchronously with `eglot-sync-connect' set to 2." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect 1) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 2 && clangd"))))) + (should-not (apply #'eglot--connect (eglot--guess-contact))) + (eglot--with-timeout 3 + (while (not (eglot-current-server)) + (accept-process-output nil 0.2)) + (should (eglot-current-server))))))) + +(ert-deftest slow-sync-timeout () + "Failed attempt at connection synchronously." + (skip-unless (executable-find "clangd")) + (eglot--with-fixture + `(("project" . (("something.c" . "int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/something.c") + (let ((eglot-sync-connect t) + (eglot-connect-timeout 1) + (eglot-server-programs + `((c-mode . ("sh" "-c" "sleep 2 && clangd"))))) + (should-error (apply #'eglot--connect (eglot--guess-contact))))))) + +(ert-deftest eglot-capabilities () + "Unit test for `eglot--server-capable'." + (cl-letf (((symbol-function 'eglot--capabilities) + (lambda (_dummy) + ;; test data lifted from Golangserver example at + ;; https://github.com/joaotavora/eglot/pull/74 + (list :textDocumentSync 2 :hoverProvider t + :completionProvider '(:triggerCharacters ["."]) + :signatureHelpProvider '(:triggerCharacters ["(" ","]) + :definitionProvider t :typeDefinitionProvider t + :referencesProvider t :documentSymbolProvider t + :workspaceSymbolProvider t :implementationProvider t + :documentFormattingProvider t :xworkspaceReferencesProvider t + :xdefinitionProvider t :xworkspaceSymbolByProperties t))) + ((symbol-function 'eglot--current-server-or-lose) + (lambda () nil))) + (should (eql 2 (eglot--server-capable :textDocumentSync))) + (should (eglot--server-capable :completionProvider :triggerCharacters)) + (should (equal '(:triggerCharacters ["."]) (eglot--server-capable :completionProvider))) + (should-not (eglot--server-capable :foobarbaz)) + (should-not (eglot--server-capable :textDocumentSync :foobarbaz)))) + +(defmacro eglot--without-interface-warnings (&rest body) + (let ((eglot-strict-mode nil)) + (macroexpand-all (macroexp-progn body) macroexpand-all-environment))) + +(ert-deftest eglot-strict-interfaces () + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz)))))) + (eglot--without-interface-warnings + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode nil)) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar") + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar)))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode nil)) + (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix bargh) + (cons foo bar)))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode '(disallow-non-standard-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh) + (cons foo bar))))) + (should + (equal '("foo" . nil) + (let ((eglot-strict-mode nil)) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh) + (cons foo bar))))) + (should + (equal '("foo" . "bar") + (let ((eglot-strict-mode '(enforce-required-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh) + (cons foo bar))))) + (should-error + (let ((eglot-strict-mode '(enforce-required-keys))) + (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh) + (cons foo bar))))))) + +(ert-deftest eglot-dcase () + (eglot--without-interface-warnings + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz))) + (CodeAction (:title) (:kind :diagnostics :edit :command)) + (Command ((:title . string) (:command . string)) (:arguments))))) + (should + (equal + "foo" + (eglot--dcase `(:foo "foo" :bar "bar") + (((FooObject) foo) + foo)))) + (should + (equal + (list "foo" '(:title "hey" :command "ho") "some edit") + (eglot--dcase '(:title "foo" + :command (:title "hey" :command "ho") + :edit "some edit") + (((Command) _title _command _arguments) + (ert-fail "Shouldn't have destructured this object as a Command")) + (((CodeAction) title edit command) + (list title command edit))))) + (should + (equal + (list "foo" "some command" nil) + (eglot--dcase '(:title "foo" :command "some command") + (((Command) title command arguments) + (list title command arguments)) + (((CodeAction) _title _edit _command) + (ert-fail "Shouldn't have destructured this object as a CodeAction")))))))) + +(ert-deftest eglot-dcase-issue-452 () + (let ((eglot--lsp-interface-alist + `((FooObject . ((:foo :bar) (:baz))) + (CodeAction (:title) (:kind :diagnostics :edit :command)) + (Command ((string . :title) (:command . string)) (:arguments))))) + (should + (equal + (list "foo" '(:command "cmd" :title "alsofoo")) + (eglot--dcase '(:title "foo" :command (:command "cmd" :title "alsofoo")) + (((Command) _title _command _arguments) + (ert-fail "Shouldn't have destructured this object as a Command")) + (((CodeAction) title command) + (list title command))))))) + +(cl-defmacro eglot--guessing-contact ((interactive-sym + prompt-args-sym + guessed-class-sym guessed-contact-sym + &optional guessed-lang-id-sym) + &body body) + "Guess LSP contact with `eglot--guessing-contact', evaluate BODY. + +BODY is evaluated twice, with INTERACTIVE bound to the boolean passed to +`eglot--guess-contact' each time. + +If the user would have been prompted, PROMPT-ARGS-SYM is bound to +the list of arguments that would have been passed to +`read-shell-command', else nil. GUESSED-CLASS-SYM, +GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM are bound to the +useful return values of `eglot--guess-contact'. Unless the +server program evaluates to \"a-missing-executable.exe\", this +macro will assume it exists." + (declare (indent 1) (debug t)) + (let ((i-sym (cl-gensym))) + `(dolist (,i-sym '(nil t)) + (let ((,interactive-sym ,i-sym) + (buffer-file-name "_") + ,@(when prompt-args-sym `((,prompt-args-sym nil)))) + (cl-letf (((symbol-function 'executable-find) + (lambda (name &optional _remote) + (unless (string-equal name "a-missing-executable.exe") + (format "/totally-mock-bin/%s" name)))) + ((symbol-function 'read-shell-command) + ,(if prompt-args-sym + `(lambda (&rest args) (setq ,prompt-args-sym args) "") + `(lambda (&rest _dummy) "")))) + (cl-destructuring-bind + (_ _ ,guessed-class-sym ,guessed-contact-sym + ,(or guessed-lang-id-sym '_)) + (eglot--guess-contact ,i-sym) + ,@body)))))) + +(ert-deftest eglot-server-programs-simple-executable () + (let ((eglot-server-programs '((foo-mode "some-executable"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-simple-missing-executable () + (let ((eglot-server-programs '((foo-mode "a-missing-executable.exe"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (interactive-p prompt-args guessed-class guessed-contact) + (should (equal (not prompt-args) (not interactive-p))) + (should (equal guessed-class 'eglot-lsp-server)) + (should (or prompt-args + (equal guessed-contact '("a-missing-executable.exe"))))))) + +(ert-deftest eglot-server-programs-executable-multiple-major-modes () + (let ((eglot-server-programs '(((bar-mode foo-mode) "some-executable"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-executable-with-arg () + (let ((eglot-server-programs '((foo-mode "some-executable" "arg1"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable" "arg1")))))) + +(ert-deftest eglot-server-programs-executable-with-args-and-autoport () + (let ((eglot-server-programs '((foo-mode "some-executable" "arg1" + :autoport "arg2"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable" "arg1" + :autoport "arg2")))))) + +(ert-deftest eglot-server-programs-host-and-port () + (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("somehost.example.com" 7777)))))) + +(ert-deftest eglot-server-programs-host-and-port-and-tcp-args () + (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777 + :type network))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("somehost.example.com" 7777 + :type network)))))) + +(ert-deftest eglot-server-programs-class-name-and-plist () + (let ((eglot-server-programs '((foo-mode bar-class :init-key init-val))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'bar-class)) + (should (equal guessed-contact '(:init-key init-val)))))) + +(ert-deftest eglot-server-programs-class-name-and-contact-spec () + (let ((eglot-server-programs '((foo-mode bar-class "some-executable" "arg1" + :autoport "arg2"))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'bar-class)) + (should (equal guessed-contact '("some-executable" "arg1" + :autoport "arg2")))))) + +(ert-deftest eglot-server-programs-function () + (let ((eglot-server-programs '((foo-mode . (lambda (&optional _) + '("some-executable"))))) + (major-mode 'foo-mode)) + (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact) + (should (not prompt-args)) + (should (equal guessed-class 'eglot-lsp-server)) + (should (equal guessed-contact '("some-executable")))))) + +(ert-deftest eglot-server-programs-guess-lang () + (let ((major-mode 'foo-mode)) + (let ((eglot-server-programs '((foo-mode . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "foo")))) + (let ((eglot-server-programs '(((foo-mode :language-id "bar") + . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "bar")))) + (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar")) + . ("prog-executable"))))) + (eglot--guessing-contact (_ nil _ _ guessed-lang) + (should (equal guessed-lang "bar")))))) + +(defun eglot--glob-match (glob str) + (funcall (eglot--glob-compile glob t t) str)) + +(ert-deftest eglot--glob-test () + (should (eglot--glob-match "foo/**/baz" "foo/bar/baz")) + (should (eglot--glob-match "foo/**/baz" "foo/baz")) + (should-not (eglot--glob-match "foo/**/baz" "foo/bar")) + (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz")) + (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz")) + (should-not (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/ding/foo/quuz")) + (should (eglot--glob-match "*.js" "foo.js")) + (should-not (eglot--glob-match "*.js" "foo.jsx")) + (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js")) + (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx")) + (should (eglot--glob-match "*.{js,ts}" "foo.js")) + (should-not (eglot--glob-match "*.{js,ts}" "foo.xs")) + (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts")) + (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx")) + (should (eglot--glob-match "?oo.js" "foo.js")) + (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz")) + (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz")) + (should (eglot--glob-match "example.[!0-9]" "example.a")) + (should-not (eglot--glob-match "example.[!0-9]" "example.0")) + (should (eglot--glob-match "example.[0-9]" "example.0")) + (should-not (eglot--glob-match "example.[0-9]" "example.a")) + (should (eglot--glob-match "**/bar/" "foo/bar/")) + (should-not (eglot--glob-match "foo.hs" "fooxhs")) + + ;; Some more tests + (should (eglot--glob-match "**/.*" ".git")) + (should (eglot--glob-match ".?" ".o")) + (should (eglot--glob-match "**/.*" ".hidden.txt")) + (should (eglot--glob-match "**/.*" "path/.git")) + (should (eglot--glob-match "**/.*" "path/.hidden.txt")) + (should (eglot--glob-match "**/node_modules/**" "node_modules/")) + (should (eglot--glob-match "{foo,bar}/**" "foo/test")) + (should (eglot--glob-match "{foo,bar}/**" "bar/test")) + (should (eglot--glob-match "some/**/*" "some/foo.js")) + (should (eglot--glob-match "some/**/*" "some/folder/foo.js")) + + ;; VSCode supposedly supports this, not sure if good idea. + ;; + ;; (should (eglot--glob-match "**/node_modules/**" "node_modules")) + ;; (should (eglot--glob-match "{foo,bar}/**" "foo")) + ;; (should (eglot--glob-match "{foo,bar}/**" "bar")) + + ;; VSCode also supports nested blobs. Do we care? + ;; + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js")) + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts")) + ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5")) + ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" "prefix/foo.8")) + ) + +(defun eglot--call-with-tramp-test (fn) + ;; Set up a loopback TRAMP method that’s just a shell so the remote + ;; host is really just the local host. + (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path)) + (tramp-histfile-override t) + (tramp-methods '(("loopback" + (tramp-login-program "/bin/sh") + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-login ("-l")) + (tramp-remote-shell-args ("-c"))))) + (temporary-file-directory (concat "/loopback::" + temporary-file-directory))) + ;; With ‘temporary-file-directory’ bound to the ‘loopback’ TRAMP + ;; method, fixtures will be automatically made “remote". + (unwind-protect + (funcall fn) + ;; Tramp leave some buffers behind, and some time later, + ;; `project-buffers' will trip over them causing a hard to debug + ;; intermittent test failure somewhere else. + (dolist (buf (buffer-list)) + (when (string-match-p "^\\*tramp" (buffer-name buf)) + (kill-buffer buf)))))) + +(ert-deftest eglot--tramp-test () + "Ensure LSP servers can be used over TRAMP." + (skip-unless (executable-find "clangd")) + (eglot--call-with-tramp-test #'eglot-tests--auto-detect-running-server-1)) + +(ert-deftest eglot--tramp-test-2 () + "Ensure LSP servers can be used over TRAMP." + (skip-unless (executable-find "clangd")) + (eglot--call-with-tramp-test #'eglot-tests--lsp-abiding-column-1)) + +(ert-deftest eglot--path-to-uri-windows () + (skip-unless (eq system-type 'windows-nt)) + (should (string-prefix-p "file:///" + (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))) + (should (string-suffix-p "c%3A/Users/Foo/bar.lisp" + (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))) + +(ert-deftest eglot--same-server-multi-mode () + "Check single LSP instance manages multiple modes in same project." + (skip-unless (executable-find "clangd")) + (let (server) + (eglot--with-fixture + `(("project" . (("foo.cpp" . + "#include \"foolib.h\" + int main() { return foo(); }") + ("foolib.h" . + "#ifdef __cplusplus\nextern \"C\" {\n#endif + int foo(); + #ifdef __cplusplus\n}\n#endif") + ("foolib.c" . + "#include \"foolib.h\" + int foo() {return 42;}")))) + (with-current-buffer + (eglot--find-file-noselect "project/foo.cpp") + (should (setq server (eglot--tests-connect)))) + (with-current-buffer + (eglot--find-file-noselect "project/foolib.h") + (should (eq (eglot-current-server) server))) + (with-current-buffer + (eglot--find-file-noselect "project/foolib.c") + (should (eq (eglot-current-server) server)))))) + +(provide 'eglot-tests) +;;; eglot-tests.el ends here + +;; Local Variables: +;; checkdoc-force-docstrings-flag: nil +;; End: -- 2.39.2