dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

eglot-tests.el (52062B)


      1 ;;; eglot-tests.el --- Tests for eglot.el            -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
      4 
      5 ;; Author: Joรฃo Tรกvora <joaotavora@gmail.com>
      6 ;; Keywords: tests
      7 
      8 ;; This file is part of GNU Emacs.
      9 
     10 ;; GNU Emacs is free software: you can redistribute it and/or modify
     11 ;; it under the terms of the GNU General Public License as published by
     12 ;; the Free Software Foundation, either version 3 of the License, or
     13 ;; (at your option) any later version.
     14 
     15 ;; GNU Emacs is distributed in the hope that it will be useful,
     16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     18 ;; GNU General Public License for more details.
     19 
     20 ;; You should have received a copy of the GNU General Public License
     21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     22 
     23 ;;; Commentary:
     24 
     25 ;; Tests for eglot.el
     26 
     27 ;;; Code:
     28 (require 'eglot)
     29 (require 'cl-lib)
     30 (require 'ert)
     31 (require 'ert-x) ; ert-simulate-command
     32 (require 'edebug)
     33 (require 'python) ; python-mode-hook
     34 (require 'company nil t)
     35 (require 'subr-x)
     36 
     37 ;;; Helpers
     38 
     39 (defun eglot--have-eclipse-jdt-ls-p ()
     40   (and (getenv "CLASSPATH")
     41        (cl-some
     42         (lambda (x)
     43           (string-match-p "org\\.eclipse\\.equinox\\.launcher_.*\\.jar$" x))
     44         (split-string (getenv "CLASSPATH") ":"))))
     45 
     46 (defmacro eglot--with-fixture (fixture &rest body)
     47   "Setup FIXTURE, call BODY, teardown FIXTURE.
     48 FIXTURE is a list.  Its elements are of the form (FILE . CONTENT)
     49 to create a readable FILE with CONTENT.  FILE may be a directory
     50 name and CONTENT another (FILE . CONTENT) list to specify a
     51 directory hierarchy.  FIXTURE's elements can also be (SYMBOL
     52 VALUE) meaning SYMBOL should be bound to VALUE during BODY and
     53 then restored."
     54   (declare (indent 1) (debug t))
     55   `(eglot--call-with-fixture
     56     ,fixture #'(lambda () ,@body)))
     57 
     58 (defun eglot--make-file-or-dir (ass)
     59   (let ((file-or-dir-name (car ass))
     60         (content (cdr ass)))
     61     (cond ((listp content)
     62            (make-directory file-or-dir-name 'parents)
     63            (let ((default-directory (concat default-directory "/" file-or-dir-name)))
     64              (mapcan #'eglot--make-file-or-dir content)))
     65           ((stringp content)
     66            (with-temp-buffer
     67              (insert content)
     68              (write-region nil nil file-or-dir-name nil 'nomessage))
     69            (list (expand-file-name file-or-dir-name)))
     70           (t
     71            (eglot--error "Expected a string or a directory spec")))))
     72 
     73 (defun eglot--call-with-fixture (fixture fn)
     74   "Helper for `eglot--with-fixture'.  Run FN under FIXTURE."
     75   (let* ((fixture-directory (make-temp-file "eglot--fixture" t))
     76          (default-directory fixture-directory)
     77          file-specs created-files
     78          syms-to-restore
     79          new-servers
     80          test-body-successful-p)
     81     (dolist (spec fixture)
     82       (cond ((symbolp spec)
     83              (push (cons spec (symbol-value spec)) syms-to-restore)
     84              (set spec nil))
     85             ((symbolp (car spec))
     86              (push (cons (car spec) (symbol-value (car spec))) syms-to-restore)
     87              (set (car spec) (cadr spec)))
     88             ((stringp (car spec)) (push spec file-specs))))
     89     (unwind-protect
     90         (let ((process-environment
     91                ;; Prevent user-configuration to have an influence on
     92                ;; language servers. (See github#441)
     93                (cons "XDG_CONFIG_HOME=/dev/null" process-environment))
     94               ;; Prevent "Can't guess python-indent-offset ..." messages.
     95               (python-indent-guess-indent-offset-verbose . nil)
     96               (eglot-server-initialized-hook
     97                (lambda (server) (push server new-servers))))
     98           (setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
     99           (prog1 (funcall fn)
    100             (setq test-body-successful-p t)))
    101       (eglot--message
    102        "Test body was %s" (if test-body-successful-p "OK" "A FAILURE"))
    103       (unwind-protect
    104           (let ((eglot-autoreconnect nil))
    105             (dolist (server new-servers)
    106               (when (jsonrpc-running-p server)
    107                 (condition-case oops
    108                     (eglot-shutdown
    109                      server nil 3 (not test-body-successful-p))
    110                   (error
    111                    (eglot--message "Non-critical shutdown error after test: %S"
    112                                    oops))))
    113               (when (not test-body-successful-p)
    114                 ;; We want to do this after the sockets have
    115                 ;; shut down such that any pending data has been
    116                 ;; consumed and is available in the process
    117                 ;; buffers.
    118                 (let ((buffers (delq nil (list
    119                                           ;; FIXME: Accessing "internal" symbol here.
    120                                           (process-buffer (jsonrpc--process server))
    121                                           (jsonrpc-stderr-buffer server)
    122                                           (jsonrpc-events-buffer server)))))
    123                   (cond (noninteractive
    124                          (dolist (buffer buffers)
    125                            (eglot--message "%s:" (buffer-name buffer))
    126                            (princ (with-current-buffer buffer (buffer-string))
    127                                   'external-debugging-output)))
    128                         (t
    129                          (eglot--message "Preserved for inspection: %s"
    130                                          (mapconcat #'buffer-name buffers ", "))))))))
    131         (eglot--cleanup-after-test fixture-directory created-files syms-to-restore)))))
    132 
    133 (defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore)
    134   (let ((buffers-to-delete
    135          (delete nil (mapcar #'find-buffer-visiting created-files))))
    136     (eglot--message "Killing %s, wiping %s, restoring %s"
    137                     buffers-to-delete
    138                     fixture-directory
    139                     (mapcar #'car syms-to-restore))
    140     (cl-loop for (sym . val) in syms-to-restore
    141              do (set sym val))
    142     (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted
    143       (with-current-buffer buf (save-buffer) (kill-buffer)))
    144     (delete-directory fixture-directory 'recursive)))
    145 
    146 (cl-defmacro eglot--with-timeout (timeout &body body)
    147   (declare (indent 1) (debug t))
    148   `(eglot--call-with-timeout ,timeout (lambda () ,@body)))
    149 
    150 (defun eglot--call-with-timeout (timeout fn)
    151   (let* ((tag (gensym "eglot-test-timeout"))
    152          (timed-out (make-symbol "timeout"))
    153          (timeout-and-message
    154           (if (listp timeout) timeout
    155             (list timeout "waiting for test to finish")))
    156          (timeout (car timeout-and-message))
    157          (message (cadr timeout-and-message))
    158          (timer)
    159          (retval))
    160     (unwind-protect
    161         (setq retval
    162               (catch tag
    163                 (setq timer
    164                       (run-with-timer timeout nil
    165                                       (lambda ()
    166                                         (unless edebug-active
    167                                           (throw tag timed-out)))))
    168                 (funcall fn)))
    169       (cancel-timer timer)
    170       (when (eq retval timed-out)
    171         (error "%s" (concat "Timed out " message))))))
    172 
    173 (defun eglot--find-file-noselect (file &optional noerror)
    174   (unless (or noerror
    175               (file-readable-p file)) (error "%s does not exist" file))
    176   (find-file-noselect file))
    177 
    178 (cl-defmacro eglot--sniffing ((&key server-requests
    179                                     server-notifications
    180                                     server-replies
    181                                     client-requests
    182                                     client-notifications
    183                                     client-replies)
    184                               &rest body)
    185   "Run BODY saving LSP JSON messages in variables, most recent first."
    186   (declare (indent 1) (debug (sexp &rest form)))
    187   (let ((log-event-ad-sym (make-symbol "eglot--event-sniff")))
    188     `(unwind-protect
    189          (let ,(delq nil (list server-requests
    190                                server-notifications
    191                                server-replies
    192                                client-requests
    193                                client-notifications
    194                                client-replies))
    195            (advice-add
    196             #'jsonrpc--log-event :before
    197             (lambda (_proc message &optional type)
    198               (cl-destructuring-bind (&key method id _error &allow-other-keys)
    199                   message
    200                 (let ((req-p (and method id))
    201                       (notif-p method)
    202                       (reply-p id))
    203                   (cond
    204                    ((eq type 'server)
    205                     (cond (req-p ,(when server-requests
    206                                     `(push message ,server-requests)))
    207                           (notif-p ,(when server-notifications
    208                                       `(push message ,server-notifications)))
    209                           (reply-p ,(when server-replies
    210                                       `(push message ,server-replies)))))
    211                    ((eq type 'client)
    212                     (cond (req-p ,(when client-requests
    213                                     `(push message ,client-requests)))
    214                           (notif-p ,(when client-notifications
    215                                       `(push message ,client-notifications)))
    216                           (reply-p ,(when client-replies
    217                                       `(push message ,client-replies)))))))))
    218             '((name . ,log-event-ad-sym)))
    219            ,@body)
    220        (advice-remove #'jsonrpc--log-event ',log-event-ad-sym))))
    221 
    222 (cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body)
    223   "Spin until FN match in EVENTS-SYM, flush events after it.
    224 Pass TIMEOUT to `eglot--with-timeout'."
    225   (declare (indent 2) (debug (sexp sexp sexp &rest form)))
    226   `(eglot--with-timeout '(,timeout ,(or message
    227                                         (format "waiting for:\n%s" (pp-to-string body))))
    228      (let ((event
    229             (cl-loop thereis (cl-loop for json in ,events-sym
    230                                       for method = (plist-get json :method)
    231                                       when (keywordp method)
    232                                       do (plist-put json :method
    233                                                     (substring
    234                                                      (symbol-name method)
    235                                                      1))
    236                                       when (funcall
    237                                             (jsonrpc-lambda ,args ,@body) json)
    238                                       return (cons json before)
    239                                       collect json into before)
    240                      for i from 0
    241                      when (zerop (mod i 5))
    242                      ;; do (eglot--message "still struggling to find in %s"
    243                      ;;                    ,events-sym)
    244                      do
    245                      ;; `read-event' is essential to have the file
    246                      ;; watchers come through.
    247                      (read-event "[eglot] Waiting a bit..." nil 0.1)
    248                      (accept-process-output nil 0.1))))
    249        (setq ,events-sym (cdr event))
    250        (eglot--message "Event detected:\n%s"
    251                        (pp-to-string (car event))))))
    252 
    253 ;; `rust-mode' is not a part of emacs. So define these two shims which
    254 ;; should be more than enough for testing
    255 (unless (functionp 'rust-mode)
    256   (define-derived-mode rust-mode prog-mode "Rust"))
    257 (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-mode))
    258 
    259 (defun eglot--tests-connect (&optional timeout)
    260   (let* ((timeout (or timeout 2))
    261          (eglot-sync-connect t)
    262          (eglot-connect-timeout timeout))
    263     (apply #'eglot--connect (eglot--guess-contact))))
    264 
    265 
    266 ;;; Unit tests
    267 
    268 (ert-deftest eclipse-connect ()
    269   "Connect to eclipse.jdt.ls server."
    270   (skip-unless (eglot--have-eclipse-jdt-ls-p))
    271   (eglot--with-fixture
    272       '(("project/src/main/java/foo" . (("Main.java" . "")))
    273         ("project/.git/" . nil))
    274     (with-current-buffer
    275         (eglot--find-file-noselect "project/src/main/java/foo/Main.java")
    276       (eglot--sniffing (:server-notifications s-notifs)
    277         (should (eglot--tests-connect 20))
    278         (eglot--wait-for (s-notifs 10)
    279             (&key _id method &allow-other-keys)
    280           (string= method "language/status"))))))
    281 
    282 (ert-deftest eclipse-workspace-folders ()
    283   "Check eclipse connection with multi-root projects."
    284   (skip-unless (eglot--have-eclipse-jdt-ls-p))
    285   (eglot--with-fixture
    286       '(("project/main/src/main/java/foo" . (("Main.java" . "")))
    287         ("project/sub1/" . (("pom.xml" . "")))
    288         ("project/sub2/" . (("build.gradle" . "")))
    289         ("project/sub3/" . (("a.txt" . "")))
    290         ("project/.git/" . nil))
    291     (let ((root (file-name-as-directory default-directory)))
    292       (with-current-buffer
    293           (eglot--find-file-noselect "project/main/src/main/java/foo/Main.java")
    294         (eglot--sniffing (:client-requests c-reqs)
    295           (should (eglot--tests-connect 10))
    296           (eglot--wait-for (c-reqs 10)
    297               (&key _id method params &allow-other-keys)
    298             (when (string= method "initialize")
    299               (let ((folders (plist-get
    300                               (plist-get params :initializationOptions)
    301                               :workspaceFolders))
    302                     (default-directory root))
    303                 (and
    304                  (cl-find (eglot--path-to-uri "project/") folders :test #'equal)
    305                  (cl-find (eglot--path-to-uri "project/sub1/") folders :test #'equal)
    306                  (cl-find (eglot--path-to-uri "project/sub2/") folders :test #'equal)
    307                  (= 3 (length folders)))))))))))
    308 
    309 (defun eglot-tests--auto-detect-running-server-1 ()
    310   (let (server)
    311     (eglot--with-fixture
    312      `(("project" . (("coiso.py" . "bla")
    313                      ("merdix.py" . "bla")))
    314        ("anotherproject" . (("cena.py" . "bla"))))
    315      (with-current-buffer
    316          (eglot--find-file-noselect "project/coiso.py")
    317        (should (setq server (eglot--tests-connect)))
    318        (should (eglot-current-server)))
    319      (with-current-buffer
    320          (eglot--find-file-noselect "project/merdix.py")
    321        (should (eglot-current-server))
    322        (should (eq (eglot-current-server) server)))
    323      (with-current-buffer
    324          (eglot--find-file-noselect "anotherproject/cena.py")
    325        (should-error (eglot--current-server-or-lose))))))
    326 
    327 (ert-deftest auto-detect-running-server ()
    328   "Visit a file and \\[eglot], then visit a neighbour."
    329   (skip-unless (executable-find "pyls"))
    330   (eglot-tests--auto-detect-running-server-1))
    331 
    332 (ert-deftest auto-shutdown ()
    333   "Visit a file and \\[eglot], then kill buffer."
    334   (skip-unless (executable-find "pyls"))
    335   (let (server
    336         buffer)
    337     (eglot--with-fixture
    338         `(("project" . (("coiso.py" . "def coiso: pass"))))
    339       (with-current-buffer
    340           (setq buffer (eglot--find-file-noselect "project/coiso.py"))
    341         (should (setq server (eglot--tests-connect)))
    342         (should (eglot-current-server))
    343         (let ((eglot-autoshutdown nil)) (kill-buffer buffer))
    344         (should (jsonrpc-running-p server))
    345         ;; re-find file...
    346         (setq buffer (eglot--find-file-noselect (buffer-file-name buffer)))
    347         ;; ;; but now kill it with `eglot-autoshutdown' set to t
    348         (let ((eglot-autoshutdown t)) (kill-buffer buffer))
    349         (should (not (jsonrpc-running-p server)))))))
    350 
    351 (ert-deftest auto-reconnect ()
    352   "Start a server.  Kill it.  Watch it reconnect."
    353   (skip-unless (executable-find "pyls"))
    354   (let (server (eglot-autoreconnect 1))
    355     (eglot--with-fixture
    356         `(("project" . (("coiso.py" . "bla")
    357                         ("merdix.py" . "bla"))))
    358       (with-current-buffer
    359           (eglot--find-file-noselect "project/coiso.py")
    360         (should (setq server (eglot--tests-connect)))
    361         ;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We
    362         ;; should have a automatic reconnection.
    363         (run-with-timer 1.2 nil (lambda () (delete-process
    364                                             (jsonrpc--process server))))
    365         (while (jsonrpc-running-p server) (accept-process-output nil 0.5))
    366         (should (eglot-current-server))
    367         ;; Now try again too quickly
    368         (setq server (eglot-current-server))
    369         (let ((proc (jsonrpc--process server)))
    370           (run-with-timer 0.5 nil (lambda () (delete-process proc)))
    371           (while (process-live-p proc) (accept-process-output nil 0.5)))
    372         (should (not (eglot-current-server)))))))
    373 
    374 (ert-deftest rls-watches-files ()
    375   "Start RLS server.  Notify it when a critical file changes."
    376   (skip-unless (executable-find "rls"))
    377   (skip-unless (executable-find "cargo"))
    378   (skip-unless (null (getenv "TRAVIS_TESTING")))
    379   (let ((eglot-autoreconnect 1))
    380     (eglot--with-fixture
    381         '(("watch-project" . (("coiso.rs" . "bla")
    382                               ("merdix.rs" . "bla"))))
    383       (with-current-buffer
    384           (eglot--find-file-noselect "watch-project/coiso.rs")
    385         (should (zerop (shell-command "cargo init")))
    386         (eglot--sniffing (
    387                           :server-requests s-requests
    388                           :client-notifications c-notifs
    389                           :client-replies c-replies
    390                           )
    391           (should (eglot--tests-connect))
    392           (let (register-id)
    393             (eglot--wait-for (s-requests 1)
    394                 (&key id method &allow-other-keys)
    395               (setq register-id id)
    396               (string= method "client/registerCapability"))
    397             (eglot--wait-for (c-replies 1)
    398                 (&key id error &allow-other-keys)
    399               (and (eq id register-id) (null error))))
    400           (delete-file "Cargo.toml")
    401           (eglot--wait-for
    402               (c-notifs 3 "waiting for didChangeWatchedFiles notification")
    403               (&key method params &allow-other-keys)
    404             (and (string= method "workspace/didChangeWatchedFiles")
    405                  (cl-destructuring-bind (&key uri type)
    406                      (elt (plist-get params :changes) 0)
    407                    (and (string= (eglot--path-to-uri "Cargo.toml") uri)
    408                         (= type 3))))))))))
    409 
    410 (ert-deftest basic-diagnostics ()
    411   "Test basic diagnostics."
    412   (skip-unless (executable-find "pyls"))
    413   (eglot--with-fixture
    414       `(("diag-project" .
    415                                         ; colon missing after True
    416          (("main.py" . "def foo(): if True pass"))))
    417     (with-current-buffer
    418         (eglot--find-file-noselect "diag-project/main.py")
    419       (eglot--sniffing (:server-notifications s-notifs)
    420         (eglot--tests-connect)
    421         (eglot--wait-for (s-notifs 2)
    422             (&key _id method &allow-other-keys)
    423           (string= method "textDocument/publishDiagnostics"))
    424         (flymake-start)
    425         (goto-char (point-min))
    426         (flymake-goto-next-error 1 '() t)
    427         (should (eq 'flymake-error (face-at-point)))))))
    428 
    429 (defun eglot--eldoc-on-demand ()
    430   ;; Trick Eldoc 1.1.0 into accepting on-demand calls.
    431   (eldoc t))
    432 
    433 (defun eglot--tests-force-full-eldoc ()
    434   ;; FIXME: This uses some Eldoc implementation defatils.
    435   (when (buffer-live-p eldoc--doc-buffer)
    436     (with-current-buffer eldoc--doc-buffer
    437       (let ((inhibit-read-only t))
    438         (erase-buffer))))
    439   (eglot--eldoc-on-demand)
    440   (cl-loop
    441    repeat 10
    442    for retval = (and (buffer-live-p eldoc--doc-buffer)
    443                      (with-current-buffer eldoc--doc-buffer
    444                        (let ((bs (buffer-string)))
    445                          (unless (zerop (length bs)) bs))))
    446    when retval return retval
    447    do (sit-for 0.1)
    448    finally (error "eglot--tests-force-full-eldoc didn't deliver")))
    449 
    450 (ert-deftest rls-hover-after-edit ()
    451   "Hover and highlightChanges are tricky in RLS."
    452   (skip-unless (executable-find "rls"))
    453   (skip-unless (executable-find "cargo"))
    454   (skip-unless (null (getenv "TRAVIS_TESTING")))
    455   (eglot--with-fixture
    456       '(("hover-project" .
    457          (("main.rs" .
    458            "fn test() -> i32 { let test=3; return te; }"))))
    459     (with-current-buffer
    460         (eglot--find-file-noselect "hover-project/main.rs")
    461       (should (zerop (shell-command "cargo init")))
    462       (eglot--sniffing (
    463                         :server-replies s-replies
    464                         :client-requests c-reqs
    465                         )
    466         (eglot--tests-connect)
    467         (goto-char (point-min))
    468         (search-forward "return te")
    469         (insert "st")
    470         (progn
    471           ;; simulate these two which don't happen when buffer isn't
    472           ;; visible in a window.
    473           (eglot--signal-textDocument/didChange)
    474           (eglot--eldoc-on-demand))
    475         (let (pending-id)
    476           (eglot--wait-for (c-reqs 2)
    477               (&key id method &allow-other-keys)
    478             (setq pending-id id)
    479             (string= method "textDocument/documentHighlight"))
    480           (eglot--wait-for (s-replies 2)
    481               (&key id &allow-other-keys)
    482             (eq id pending-id)))))))
    483 
    484 (ert-deftest rename-a-symbol ()
    485   "Test basic symbol renaming."
    486   (skip-unless (executable-find "pyls"))
    487   (eglot--with-fixture
    488       `(("rename-project"
    489          . (("main.py" .
    490              "def foo (bar) : 1 + bar\n\ndef bar() : pass"))))
    491     (with-current-buffer
    492         (eglot--find-file-noselect "rename-project/main.py")
    493       (eglot--tests-connect)
    494       (goto-char (point-min)) (search-forward "bar")
    495       (eglot-rename "bla")
    496       (should (equal (buffer-string)
    497                      "def foo (bla) : 1 + bla\n\ndef bar() : pass")))))
    498 
    499 (ert-deftest basic-completions ()
    500   "Test basic autocompletion in a python LSP."
    501   (skip-unless (executable-find "pyls"))
    502   (eglot--with-fixture
    503       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    504     (with-current-buffer
    505         (eglot--find-file-noselect "project/something.py")
    506       (should (eglot--tests-connect))
    507       (goto-char (point-max))
    508       (completion-at-point)
    509       (should (looking-back "sys.exit")))))
    510 
    511 (ert-deftest non-unique-completions ()
    512   "Test completion resulting in 'Complete, but not unique'."
    513   (skip-unless (executable-find "pyls"))
    514   (eglot--with-fixture
    515       '(("project" . (("something.py" . "foo=1\nfoobar=2\nfoo"))))
    516     (with-current-buffer
    517         (eglot--find-file-noselect "project/something.py")
    518       (should (eglot--tests-connect))
    519       (goto-char (point-max))
    520       (completion-at-point))
    521     ;; FIXME: `current-message' doesn't work here :-(
    522     (with-current-buffer (messages-buffer)
    523       (save-excursion
    524         (goto-char (point-max))
    525         (forward-line -1)
    526         (should (looking-at "Complete, but not unique"))))))
    527 
    528 (ert-deftest basic-xref ()
    529   "Test basic xref functionality in a python LSP."
    530   (skip-unless (executable-find "pyls"))
    531   (eglot--with-fixture
    532       `(("project" . (("something.py" . "def foo(): pass\ndef bar(): foo()"))))
    533     (with-current-buffer
    534         (eglot--find-file-noselect "project/something.py")
    535       (should (eglot--tests-connect))
    536       (search-forward "bar(): f")
    537       (call-interactively 'xref-find-definitions)
    538       (should (looking-at "foo(): pass")))))
    539 
    540 (defvar eglot--test-python-buffer
    541   "\
    542 def foobarquux(a, b, c=True): pass
    543 def foobazquuz(d, e, f): pass
    544 ")
    545 
    546 (ert-deftest snippet-completions ()
    547   "Test simple snippet completion in a python LSP."
    548   (skip-unless (and (executable-find "pyls")
    549                     (functionp 'yas-minor-mode)))
    550   (eglot--with-fixture
    551       `(("project" . (("something.py" . ,eglot--test-python-buffer))))
    552     (with-current-buffer
    553         (eglot--find-file-noselect "project/something.py")
    554       (yas-minor-mode 1)
    555       (let ((eglot-workspace-configuration
    556              `((:pyls . (:plugins (:jedi_completion (:include_params t)))))))
    557         (should (eglot--tests-connect)))
    558       (goto-char (point-max))
    559       (insert "foobar")
    560       (completion-at-point)
    561       (should (looking-back "foobarquux("))
    562       (should (looking-at "a, b)")))))
    563 
    564 (defvar company-candidates)
    565 
    566 (ert-deftest snippet-completions-with-company ()
    567   "Test simple snippet completion in a python LSP."
    568   (skip-unless (and (executable-find "pyls")
    569                     (functionp 'yas-minor-mode)
    570                     (functionp 'company-complete)))
    571   (eglot--with-fixture
    572       `(("project" . (("something.py" . ,eglot--test-python-buffer))))
    573     (with-current-buffer
    574         (eglot--find-file-noselect "project/something.py")
    575       (yas-minor-mode 1)
    576       (let ((eglot-workspace-configuration
    577              `((:pyls . (:plugins (:jedi_completion (:include_params t)))))))
    578         (should (eglot--tests-connect)))
    579       (goto-char (point-max))
    580       (insert "foo")
    581       (company-mode)
    582       (company-complete)
    583       (should (looking-back "fooba"))
    584       (should (= 2 (length company-candidates)))
    585       ;; this last one is brittle, since there it is possible that
    586       ;; pyls will change the representation of this candidate
    587       (should (member "foobazquuz(d, e, f)" company-candidates)))))
    588 
    589 (ert-deftest eglot-eldoc-after-completions ()
    590   "Test documentation echo in a python LSP."
    591   (skip-unless (executable-find "pyls"))
    592   (eglot--with-fixture
    593       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    594     (with-current-buffer
    595         (eglot--find-file-noselect "project/something.py")
    596       (should (eglot--tests-connect))
    597       (goto-char (point-max))
    598       (completion-at-point)
    599       (should (looking-back "sys.exit"))
    600       (should (string-match "^exit" (eglot--tests-force-full-eldoc))))))
    601 
    602 (ert-deftest eglot-multiline-eldoc ()
    603   "Test if suitable amount of lines of hover info are shown."
    604   :expected-result (if (getenv "TRAVIS_TESTING") :failed :passed)
    605   (skip-unless (executable-find "pyls"))
    606   (eglot--with-fixture
    607       `(("project" . (("hover-first.py" . "from datetime import datetime"))))
    608     (with-current-buffer
    609         (eglot--find-file-noselect "project/hover-first.py")
    610       (should (eglot--tests-connect))
    611       (goto-char (point-max))
    612       ;; one-line
    613       (let* ((eldoc-echo-area-use-multiline-p t)
    614              (captured-message (eglot--tests-force-full-eldoc)))
    615         (should (string-match "datetim" captured-message))
    616         (should (cl-find ?\n captured-message))))))
    617 
    618 (ert-deftest eglot-single-line-eldoc ()
    619   "Test if suitable amount of lines of hover info are shown."
    620   (skip-unless (executable-find "pyls"))
    621   (eglot--with-fixture
    622       `(("project" . (("hover-first.py" . "from datetime import datetime"))))
    623     (with-current-buffer
    624         (eglot--find-file-noselect "project/hover-first.py")
    625       (should (eglot--tests-connect))
    626       (goto-char (point-max))
    627       ;; one-line
    628       (let* ((eldoc-echo-area-use-multiline-p nil)
    629              (captured-message (eglot--tests-force-full-eldoc)))
    630         (should (string-match "datetim" captured-message))
    631         (should (not (cl-find ?\n eldoc-last-message)))))))
    632 
    633 (ert-deftest python-autopep-formatting ()
    634   "Test formatting in the pyls python LSP.
    635 pyls prefers autopep over yafp, despite its README stating the contrary."
    636   ;; Beware, default autopep rules can change over time, which may
    637   ;; affect this test.
    638   (skip-unless (and (executable-find "pyls")
    639                     (executable-find "autopep8")))
    640   (eglot--with-fixture
    641       `(("project" . (("something.py" . "def a():pass\n\ndef b():pass"))))
    642     (with-current-buffer
    643         (eglot--find-file-noselect "project/something.py")
    644       (should (eglot--tests-connect))
    645       ;; Try to format just the second line
    646       (search-forward "b():pa")
    647       (eglot-format (point-at-bol) (point-at-eol))
    648       (should (looking-at "ss"))
    649       (should
    650        (string= (buffer-string) "def a():pass\n\n\ndef b(): pass\n"))
    651       ;; now format the whole buffer
    652       (eglot-format-buffer)
    653       (should
    654        (string= (buffer-string) "def a(): pass\n\n\ndef b(): pass\n")))))
    655 
    656 (ert-deftest python-yapf-formatting ()
    657   "Test formatting in the pyls python LSP."
    658   (skip-unless (and (executable-find "pyls")
    659                     (not (executable-find "autopep8"))
    660                     (executable-find "yapf")))
    661   (eglot--with-fixture
    662       `(("project" . (("something.py" . "def a():pass\ndef b():pass"))))
    663     (with-current-buffer
    664         (eglot--find-file-noselect "project/something.py")
    665       (should (eglot--tests-connect))
    666       ;; Try to format just the second line
    667       (search-forward "b():pa")
    668       (eglot-format (point-at-bol) (point-at-eol))
    669       (should (looking-at "ss"))
    670       (should
    671        (string= (buffer-string) "def a():pass\n\n\ndef b():\n    pass\n"))
    672       ;; now format the whole buffer
    673       (eglot-format-buffer)
    674       (should
    675        (string= (buffer-string) "def a():\n    pass\n\n\ndef b():\n    pass\n")))))
    676 
    677 (ert-deftest javascript-basic ()
    678   "Test basic autocompletion in a JavaScript LSP."
    679   (skip-unless (executable-find "typescript-language-server"))
    680   (eglot--with-fixture
    681       '(("project" . (("hello.js" . "console.log('Hello world!');"))))
    682     (with-current-buffer
    683         (eglot--find-file-noselect "project/hello.js")
    684       (let ((eglot-server-programs
    685              '((js-mode . ("typescript-language-server" "--stdio")))))
    686         (goto-char (point-max))
    687         (eglot--sniffing (:server-notifications
    688                           s-notifs
    689                           :client-notifications
    690                           c-notifs)
    691           (should (eglot--tests-connect))
    692           (eglot--wait-for (s-notifs 2) (&key method &allow-other-keys)
    693             (string= method "textDocument/publishDiagnostics"))
    694           (should (not (eq 'flymake-error (face-at-point))))
    695           (insert "{")
    696           (eglot--signal-textDocument/didChange)
    697           (eglot--wait-for (c-notifs 1) (&key method &allow-other-keys)
    698             (string= method "textDocument/didChange"))
    699           (eglot--wait-for (s-notifs 2) (&key params method &allow-other-keys)
    700             (and (string= method "textDocument/publishDiagnostics")
    701                  (cl-destructuring-bind (&key _uri diagnostics) params
    702                    (cl-find-if (jsonrpc-lambda (&key severity &allow-other-keys)
    703                                  (= severity 1))
    704                                diagnostics)))))))))
    705 
    706 (ert-deftest json-basic ()
    707   "Test basic autocompletion in vscode-json-languageserver."
    708   (skip-unless (executable-find "vscode-json-languageserver"))
    709   (eglot--with-fixture
    710       '(("project" .
    711          (("p.json" . "{\"foo.b")
    712           ("s.json" . "{\"properties\":{\"foo.bar\":{\"default\":\"fb\"}}}")
    713           (".git" . nil))))
    714     (with-current-buffer
    715         (eglot--find-file-noselect "project/p.json")
    716       (yas-minor-mode)
    717       (goto-char 2)
    718       (insert "\"$schema\": \"file://"
    719               (file-name-directory buffer-file-name) "s.json\",")
    720       (let ((eglot-server-programs
    721              '((js-mode . ("vscode-json-languageserver" "--stdio")))))
    722         (goto-char (point-max))
    723         (should (eglot--tests-connect))
    724         (completion-at-point)
    725         (should (looking-back "\"foo.bar\": \""))
    726         (should (looking-at "fb\"$"))))))
    727 
    728 (defun eglot-tests--lsp-abiding-column-1 ()
    729   (eglot--with-fixture
    730       '(("project" .
    731          (("foo.c" . "const char write_data[] = u8\"๐Ÿš‚๐Ÿšƒ๐Ÿš„๐Ÿš…๐Ÿš†๐Ÿšˆ๐Ÿš‡๐Ÿšˆ๐Ÿš‰๐ŸšŠ๐Ÿš‹๐ŸšŒ๐ŸšŽ๐Ÿš๐Ÿšž๐ŸšŸ๐Ÿš ๐Ÿšก๐Ÿ›ค๐Ÿ›ฒ\";"))))
    732     (let ((eglot-server-programs
    733            '((c-mode . ("clangd")))))
    734       (with-current-buffer
    735           (eglot--find-file-noselect "project/foo.c")
    736         (setq-local eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column)
    737         (setq-local eglot-current-column-function #'eglot-lsp-abiding-column)
    738         (eglot--sniffing (:client-notifications c-notifs)
    739           (eglot--tests-connect)
    740           (end-of-line)
    741           (insert "p ")
    742           (eglot--signal-textDocument/didChange)
    743           (eglot--wait-for (c-notifs 2) (&key params &allow-other-keys)
    744             (should (equal 71 (cadddr (cadadr (aref (cadddr params) 0))))))
    745           (beginning-of-line)
    746           (should (eq eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column))
    747           (funcall eglot-move-to-column-function 71)
    748           (should (looking-at "p")))))))
    749 
    750 (ert-deftest eglot-lsp-abiding-column ()
    751   "Test basic `eglot-lsp-abiding-column' and `eglot-move-to-lsp-abiding-column'."
    752   (skip-unless (executable-find "clangd"))
    753   (eglot-tests--lsp-abiding-column-1))
    754 
    755 (ert-deftest eglot-ensure ()
    756   "Test basic `eglot-ensure' functionality."
    757   (skip-unless (executable-find "pyls"))
    758   (eglot--with-fixture
    759       `(("project" . (("foo.py" . "import sys\nsys.exi")
    760                       ("bar.py" . "import sys\nsys.exi")))
    761         (python-mode-hook
    762          (eglot-ensure
    763           (lambda ()
    764             (remove-hook 'flymake-diagnostic-functions 'python-flymake)))))
    765     (let (server)
    766       ;; need `ert-simulate-command' because `eglot-ensure'
    767       ;; relies on `post-command-hook'.
    768       (with-current-buffer
    769           (ert-simulate-command
    770            '(find-file "project/foo.py"))
    771         ;; FIXME: This test fails without this sleep on my machine.
    772         ;; Figure out why and solve this more cleanly.
    773         (sleep-for 0.1)
    774         (should (setq server (eglot-current-server))))
    775       (with-current-buffer
    776           (ert-simulate-command
    777            '(find-file "project/bar.py"))
    778         (should (eq server (eglot-current-server)))))))
    779 
    780 (ert-deftest slow-sync-connection-wait ()
    781   "Connect with `eglot-sync-connect' set to t."
    782   (skip-unless (executable-find "pyls"))
    783   (eglot--with-fixture
    784       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    785     (with-current-buffer
    786         (eglot--find-file-noselect "project/something.py")
    787       (let ((eglot-sync-connect t)
    788             (eglot-server-programs
    789              `((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
    790         (should (eglot--tests-connect 3))))))
    791 
    792 (ert-deftest slow-sync-connection-intime ()
    793   "Connect synchronously with `eglot-sync-connect' set to 2."
    794   (skip-unless (executable-find "pyls"))
    795   (eglot--with-fixture
    796       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    797     (with-current-buffer
    798         (eglot--find-file-noselect "project/something.py")
    799       (let ((eglot-sync-connect 2)
    800             (eglot-server-programs
    801              `((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
    802         (should (eglot--tests-connect 3))))))
    803 
    804 (ert-deftest slow-async-connection ()
    805   "Connect asynchronously with `eglot-sync-connect' set to 2."
    806   (skip-unless (executable-find "pyls"))
    807   (eglot--with-fixture
    808       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    809     (with-current-buffer
    810         (eglot--find-file-noselect "project/something.py")
    811       (let ((eglot-sync-connect 1)
    812             (eglot-server-programs
    813              `((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
    814         (should-not (apply #'eglot--connect (eglot--guess-contact)))
    815         (eglot--with-timeout 3
    816           (while (not (eglot-current-server))
    817             (accept-process-output nil 0.2))
    818           (should (eglot-current-server)))))))
    819 
    820 (ert-deftest slow-sync-timeout ()
    821   "Failed attempt at connection synchronously."
    822   (skip-unless (executable-find "pyls"))
    823   (eglot--with-fixture
    824       `(("project" . (("something.py" . "import sys\nsys.exi"))))
    825     (with-current-buffer
    826         (eglot--find-file-noselect "project/something.py")
    827       (let ((eglot-sync-connect t)
    828             (eglot-connect-timeout 1)
    829             (eglot-server-programs
    830              `((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
    831         (should-error (apply #'eglot--connect (eglot--guess-contact)))))))
    832 
    833 (ert-deftest eglot-capabilities ()
    834   "Unit test for `eglot--server-capable'."
    835   (cl-letf (((symbol-function 'eglot--capabilities)
    836              (lambda (_dummy)
    837                ;; test data lifted from Golangserver example at
    838                ;; https://github.com/joaotavora/eglot/pull/74
    839                (list :textDocumentSync 2 :hoverProvider t
    840                      :completionProvider '(:triggerCharacters ["."])
    841                      :signatureHelpProvider '(:triggerCharacters ["(" ","])
    842                      :definitionProvider t :typeDefinitionProvider t
    843                      :referencesProvider t :documentSymbolProvider t
    844                      :workspaceSymbolProvider t :implementationProvider t
    845                      :documentFormattingProvider t :xworkspaceReferencesProvider t
    846                      :xdefinitionProvider t :xworkspaceSymbolByProperties t)))
    847             ((symbol-function 'eglot--current-server-or-lose)
    848              (lambda () nil)))
    849     (should (eql 2 (eglot--server-capable :textDocumentSync)))
    850     (should (eglot--server-capable :completionProvider :triggerCharacters))
    851     (should (equal '(:triggerCharacters ["."]) (eglot--server-capable :completionProvider)))
    852     (should-not (eglot--server-capable :foobarbaz))
    853     (should-not (eglot--server-capable :textDocumentSync :foobarbaz))))
    854 
    855 
    856 (ert-deftest eglot-strict-interfaces ()
    857   (let ((eglot--lsp-interface-alist
    858          `((FooObject . ((:foo :bar) (:baz))))))
    859     (should
    860      (equal '("foo" . "bar")
    861             (let ((eglot-strict-mode nil))
    862               (eglot--dbind (foo bar) `(:foo "foo" :bar "bar")
    863                 (cons foo bar)))))
    864     (should-error
    865      (let ((eglot-strict-mode '(disallow-non-standard-keys)))
    866        (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
    867          (cons foo bar))))
    868     (should
    869      (equal '("foo" . "bar")
    870             (let ((eglot-strict-mode nil))
    871               (eglot--dbind (foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
    872                 (cons foo bar)))))
    873     (should-error
    874      (let ((eglot-strict-mode '(disallow-non-standard-keys)))
    875        (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :fotrix bargh)
    876          (cons foo bar))))
    877     (should
    878      (equal '("foo" . "bar")
    879             (let ((eglot-strict-mode '(disallow-non-standard-keys)))
    880               (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh)
    881                 (cons foo bar)))))
    882     (should
    883      (equal '("foo" . nil)
    884             (let ((eglot-strict-mode nil))
    885               (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
    886                 (cons foo bar)))))
    887     (should
    888      (equal '("foo" . "bar")
    889             (let ((eglot-strict-mode '(enforce-required-keys)))
    890               (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :bar "bar" :baz bargh)
    891                 (cons foo bar)))))
    892     (should-error
    893      (let ((eglot-strict-mode '(enforce-required-keys)))
    894        (eglot--dbind ((FooObject) foo bar) `(:foo "foo" :baz bargh)
    895          (cons foo bar))))))
    896 
    897 (ert-deftest eglot-dcase ()
    898   (let ((eglot--lsp-interface-alist
    899          `((FooObject . ((:foo :bar) (:baz)))
    900            (CodeAction (:title) (:kind :diagnostics :edit :command))
    901            (Command ((:title . string) (:command . string)) (:arguments)))))
    902     (should
    903      (equal
    904       "foo"
    905       (eglot--dcase `(:foo "foo" :bar "bar")
    906         (((FooObject) foo)
    907          foo))))
    908     (should
    909      (equal
    910       (list "foo" '(:title "hey" :command "ho") "some edit")
    911       (eglot--dcase '(:title "foo"
    912                              :command (:title "hey" :command "ho")
    913                              :edit "some edit")
    914         (((Command) _title _command _arguments)
    915          (ert-fail "Shouldn't have destructured this object as a Command"))
    916         (((CodeAction) title edit command)
    917          (list title command edit)))))
    918     (should
    919      (equal
    920       (list "foo" "some command" nil)
    921       (eglot--dcase '(:title "foo" :command "some command")
    922         (((Command) title command arguments)
    923          (list title command arguments))
    924         (((CodeAction) _title _edit _command)
    925          (ert-fail "Shouldn't have destructured this object as a CodeAction")))))))
    926 
    927 (ert-deftest eglot-dcase-issue-452 ()
    928   (let ((eglot--lsp-interface-alist
    929          `((FooObject . ((:foo :bar) (:baz)))
    930            (CodeAction (:title) (:kind :diagnostics :edit :command))
    931            (Command ((string . :title) (:command . string)) (:arguments)))))
    932     (should
    933      (equal
    934       (list "foo" '(:command "cmd" :title "alsofoo"))
    935       (eglot--dcase '(:title "foo" :command (:command "cmd" :title "alsofoo"))
    936         (((Command) _title _command _arguments)
    937          (ert-fail "Shouldn't have destructured this object as a Command"))
    938         (((CodeAction) title command)
    939          (list title command)))))))
    940 
    941 (cl-defmacro eglot--guessing-contact ((interactive-sym
    942                                        prompt-args-sym
    943                                        guessed-class-sym guessed-contact-sym
    944                                        &optional guessed-lang-id-sym)
    945                                       &body body)
    946   "Evaluate BODY twice, binding results of `eglot--guess-contact'.
    947 
    948 INTERACTIVE-SYM is bound to the boolean passed to
    949 `eglot--guess-contact' each time.  If the user would have been
    950 prompted, PROMPT-ARGS-SYM is bound to the list of arguments that
    951 would have been passed to `read-shell-command', else nil.
    952 GUESSED-CLASS-SYM, GUESSED-CONTACT-SYM and GUESSED-LANG-ID-SYM
    953 are bound to the useful return values of
    954 `eglot--guess-contact'.  Unless the server program evaluates to
    955 \"a-missing-executable.exe\", this macro will assume it exists."
    956   (declare (indent 1) (debug t))
    957   (let ((i-sym (cl-gensym)))
    958     `(dolist (,i-sym '(nil t))
    959        (let ((,interactive-sym ,i-sym)
    960              (buffer-file-name "_")
    961              (,prompt-args-sym nil))
    962          (cl-letf (((symbol-function 'executable-find)
    963                     (lambda (name &optional _remote)
    964                       (unless (string-equal name "a-missing-executable.exe")
    965                         (format "/totally-mock-bin/%s" name))))
    966                    ((symbol-function 'read-shell-command)
    967                     (lambda (&rest args) (setq ,prompt-args-sym args) "")))
    968            (cl-destructuring-bind
    969                (_ _ ,guessed-class-sym ,guessed-contact-sym
    970                   ,(or guessed-lang-id-sym '_))
    971                (eglot--guess-contact ,i-sym)
    972              ,@body))))))
    973 
    974 (ert-deftest eglot-server-programs-simple-executable ()
    975   (let ((eglot-server-programs '((foo-mode "some-executable")))
    976         (major-mode 'foo-mode))
    977     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
    978       (should (not prompt-args))
    979       (should (equal guessed-class 'eglot-lsp-server))
    980       (should (equal guessed-contact '("some-executable"))))))
    981 
    982 (ert-deftest eglot-server-programs-simple-missing-executable ()
    983   (let ((eglot-server-programs '((foo-mode "a-missing-executable.exe")))
    984         (major-mode 'foo-mode))
    985     (eglot--guessing-contact (interactive-p prompt-args guessed-class guessed-contact)
    986       (should (equal (not prompt-args) (not interactive-p)))
    987       (should (equal guessed-class 'eglot-lsp-server))
    988       (should (equal guessed-contact '("a-missing-executable.exe"))))))
    989 
    990 (ert-deftest eglot-server-programs-executable-multiple-major-modes ()
    991   (let ((eglot-server-programs '(((bar-mode foo-mode) "some-executable")))
    992         (major-mode 'foo-mode))
    993     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
    994       (should (not prompt-args))
    995       (should (equal guessed-class 'eglot-lsp-server))
    996       (should (equal guessed-contact '("some-executable"))))))
    997 
    998 (ert-deftest eglot-server-programs-executable-with-arg ()
    999   (let ((eglot-server-programs '((foo-mode "some-executable" "arg1")))
   1000         (major-mode 'foo-mode))
   1001     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1002       (should (not prompt-args))
   1003       (should (equal guessed-class 'eglot-lsp-server))
   1004       (should (equal guessed-contact '("some-executable" "arg1"))))))
   1005 
   1006 (ert-deftest eglot-server-programs-executable-with-args-and-autoport ()
   1007   (let ((eglot-server-programs '((foo-mode "some-executable" "arg1"
   1008                                            :autoport "arg2")))
   1009         (major-mode 'foo-mode))
   1010     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1011       (should (not prompt-args))
   1012       (should (equal guessed-class 'eglot-lsp-server))
   1013       (should (equal guessed-contact '("some-executable" "arg1"
   1014                                        :autoport "arg2"))))))
   1015 
   1016 (ert-deftest eglot-server-programs-host-and-port ()
   1017   (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777)))
   1018         (major-mode 'foo-mode))
   1019     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1020       (should (not prompt-args))
   1021       (should (equal guessed-class 'eglot-lsp-server))
   1022       (should (equal guessed-contact '("somehost.example.com" 7777))))))
   1023 
   1024 (ert-deftest eglot-server-programs-host-and-port-and-tcp-args ()
   1025   (let ((eglot-server-programs '((foo-mode "somehost.example.com" 7777
   1026                                            :type network)))
   1027         (major-mode 'foo-mode))
   1028     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1029       (should (not prompt-args))
   1030       (should (equal guessed-class 'eglot-lsp-server))
   1031       (should (equal guessed-contact '("somehost.example.com" 7777
   1032                                        :type network))))))
   1033 
   1034 (ert-deftest eglot-server-programs-class-name-and-plist ()
   1035   (let ((eglot-server-programs '((foo-mode bar-class :init-key init-val)))
   1036         (major-mode 'foo-mode))
   1037     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1038       (should (not prompt-args))
   1039       (should (equal guessed-class 'bar-class))
   1040       (should (equal guessed-contact '(:init-key init-val))))))
   1041 
   1042 (ert-deftest eglot-server-programs-class-name-and-contact-spec ()
   1043   (let ((eglot-server-programs '((foo-mode bar-class "some-executable" "arg1"
   1044                                            :autoport "arg2")))
   1045         (major-mode 'foo-mode))
   1046     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1047       (should (not prompt-args))
   1048       (should (equal guessed-class 'bar-class))
   1049       (should (equal guessed-contact '("some-executable" "arg1"
   1050                                        :autoport "arg2"))))))
   1051 
   1052 (ert-deftest eglot-server-programs-function ()
   1053   (let ((eglot-server-programs '((foo-mode . (lambda (&optional _)
   1054                                                '("some-executable")))))
   1055         (major-mode 'foo-mode))
   1056     (eglot--guessing-contact (_ prompt-args guessed-class guessed-contact)
   1057       (should (not prompt-args))
   1058       (should (equal guessed-class 'eglot-lsp-server))
   1059       (should (equal guessed-contact '("some-executable"))))))
   1060 
   1061 (ert-deftest eglot-server-programs-guess-lang ()
   1062   (let ((major-mode 'foo-mode))
   1063     (let ((eglot-server-programs '((foo-mode . ("prog-executable")))))
   1064       (eglot--guessing-contact (_ _ _ _ guessed-lang)
   1065         (should (equal guessed-lang "foo"))))
   1066     (let ((eglot-server-programs '(((foo-mode :language-id "bar")
   1067                                     . ("prog-executable")))))
   1068       (eglot--guessing-contact (_ _ _ _ guessed-lang)
   1069         (should (equal guessed-lang "bar"))))
   1070     (let ((eglot-server-programs '(((baz-mode (foo-mode :language-id "bar"))
   1071                                     . ("prog-executable")))))
   1072       (eglot--guessing-contact (_ _ _ _ guessed-lang)
   1073         (should (equal guessed-lang "bar"))))))
   1074 
   1075 (defun eglot--glob-match (glob str)
   1076   (funcall (eglot--glob-compile glob t t) str))
   1077 
   1078 (ert-deftest eglot--glob-test ()
   1079   (should (eglot--glob-match "foo/**/baz" "foo/bar/baz"))
   1080   (should (eglot--glob-match "foo/**/baz" "foo/baz"))
   1081   (should-not (eglot--glob-match "foo/**/baz" "foo/bar"))
   1082   (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz"))
   1083   (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz"))
   1084   (should-not (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/ding/foo/quuz"))
   1085   (should (eglot--glob-match "*.js" "foo.js"))
   1086   (should-not (eglot--glob-match "*.js" "foo.jsx"))
   1087   (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js"))
   1088   (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx"))
   1089   (should (eglot--glob-match "*.{js,ts}" "foo.js"))
   1090   (should-not (eglot--glob-match "*.{js,ts}" "foo.xs"))
   1091   (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts"))
   1092   (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx"))
   1093   (should (eglot--glob-match "?oo.js" "foo.js"))
   1094   (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
   1095   (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
   1096   (should (eglot--glob-match "example.[!0-9]" "example.a"))
   1097   (should-not (eglot--glob-match "example.[!0-9]" "example.0"))
   1098   (should (eglot--glob-match "example.[0-9]" "example.0"))
   1099   (should-not (eglot--glob-match "example.[0-9]" "example.a"))
   1100   (should (eglot--glob-match "**/bar/" "foo/bar/"))
   1101   (should-not (eglot--glob-match "foo.hs" "fooxhs"))
   1102 
   1103   ;; Some more tests
   1104   (should (eglot--glob-match "**/.*" ".git"))
   1105   (should (eglot--glob-match ".?" ".o"))
   1106   (should (eglot--glob-match "**/.*" ".hidden.txt"))
   1107   (should (eglot--glob-match "**/.*" "path/.git"))
   1108   (should (eglot--glob-match "**/.*" "path/.hidden.txt"))
   1109   (should (eglot--glob-match "**/node_modules/**" "node_modules/"))
   1110   (should (eglot--glob-match "{foo,bar}/**" "foo/test"))
   1111   (should (eglot--glob-match "{foo,bar}/**" "bar/test"))
   1112   (should (eglot--glob-match "some/**/*" "some/foo.js"))
   1113   (should (eglot--glob-match "some/**/*" "some/folder/foo.js"))
   1114 
   1115   ;; VSCode supposedly supports this, not sure if good idea.
   1116   ;;
   1117   ;; (should (eglot--glob-match "**/node_modules/**" "node_modules"))
   1118   ;; (should (eglot--glob-match "{foo,bar}/**" "foo"))
   1119   ;; (should (eglot--glob-match "{foo,bar}/**" "bar"))
   1120 
   1121   ;; VSCode also supports nested blobs.  Do we care?
   1122   ;;
   1123   ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js"))
   1124   ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts"))
   1125   ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5"))
   1126   ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" "prefix/foo.8"))
   1127   )
   1128 
   1129 (ert-deftest eglot--tramp-test ()
   1130   "Ensure LSP servers can be used over TRAMP."
   1131   (skip-unless (and (>= emacs-major-version 27) (executable-find "pyls")))
   1132   ;; Set up a loopback TRAMP method thatโ€™s just a shell so the remote
   1133   ;; host is really just the local host.
   1134   (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
   1135         (tramp-methods '(("loopback"
   1136                           (tramp-login-program "/bin/sh")
   1137                           (tramp-remote-shell "/bin/sh")
   1138                           (tramp-remote-shell-login ("-l"))
   1139                           (tramp-remote-shell-args ("-c")))))
   1140         (temporary-file-directory (concat "/loopback::"
   1141                                           temporary-file-directory)))
   1142     ;; With โ€˜temporary-file-directoryโ€™ bound to the โ€˜loopbackโ€™ TRAMP
   1143     ;; method, fixtures will be automatically made โ€œremote".
   1144     (eglot-tests--auto-detect-running-server-1)))
   1145 
   1146 (ert-deftest eglot--tramp-test-2 ()
   1147   "Ensure LSP servers can be used over TRAMP."
   1148   (skip-unless (and (>= emacs-major-version 27) (executable-find "clangd")))
   1149   ;; Set up a loopback TRAMP method thatโ€™s just a shell so the remote
   1150   ;; host is really just the local host.
   1151   (let ((tramp-remote-path (cons 'tramp-own-remote-path tramp-remote-path))
   1152         (tramp-methods '(("loopback"
   1153                           (tramp-login-program "/bin/sh")
   1154                           (tramp-remote-shell "/bin/sh")
   1155                           (tramp-remote-shell-login ("-l"))
   1156                           (tramp-remote-shell-args ("-c")))))
   1157         (temporary-file-directory (concat "/loopback::"
   1158                                           temporary-file-directory))
   1159         (eglot-server-programs '((c-mode "clangd"))))
   1160     (eglot-tests--lsp-abiding-column-1) ))
   1161 
   1162 (ert-deftest eglot--path-to-uri-windows ()
   1163   (should (string-prefix-p "file:///"
   1164                            (eglot--path-to-uri "c:/Users/Foo/bar.lisp")))
   1165   (should (string-suffix-p "c%3A/Users/Foo/bar.lisp"
   1166                            (eglot--path-to-uri "c:/Users/Foo/bar.lisp"))))
   1167 
   1168 (provide 'eglot-tests)
   1169 ;;; eglot-tests.el ends here
   1170 
   1171 ;; Local Variables:
   1172 ;; checkdoc-force-docstrings-flag: nil
   1173 ;; End: