From 7a34b31c17b9563051c54d0fd7289b44f9e36f12 Mon Sep 17 00:00:00 2001 From: Jim Porter 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