mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
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.
This commit is contained in:
Jim Porter
parent
eb713a8fcc
commit
14d54212ea
3 changed files with 115 additions and 59 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -22,37 +22,23 @@
|
|||
(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)
|
||||
"Run emacsclient, passing ARGS as arguments to it."
|
||||
(let ((socket-name (process-get server-process :server-file)))
|
||||
(make-process
|
||||
:name server-tests/emacsclient
|
||||
:command (append (list server-tests/emacsclient
|
||||
"--socket-name" socket-name)
|
||||
args))))
|
||||
|
||||
(defmacro server-tests/with-server (&rest body)
|
||||
"Start the Emacs server, evaluate BODY, and then stop the server."
|
||||
(declare (indent 0))
|
||||
`(progn
|
||||
(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)))
|
||||
|
|
@ -62,6 +48,68 @@
|
|||
(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 ((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
|
||||
(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))
|
||||
;; 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)
|
||||
(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)
|
||||
|
||||
;;; Tests:
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue