aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoão Távora2023-03-14 19:50:48 +0000
committerJoão Távora2023-03-14 22:57:09 +0000
commitcf7db4d9dd2e69cf7463a3d43ce7d92a6dce6f3c (patch)
treeb3db04858048e0b9ffe49e8b49c46fb317d21927
parentd3ab5f68773d70eb9e0a2396975583bf14453f40 (diff)
downloademacs-cf7db4d9dd2e69cf7463a3d43ce7d92a6dce6f3c.tar.gz
emacs-cf7db4d9dd2e69cf7463a3d43ce7d92a6dce6f3c.zip
Improve debug output of Eglot tests
* test/lisp/progmodes/eglot-tests.el (eglot--test-message): New helper. (eglot--call-with-fixture): Use it. (eglot--cleanup-after-test): Use it. (eglot--wait-for): Use it. Clean mistaken docstring.
-rw-r--r--test/lisp/progmodes/eglot-tests.el50
1 files changed, 29 insertions, 21 deletions
diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el
index 4d6af79f87f..d5f0f02fc6b 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -59,6 +59,11 @@
59 59
60;;; Helpers 60;;; Helpers
61 61
62(defun eglot--test-message (format &rest args)
63 "Message out with FORMAT with ARGS."
64 (message "[eglot-tests] %s"
65 (apply #'format format args)))
66
62(defmacro eglot--with-fixture (fixture &rest body) 67(defmacro eglot--with-fixture (fixture &rest body)
63 "Setup FIXTURE, call BODY, teardown FIXTURE. 68 "Setup FIXTURE, call BODY, teardown FIXTURE.
64FIXTURE is a list. Its elements are of the form (FILE . CONTENT) 69FIXTURE is a list. Its elements are of the form (FILE . CONTENT)
@@ -102,6 +107,7 @@ then restored."
102 (push (cons (car spec) (symbol-value (car spec))) syms-to-restore) 107 (push (cons (car spec) (symbol-value (car spec))) syms-to-restore)
103 (set (car spec) (cadr spec))) 108 (set (car spec) (cadr spec)))
104 ((stringp (car spec)) (push spec file-specs)))) 109 ((stringp (car spec)) (push spec file-specs))))
110 (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test)))
105 (unwind-protect 111 (unwind-protect
106 (let* ((process-environment 112 (let* ((process-environment
107 (append 113 (append
@@ -126,8 +132,8 @@ then restored."
126 (setq created-files (mapcan #'eglot--make-file-or-dir file-specs)) 132 (setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
127 (prog1 (funcall fn) 133 (prog1 (funcall fn)
128 (setq test-body-successful-p t))) 134 (setq test-body-successful-p t)))
129 (eglot--message 135 (eglot--test-message "[%s]: %s" (ert-test-name (ert-running-test))
130 "Test body was %s" (if test-body-successful-p "OK" "A FAILURE")) 136 (if test-body-successful-p "OK" "FAILED"))
131 (unwind-protect 137 (unwind-protect
132 (let ((eglot-autoreconnect nil)) 138 (let ((eglot-autoreconnect nil))
133 (dolist (server new-servers) 139 (dolist (server new-servers)
@@ -136,8 +142,7 @@ then restored."
136 (eglot-shutdown 142 (eglot-shutdown
137 server nil 3 (not test-body-successful-p)) 143 server nil 3 (not test-body-successful-p))
138 (error 144 (error
139 (eglot--message "Non-critical shutdown error after test: %S" 145 (eglot--test-message "Non-critical cleanup error: %S" oops))))
140 oops))))
141 (when (not test-body-successful-p) 146 (when (not test-body-successful-p)
142 ;; We want to do this after the sockets have 147 ;; We want to do this after the sockets have
143 ;; shut down such that any pending data has been 148 ;; shut down such that any pending data has been
@@ -150,21 +155,21 @@ then restored."
150 (jsonrpc-events-buffer server))))) 155 (jsonrpc-events-buffer server)))))
151 (cond (noninteractive 156 (cond (noninteractive
152 (dolist (buffer buffers) 157 (dolist (buffer buffers)
153 (eglot--message "%s:" (buffer-name buffer)) 158 (eglot--test-message "contents of `%s':" (buffer-name buffer))
154 (princ (with-current-buffer buffer (buffer-string)) 159 (princ (with-current-buffer buffer (buffer-string))
155 'external-debugging-output))) 160 'external-debugging-output)))
156 (t 161 (t
157 (eglot--message "Preserved for inspection: %s" 162 (eglot--test-message "Preserved for inspection: %s"
158 (mapconcat #'buffer-name buffers ", ")))))))) 163 (mapconcat #'buffer-name buffers ", "))))))))
159 (eglot--cleanup-after-test fixture-directory created-files syms-to-restore))))) 164 (eglot--cleanup-after-test fixture-directory created-files syms-to-restore)))))
160 165
161(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore) 166(defun eglot--cleanup-after-test (fixture-directory created-files syms-to-restore)
162 (let ((buffers-to-delete 167 (let ((buffers-to-delete
163 (delete nil (mapcar #'find-buffer-visiting created-files)))) 168 (delete nil (mapcar #'find-buffer-visiting created-files))))
164 (eglot--message "Killing %s, wiping %s, restoring %s" 169 (eglot--test-message "Killing %s, wiping %s, restoring %s"
165 buffers-to-delete 170 buffers-to-delete
166 fixture-directory 171 fixture-directory
167 (mapcar #'car syms-to-restore)) 172 (mapcar #'car syms-to-restore))
168 (cl-loop for (sym . val) in syms-to-restore 173 (cl-loop for (sym . val) in syms-to-restore
169 do (set sym val)) 174 do (set sym val))
170 (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted 175 (dolist (buf buffers-to-delete) ;; have to save otherwise will get prompted
@@ -252,12 +257,12 @@ then restored."
252 (advice-remove #'jsonrpc--log-event ',log-event-ad-sym)))) 257 (advice-remove #'jsonrpc--log-event ',log-event-ad-sym))))
253 258
254(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) 259(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body)
255 "Spin until FN match in EVENTS-SYM, flush events after it.
256Pass TIMEOUT to `eglot--with-timeout'."
257 (declare (indent 2) (debug (sexp sexp sexp &rest form))) 260 (declare (indent 2) (debug (sexp sexp sexp &rest form)))
258 `(eglot--with-timeout '(,timeout ,(or message 261 `(eglot--with-timeout '(,timeout ,(or message
259 (format "waiting for:\n%s" (pp-to-string body)))) 262 (format "waiting for:\n%s" (pp-to-string body))))
260 (let ((event 263 (eglot--test-message "waiting for `%s'" (with-output-to-string
264 (mapc #'princ ',body)))
265 (let ((events
261 (cl-loop thereis (cl-loop for json in ,events-sym 266 (cl-loop thereis (cl-loop for json in ,events-sym
262 for method = (plist-get json :method) 267 for method = (plist-get json :method)
263 when (keywordp method) 268 when (keywordp method)
@@ -271,16 +276,18 @@ Pass TIMEOUT to `eglot--with-timeout'."
271 collect json into before) 276 collect json into before)
272 for i from 0 277 for i from 0
273 when (zerop (mod i 5)) 278 when (zerop (mod i 5))
274 ;; do (eglot--message "still struggling to find in %s" 279 ;; do (eglot--test-message "still struggling to find in %s"
275 ;; ,events-sym) 280 ;; ,events-sym)
276 do 281 do
277 ;; `read-event' is essential to have the file 282 ;; `read-event' is essential to have the file
278 ;; watchers come through. 283 ;; watchers come through.
279 (read-event "[eglot] Waiting a bit..." nil 0.1) 284 (read-event nil nil 0.1)
285 (princ ".") (flush-standard-output)
280 (accept-process-output nil 0.1)))) 286 (accept-process-output nil 0.1))))
281 (setq ,events-sym (cdr event)) 287 (setq ,events-sym (cdr events))
282 (eglot--message "Event detected:\n%s" 288 (cl-destructuring-bind (&key method id &allow-other-keys) (car events)
283 (pp-to-string (car event)))))) 289 (eglot--test-message "detected: %s"
290 (or method (and id (format "id=%s" id))))))))
284 291
285;; `rust-mode' is not a part of Emacs, so we define these two shims 292;; `rust-mode' is not a part of Emacs, so we define these two shims
286;; which should be more than enough for testing. 293;; which should be more than enough for testing.
@@ -803,17 +810,18 @@ pylsp prefers autopep over yafp, despite its README stating the contrary."
803 "Test diagnostics through multiple files in a TypeScript LSP." 810 "Test diagnostics through multiple files in a TypeScript LSP."
804 (skip-unless (executable-find "rust-analyzer")) 811 (skip-unless (executable-find "rust-analyzer"))
805 (skip-unless (executable-find "cargo")) 812 (skip-unless (executable-find "cargo"))
813 (skip-unless (executable-find "git"))
806 (eglot--with-fixture 814 (eglot--with-fixture
807 '(("project" . 815 '(("project" .
808 (("main.rs" . 816 (("main.rs" .
809 "fn main() -> i32 { return 42.2;}") 817 "fn main() -> i32 { return 42.2;}")
810 ("other-file.rs" . 818 ("other-file.rs" .
811 "fn foo() -> () { let hi=3; }")))) 819 "fn foo() -> () { let hi=3; }"))))
812 (eglot--make-file-or-dir '(".git"))
813 (let ((eglot-server-programs '((rust-mode . ("rust-analyzer"))))) 820 (let ((eglot-server-programs '((rust-mode . ("rust-analyzer")))))
814 ;; Open other-file.rs, and see diagnostics arrive for main.rs, 821 ;; Open other-file.rs, and see diagnostics arrive for main.rs,
815 ;; which we didn't open. 822 ;; which we didn't open.
816 (with-current-buffer (eglot--find-file-noselect "project/other-file.rs") 823 (with-current-buffer (eglot--find-file-noselect "project/other-file.rs")
824 (should (zerop (shell-command "git init")))
817 (should (zerop (shell-command "cargo init"))) 825 (should (zerop (shell-command "cargo init")))
818 (eglot--sniffing (:server-notifications s-notifs) 826 (eglot--sniffing (:server-notifications s-notifs)
819 (eglot--tests-connect) 827 (eglot--tests-connect)