all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Jim Porter <jporterbugs@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 58877@debbugs.gnu.org
Subject: bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt
Date: Fri, 25 Nov 2022 12:57:37 -0800	[thread overview]
Message-ID: <e00204c4-8d05-0e69-1b8a-83a9ed7dde87@gmail.com> (raw)
In-Reply-To: <83wn7iu6rz.fsf@gnu.org>

[-- Attachment #1: Type: text/plain, Size: 1458 bytes --]

On 11/25/2022 12:18 PM, Eli Zaretskii wrote:
>> Date: Fri, 25 Nov 2022 11:31:07 -0800
>> Cc: 58877@debbugs.gnu.org
>> From: Jim Porter <jporterbugs@gmail.com>
>>
>> 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.

[-- Attachment #2: 0001-Improve-robustness-of-server.el-tests.patch --]
[-- Type: text/plain, Size: 12274 bytes --]

From 7a34b31c17b9563051c54d0fd7289b44f9e36f12 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
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


  reply	other threads:[~2022-11-25 20:57 UTC|newest]

Thread overview: 19+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-10-29 21:33 bug#58877: 29.0.50; [PATCH] When killing Emacs from a client frame with no other frames, Emacs shows a useless error prompt Jim Porter
2022-10-30  6:14 ` Eli Zaretskii
2022-10-30 21:14   ` Jim Porter
2022-11-22  5:06     ` Jim Porter
2022-11-24 11:51       ` Eli Zaretskii
2022-11-25  1:36         ` Jim Porter
2022-11-25 13:25           ` Eli Zaretskii
2022-11-25 19:31             ` Jim Porter
2022-11-25 20:18               ` Eli Zaretskii
2022-11-25 20:57                 ` Jim Porter [this message]
2022-11-26 14:43                   ` Eli Zaretskii
2022-11-26 19:04                     ` Jim Porter
2022-11-26 19:45                       ` Eli Zaretskii
2022-11-26 20:17                         ` Jim Porter
2022-11-26 20:35                           ` Eli Zaretskii
2022-11-26 21:44                             ` Jim Porter
2022-11-28  1:28                               ` Jim Porter
2022-11-28  3:31                                 ` Eli Zaretskii
2022-11-28  6:27                                   ` Jim Porter

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=e00204c4-8d05-0e69-1b8a-83a9ed7dde87@gmail.com \
    --to=jporterbugs@gmail.com \
    --cc=58877@debbugs.gnu.org \
    --cc=eliz@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.