[elpa] externals/elpa 3483a2f 10/71: Tests: print contents of *EGLOT ...* buffers in batch mode.

[João Távora]

branch: externals/elpa
commit 3483a2fd0792b988ec6c4dbc1b92dd4fe7a8c4e5
Author: Tobias Rittweiler <trittweiler@gmail.com>
Commit: Tobias Rittweiler <trittweiler@gmail.com>

    Tests: print contents of *EGLOT ...* buffers in batch mode.
    
    Useful for the CI on github. To be able to see more of the context of
    a failure.
    
    * eglot.el (eglot-server-initialized-hook): Changed semantics. Now
    called when an instance of `eglot-lsp-server' is created as part of
    the "connect to server" flow. Previously, there was no difference
    between this hook and `eglot-connect-hook' which continues to be run
    once a connection was successfully established. The
    `eglot-server-initialized-hook' will now capture ALL server instances
    including those that failed to be started. This change was necessary
    to make the test suite be able to dump the output of processes that
    fail to start when running the test suite in batch mode ("make check"
    and the CI.) In PR #448 it was decided that it is ok to change the
    semantics of this hook rather than introducing a new hook.
    (eglot--connect): Change place of where the hook is run.
    (eglot-connect-hook): Initialized now with
    `eglot-signal-didChangeConfiguration' which was kept in
    `eglot-server-initialized-hook' before.
    
    * eglot-tests.el (eglot--call-with-fixture): Use
    `eglot-server-initialized-hook' rather than `eglot-connect-hook'. And
    dump the contents of the *EGLOT ...* buffers when run in
    `noninteractive' (i.e. batch) mode.
    (eglot--cleanup-after-test): New auxiliary function. Extracted
    verbatim out of `eglot--call-with-fixture` in order to lower the
    latter's LOC.
---
 eglot-tests.el | 61 +++++++++++++++++++++++++++++++++++++++-------------------
 eglot.el       | 18 ++++++++++++-----
 2 files changed, 54 insertions(+), 25 deletions(-)

diff --git a/eglot-tests.el b/eglot-tests.el
index fb62a72..faf0e16 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -84,7 +84,7 @@ then restored."
              (set (car spec) (cadr spec)))
             ((stringp (car spec)) (push spec file-specs))))
     (unwind-protect
-        (let ((eglot-connect-hook
+        (let ((eglot-server-initialized-hook
                (lambda (server) (push server new-servers))))
           (setq created-files (mapcan #'eglot--make-file-or-dir file-specs))
           (prog1 (funcall fn)
@@ -93,25 +93,46 @@ then restored."
        "Test body was %s" (if test-body-successful-p "OK" "A FAILURE"))
       (unwind-protect
           (let ((eglot-autoreconnect nil))
-            (mapc (lambda (server)
-                    (condition-case oops
-                        (eglot-shutdown
-                         server nil 3 (not test-body-successful-p))
-                      (error
-                       (message "[eglot] Non-critical shutdown error after 
test: %S"
-                                oops))))
-                  (cl-remove-if-not #'jsonrpc-running-p new-servers)))
-        (let ((buffers-to-delete
-               (delete nil (mapcar #'find-buffer-visiting created-files))))
-          (eglot--message "Killing %s, wiping %s, restoring %s"
-                          buffers-to-delete
-                          default-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))))))
+            (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))
diff --git a/eglot.el b/eglot.el
index c7c4551..13571d4 100644
--- a/eglot.el
+++ b/eglot.el
@@ -790,11 +790,19 @@ INTERACTIVE is t if called interactively."
   (interactive (list (eglot--current-server-or-lose)))
   (jsonrpc-forget-pending-continuations server))
 
-(defvar eglot-connect-hook nil "Hook run after connecting in 
`eglot--connect'.")
+(defvar eglot-connect-hook
+  '(eglot-signal-didChangeConfiguration)
+  "Hook run after connecting in `eglot--connect'.")
 
 (defvar eglot-server-initialized-hook
-  '(eglot-signal-didChangeConfiguration)
-  "Hook run after server is successfully initialized.
+  '()
+  "Hook run after a `eglot-lsp-server' instance is created.
+
+That is before a connection was established. Use
+`eglot-connect-hook' to hook into when a connection was
+successfully established and the server on the other side has
+received the initializing configuration.
+
 Each function is passed the server as an argument")
 
 (defun eglot--connect (managed-major-mode project class contact)
@@ -851,6 +859,7 @@ This docstring appeases checkdoc, that's all."
     (setf (eglot--project-nickname server) nickname)
     (setf (eglot--major-mode server) managed-major-mode)
     (setf (eglot--inferior-process server) autostart-inferior-process)
+    (run-hook-with-args 'eglot-server-initialized-hook server)
     ;; Now start the handshake.  To honour `eglot-sync-connect'
     ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
     ;; and mimic most of `jsonrpc-request'.
@@ -898,8 +907,7 @@ This docstring appeases checkdoc, that's all."
                           (let ((default-directory (car (project-roots 
project)))
                                 (major-mode managed-major-mode))
                             (hack-dir-local-variables-non-file-buffer)
-                            (run-hook-with-args 'eglot-connect-hook server)
-                            (run-hook-with-args 'eglot-server-initialized-hook 
server))
+                            (run-hook-with-args 'eglot-connect-hook server))
                           (eglot--message
                            "Connected! Server `%s' now managing `%s' buffers \
 in project `%s'."