Subject: bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt

From: Jim Porter <[email-masked]>
Date: Fri, 25 Nov 2022 12:57:37 -0800

On 11/25/2022 12:18 PM, Eli Zaretskii wrote:
>> Date: Fri, 25 Nov 2022 11:31:07 -0800
>> Cc: [email-masked]
>> From: Jim Porter <[email-masked]>
>>
>> Hm, it looks like the emacsclient may not be starting up correctly.
>> Could you try the attached patch? I doubt this will fix the tests, but
>> hopefully you'll get some more-useful error messages.
> 
> Here are the failure info from each failed test after this patch:
> 
> Test server-tests/emacsclient/create-frame condition:
>      Output:
>      (ert-test-failed "timed out waiting for (or (= (length server-clients) (1+ starting-client-count)) (eq (process-status emacsclient) exit-status)) to be non-nil")
>     FAILED  1/7  server-tests/emacsclient/create-frame (5.062500 sec) at lisp/server-tests.el:138

Oops, sorry about that. I didn't realize until now that 'ert-info' 
computes its message immediately, rather than at the time of printing 
the info.[1] I've added a bit of code to ert.el to support this case, 
which will hopefully produce better output.

I also added the server.el logs to the output of test failures. Note 
that they'll print the environment variables of the client, so it's 
probably worth skimming over them before posting just in case there are 
any secrets in there.

[1] Maybe there's a better way to do this, but it should at least work 
for the time being. I'm open to alternatives here so that these tests 
are as informative as possible when they fail.

From 7a34b31c17b9563051c54d0fd7289b44f9e36f12 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Fri, 25 Nov 2022 11:13:06 -0800
Subject: [PATCH] Improve robustness of server.el tests

* lisp/emacs-lisp/ert.el (ert--insert-infos): Allow 'message' to be a
function that is called when inserting the info.
(ert-info): Update docstring to describe using a function for
MESSAGE-FORM.

* lisp/server.el (server-start): Log when the server is starting.

* test/lisp/server-tests.el (server-tests/start-emacsclient): Rename
to...
(server-tests/start-client): ... this, and set the process's buffer.
(server-tests/with-server): Override 'server-name' so we don't
conflict with "real" Emacs servers.
(server-tests/with-client): New macro...
(server-tests/server-start/stop-prompt-with-client)
(server-tests/emacsclient/server-edit)
(server-tests/emacsclient/create-frame)
(server-tests/emacsclient/create-frame): ... use it.
(server-tests/server-start/stop-prompt-with-client): Simplify.
---
 lisp/emacs-lisp/ert.el    |   9 ++-
 lisp/server.el            |   1 +
 test/lisp/server-tests.el | 138 +++++++++++++++++++++++---------------
 3 files changed, 93 insertions(+), 55 deletions(-)

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index c25ade22d6..67cbe62538 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -673,8 +673,11 @@ ert-info
 
 To be used within ERT tests.  MESSAGE-FORM should evaluate to a
 string that will be displayed together with the test result if
-the test fails.  PREFIX-FORM should evaluate to a string as well
-and is displayed in front of the value of MESSAGE-FORM."
+the test fails.  MESSAGE-FORM can also evaluate to a function; in
+this case, it will be called when displaying the info.
+
+PREFIX-FORM should evaluate to a string as well and is displayed
+in front of the value of MESSAGE-FORM."
   (declare (debug ((form &rest [sexp form]) body))
 	   (indent 1))
   `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos)))
@@ -1352,6 +1355,8 @@ ert--insert-infos
             (end nil))
         (unwind-protect
             (progn
+              (when (functionp message)
+                (setq message (funcall message)))
               (insert message "\n")
               (setq end (point-marker))
               (goto-char begin)
diff --git a/lisp/server.el b/lisp/server.el
index beb46853b7..2102f8569b 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -756,6 +756,7 @@ server-start
 			       :service server-file
 			       :plist '(:authenticated t)))))
 	  (unless server-process (error "Could not start server process"))
+          (server-log "Starting server")
 	  (process-put server-process :server-file server-file)
           (setq server-mode t)
           (push 'server-mode global-minor-modes)
diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el
index 370cf86148..bb07f69c28 100644
--- a/test/lisp/server-tests.el
+++ b/test/lisp/server-tests.el
@@ -22,17 +22,31 @@
 (require 'ert)
 (require 'server)
 
+(defconst server-tests/max-wait-time 5
+  "The maximum time to wait in `server-tests/wait-until', in seconds.")
+
 (defconst server-tests/emacsclient
   (if installation-directory
       (expand-file-name "lib-src/emacsclient" installation-directory)
     "emacsclient")
   "The emacsclient binary to test.")
 
-(defun server-tests/start-emacsclient (&rest args)
+(defmacro server-tests/wait-until (form)
+  "Wait until FORM is non-nil, timing out and failing if it takes too long."
+  `(let ((start (current-time)))
+    (while (not ,form)
+      (when (> (float-time (time-since start))
+               server-tests/max-wait-time)
+        (ert-fail (format "timed out waiting for %S to be non-nil" ',form)))
+      (sit-for 0.1))))
+
+(defun server-tests/start-client (args)
   "Run emacsclient, passing ARGS as arguments to it."
-  (let ((socket-name (process-get server-process :server-file)))
+  (let ((socket-name (process-get server-process :server-file))
+        (buffer (generate-new-buffer "emacsclient")))
     (make-process
      :name server-tests/emacsclient
+     :buffer buffer
      :command (append (list server-tests/emacsclient
                             "--socket-name" socket-name)
                       args))))
@@ -40,27 +54,46 @@ server-tests/start-emacsclient
 (defmacro server-tests/with-server (&rest body)
   "Start the Emacs server, evaluate BODY, and then stop the server."
   (declare (indent 0))
-  `(progn
+  ;; Override the `server-name' so that these tests don't interfere
+  ;; with any existing Emacs servers on the system.
+  `(let ((server-name "server-tests--server")
+         (server-log t))
      (server-start)
-     (unwind-protect
-         (progn (should (processp server-process))
-                ,@body)
-       (let ((inhibit-message t))
-         (server-start t t))
-       (should (null server-process))
-       (should (null server-clients)))))
-
-(defconst server-tests/max-wait-time 5
-  "The maximum time to wait in `server-tests/wait-until', in seconds.")
-
-(defmacro server-tests/wait-until (form)
-  "Wait until FORM is non-nil, timing out and failing if it takes too long."
-  `(let ((start (current-time)))
-    (while (not ,form)
-      (when (> (float-time (time-since start))
-               server-tests/max-wait-time)
-        (ert-fail (format "timed out waiting for %S to be non-nil" ',form)))
-      (sit-for 0.1))))
+     (ert-info ((lambda ()
+                  (with-current-buffer (get-buffer-create server-buffer)
+                    (buffer-string)))
+                :prefix "Server logs: ")
+       (unwind-protect
+           (progn (should (processp server-process))
+                  ,@body)
+         (let ((inhibit-message t))
+           (server-start t t))
+         (should (null server-process))
+         (should (null server-clients))))))
+
+(defmacro server-tests/with-client (client-symbol args exit-status &rest body)
+  "Start an Emacs client with ARGS and evaluate BODY.
+This binds the client process to CLIENT-SYMBOL.  If EXIT-STATUS is
+non-nil, then after BODY is evaluated, make sure the client
+process's status matches it."
+  (declare (indent 3))
+  (let ((exit-status-symbol (make-symbol "exit-status"))
+        (starting-client-count-symbol (make-symbol "starting-client-count")))
+    `(let ((,starting-client-count-symbol (length server-clients))
+           (,exit-status-symbol ,exit-status)
+           (,client-symbol (server-tests/start-client ,args)))
+       (ert-info ((lambda ()
+                    (with-current-buffer (process-buffer ,client-symbol)
+                      (buffer-string)))
+                  :prefix "Client output: ")
+         (server-tests/wait-until
+          (or (= (length server-clients)
+                 (1+ ,starting-client-count-symbol))
+              (eq (process-status ,client-symbol) ,exit-status-symbol)))
+         ,@body
+         (when ,exit-status-symbol
+           (server-tests/wait-until (eq (process-status ,client-symbol)
+                                        ,exit-status-symbol)))))))
 
 (defvar server-tests/variable nil)
 
@@ -79,57 +112,55 @@ server-tests/server-start/sets-minor-mode
 (ert-deftest server-tests/server-start/stop-prompt-with-client ()
   "Ensure that stopping the server prompts when there are clients."
   (server-tests/with-server
-    (let ((yes-or-no-p-called nil)
-          (emacsclient (server-tests/start-emacsclient "-c")))
-      (server-tests/wait-until (length= (frame-list) 2))
-      (cl-letf (((symbol-function 'yes-or-no-p)
-                 (lambda (_prompt)
-                   (setq yes-or-no-p-called t))))
+    (server-tests/with-client emacsclient '("-c") 'exit
+      (should (length= (frame-list) 2))
+      (cl-letf* ((yes-or-no-p-called nil)
+                 ((symbol-function 'yes-or-no-p)
+                  (lambda (_prompt)
+                    (setq yes-or-no-p-called t))))
         (server-start t)
-        (should yes-or-no-p-called))
-      (server-tests/wait-until (eq (process-status emacsclient) 'exit)))))
+        (should yes-or-no-p-called)))))
 
 (ert-deftest server-tests/server-start/no-stop-prompt-without-client ()
   "Ensure that stopping the server doesn't prompt when there are no clients."
   (server-tests/with-server
-    (let ((yes-or-no-p-called nil))
-      (cl-letf (((symbol-function 'yes-or-no-p)
-                 (lambda (_prompt)
-                   (setq yes-or-no-p-called t))))
-        (let ((inhibit-message t))
-          (server-start t))
-        (should-not yes-or-no-p-called)))))
+    (cl-letf* ((inhibit-message t)
+               (yes-or-no-p-called nil)
+               ((symbol-function 'yes-or-no-p)
+                (lambda (_prompt)
+                  (setq yes-or-no-p-called t))))
+      (server-start t)
+      (should-not yes-or-no-p-called))))
 
 (ert-deftest server-tests/emacsclient/server-edit ()
   "Test that calling `server-edit' from a client buffer exits the client."
   (server-tests/with-server
-    (let ((emacsclient (server-tests/start-emacsclient "file.txt")))
+    (server-tests/with-client emacsclient '("file.txt") 'exit
       (server-tests/wait-until (get-buffer "file.txt"))
       (should (eq (process-status emacsclient) 'run))
-      (should (length= server-clients 1))
       (with-current-buffer "file.txt"
-        (server-edit))
-      (server-tests/wait-until (eq (process-status emacsclient) 'exit)))))
+        (server-edit)))))
 
 (ert-deftest server-tests/emacsclient/create-frame ()
   "Test that \"emacsclient -c\" creates a frame."
-  (server-tests/with-server
-    (let ((emacsclient (server-tests/start-emacsclient "-c")))
-      (server-tests/wait-until (length= (frame-list) 2))
+  (let ((starting-frame-count (length (frame-list))))
+    (server-tests/with-server
+      (server-tests/with-client emacsclient '("-c") nil
+      (should (length= (frame-list) (1+ starting-frame-count)))
       (should (eq (process-status emacsclient) 'run))
-      (should (length= server-clients 1))
       (should (eq (frame-parameter (car (frame-list)) 'client)
                   (car server-clients)))))
   ;; The client frame should go away after the server stops.
-  (should (length= (frame-list) 1)))
+    (should (length= (frame-list) starting-frame-count))))
 
 (ert-deftest server-tests/emacsclient/eval ()
   "Test that \"emacsclient --eval\" works correctly."
   (server-tests/with-server
     (let ((value (random)))
-      (server-tests/start-emacsclient
-       "--eval" (format "(setq server-tests/variable %d)" value))
-      (server-tests/wait-until (eq server-tests/variable value)))))
+      (server-tests/with-client emacsclient
+          (list "--eval" (format "(setq server-tests/variable %d)" value))
+          'exit
+        (should (= server-tests/variable value))))))
 
 (ert-deftest server-tests/server-force-stop/keeps-frames ()
   "Ensure that `server-force-stop' doesn't delete frames.  See bug#58877.
@@ -139,12 +170,13 @@ server-tests/server-force-stop/keeps-frames
 tests that `server-force-stop' doesn't delete frames (and even
 then, requires a few tricks to run as a regression test).  So
 long as this works, the problem in bug#58877 shouldn't occur."
-  (let (terminal)
+  (let ((starting-frame-count (length (frame-list)))
+        terminal)
     (unwind-protect
         (server-tests/with-server
-          (let ((emacsclient (server-tests/start-emacsclient "-c")))
-            (server-tests/wait-until (length= (frame-list) 2))
+          (server-tests/with-client emacsclient '("-c") 'exit
             (should (eq (process-status emacsclient) 'run))
+            (should (length= (frame-list) (1+ starting-frame-count)))
 
             ;; Don't delete the terminal for the client; that would
             ;; kill its frame immediately too.  (This is only an issue
@@ -159,7 +191,7 @@ server-tests/server-force-stop/keeps-frames
 
             (server-force-stop))
           ;; Ensure we didn't delete the frame.
-          (should (length= (frame-list) 2)))
+          (should (length= (frame-list) (1+ starting-frame-count))))
       ;; Clean up after ourselves and delete the terminal.
       (when (and terminal
                  (eq (terminal-live-p terminal) t)
-- 
2.25.1