diff options
| author | João Távora | 2023-03-14 19:50:48 +0000 |
|---|---|---|
| committer | João Távora | 2023-03-14 22:57:09 +0000 |
| commit | cf7db4d9dd2e69cf7463a3d43ce7d92a6dce6f3c (patch) | |
| tree | b3db04858048e0b9ffe49e8b49c46fb317d21927 | |
| parent | d3ab5f68773d70eb9e0a2396975583bf14453f40 (diff) | |
| download | emacs-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.el | 50 |
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. |
| 64 | FIXTURE is a list. Its elements are of the form (FILE . CONTENT) | 69 | FIXTURE 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. | ||
| 256 | Pass 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) |