master 14d54212ea: Improve robustness of server.el tests

[Jim Porter]

branch: master
commit 14d54212ea46dbd8c950c9852318597e0e47908d
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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/can-create-frames-p): New
    constant.  Use it to skip tests that need to create frames.
    (server-tests/start-emacsclient): Rename to...
    (server-tests/start-client): ... this, and set the process's buffer.
    (server-tests/with-server): Put the server file in a temporary
    directory 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 | 160 ++++++++++++++++++++++++++++++----------------
 3 files changed, 113 insertions(+), 57 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 @@ Bound dynamically.  This is a list of (PREFIX . MESSAGE) 
pairs.")
 
 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 @@ RESULT must be an `ert-test-result-with-condition'."
             (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 @@ the `server-process' variable."
                               :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..f8ecd046f2 100644
--- a/test/lisp/server-tests.el
+++ b/test/lisp/server-tests.el
@@ -22,45 +22,93 @@
 (require 'ert)
 (require 'server)
 
+(defconst server-tests/can-create-frames-p
+  (not (memq system-type '(windows-nt ms-dos)))
+  "Non-nil if we can create a new frame in the tests.
+Some tests below need to create new frames for the emacsclient.
+However, this doesn't work on all platforms.  In particular,
+MS-Windows fails to create frames from a batch Emacs session.  In
+cases like that, we just skip the test.")
+
+(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 ((server-file (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)
+                            (if server-use-tcp
+                                "--server-file"
+                              "--socket-name")
+                            server-file)
                       args))))
 
 (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* ((temporary-file-directory (file-name-as-directory
+                                     (make-temp-file "server-tests" t)))
+          (server-name (expand-file-name
+                        "test-server" temporary-file-directory))
+          (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))
+         (delete-directory temporary-file-directory 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)
 
@@ -78,58 +126,58 @@
 
 (ert-deftest server-tests/server-start/stop-prompt-with-client ()
   "Ensure that stopping the server prompts when there are clients."
+  (skip-unless server-tests/can-create-frames-p)
   (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))
+  (skip-unless server-tests/can-create-frames-p)
+  (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)))
+    ;; The client frame should go away after the server stops.
+    (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 +187,14 @@ would make it hard to check test results!)  Instead, it 
only
 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)
+  (skip-unless server-tests/can-create-frames-p)
+  (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 +209,7 @@ long as this works, the problem in bug#58877 shouldn't 
occur."
 
             (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)