aboutsummaryrefslogtreecommitdiffstats
path: root/test/src/process-tests.el
diff options
context:
space:
mode:
authorPhilipp Stephani2021-01-02 13:30:53 +0100
committerPhilipp Stephani2021-01-02 13:33:56 +0100
commitdf605870fde7e31d2ca76fd7e69961ba94604a34 (patch)
tree10d2b9ac9ce0fa0f68731b0e8cca3780ed8525f6 /test/src/process-tests.el
parent72b048bb9650283f40c93735a5ab50f62e0f4118 (diff)
downloademacs-df605870fde7e31d2ca76fd7e69961ba94604a34.tar.gz
emacs-df605870fde7e31d2ca76fd7e69961ba94604a34.zip
Simplify TTY allocation.
The 'process-tty-name' already provides the TTY name, we don't have interrogate the TTY host. * test/src/process-tests.el (process-tests/fd-setsize-no-crash/make-serial-process): Use 'process-tty-name' instead of having the TTY host print its TTY name. Check whether TTY names are unique. (process-tests--new-pty, process-tests--with-temp-file): Remove; no longer used.
Diffstat (limited to 'test/src/process-tests.el')
-rw-r--r--test/src/process-tests.el71
1 files changed, 12 insertions, 59 deletions
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index cddf955853e..e1e25068e4a 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -512,18 +512,6 @@ FD_SETSIZE."
512 (delete-process (pop ,processes)) 512 (delete-process (pop ,processes))
513 ,@body))))) 513 ,@body)))))
514 514
515(defmacro process-tests--with-temp-file (var &rest body)
516 "Bind VAR to the name of a new regular file and evaluate BODY.
517Afterwards, delete the file."
518 (declare (indent 1) (debug (symbolp body)))
519 (cl-check-type var symbol)
520 (let ((file (make-symbol "file")))
521 `(let ((,file (make-temp-file "emacs-test-")))
522 (unwind-protect
523 (let ((,var ,file))
524 ,@body)
525 (delete-file ,file)))))
526
527(defmacro process-tests--with-temp-directory (var &rest body) 515(defmacro process-tests--with-temp-directory (var &rest body)
528 "Bind VAR to the name of a new directory and evaluate BODY. 516 "Bind VAR to the name of a new directory and evaluate BODY.
529Afterwards, delete the directory." 517Afterwards, delete the directory."
@@ -654,12 +642,6 @@ FD_SETSIZE file descriptors (Bug#24325)."
654 "Check that Emacs doesn't crash when trying to use more than 642 "Check that Emacs doesn't crash when trying to use more than
655FD_SETSIZE file descriptors (Bug#24325)." 643FD_SETSIZE file descriptors (Bug#24325)."
656 (with-timeout (60 (ert-fail "Test timed out")) 644 (with-timeout (60 (ert-fail "Test timed out"))
657 (skip-unless (file-executable-p shell-file-name))
658 (skip-unless (executable-find "tty"))
659 (skip-unless (executable-find "sleep"))
660 ;; `process-tests--new-pty' probably only works with GNU Bash.
661 (skip-unless (string-equal
662 (file-name-nondirectory shell-file-name) "bash"))
663 (process-tests--with-processes processes 645 (process-tests--with-processes processes
664 ;; In order to use `make-serial-process', we need to create some 646 ;; In order to use `make-serial-process', we need to create some
665 ;; pseudoterminals. The easiest way to do that is to start a 647 ;; pseudoterminals. The easiest way to do that is to start a
@@ -667,14 +649,22 @@ FD_SETSIZE file descriptors (Bug#24325)."
667 ;; ensure that the terminal stays around while we connect to it. 649 ;; ensure that the terminal stays around while we connect to it.
668 ;; Create the host processes before the dummy pipes so we have a 650 ;; Create the host processes before the dummy pipes so we have a
669 ;; high chance of succeeding here. 651 ;; high chance of succeeding here.
670 (let ((tty-names ())) 652 (let ((sleep (executable-find "sleep"))
671 (dotimes (_ 10) 653 (tty-names ()))
672 (cl-destructuring-bind 654 (skip-unless sleep)
673 (host tty-name) (process-tests--new-pty) 655 (dotimes (i 10)
656 (let* ((host (make-process :name (format "tty host %d" i)
657 :command (list sleep "60")
658 :buffer nil
659 :coding 'utf-8-unix
660 :connection-type 'pty
661 :noquery t))
662 (tty-name (process-tty-name host)))
674 (should (processp host)) 663 (should (processp host))
675 (push host processes) 664 (push host processes)
676 (should tty-name) 665 (should tty-name)
677 (should (file-exists-p tty-name)) 666 (should (file-exists-p tty-name))
667 (should-not (member tty-name tty-names))
678 (push tty-name tty-names))) 668 (push tty-name tty-names)))
679 (process-tests--fd-setsize-test 669 (process-tests--fd-setsize-test
680 (process-tests--with-processes processes 670 (process-tests--with-processes processes
@@ -717,42 +707,5 @@ Return nil if that can't be determined."
717 (match-string-no-properties 1)))))) 707 (match-string-no-properties 1))))))
718 process-tests--EMFILE-message) 708 process-tests--EMFILE-message)
719 709
720(defun process-tests--new-pty ()
721 "Allocate a new pseudoterminal.
722Return a list (PROCESS TTY-NAME)."
723 ;; The command below will typically only work with GNU Bash.
724 (should (string-equal (file-name-nondirectory shell-file-name)
725 "bash"))
726 (process-tests--with-temp-file temp-file
727 (should-not (file-remote-p temp-file))
728 (let* ((command (list shell-file-name shell-command-switch
729 (format "tty > %s && sleep 60"
730 (shell-quote-argument
731 (file-name-unquote temp-file)))))
732 (process (make-process :name "tty host"
733 :command command
734 :buffer nil
735 :coding 'utf-8-unix
736 :connection-type 'pty
737 :noquery t))
738 (tty-name nil)
739 (coding-system-for-read 'utf-8-unix)
740 (coding-system-for-write 'utf-8-unix))
741 ;; Wait until TTY name has arrived.
742 (with-timeout (2 (message "Timed out waiting for TTY name"))
743 (while (and (process-live-p process) (not tty-name))
744 (sleep-for 0.1)
745 (when-let ((attributes (file-attributes temp-file)))
746 (when (cl-plusp (file-attribute-size attributes))
747 (with-temp-buffer
748 (insert-file-contents temp-file)
749 (goto-char (point-max))
750 ;; `tty' has printed a trailing newline.
751 (skip-chars-backward "\n")
752 (unless (bobp)
753 (setq tty-name (buffer-substring-no-properties
754 (point-min) (point)))))))))
755 (list process tty-name))))
756
757(provide 'process-tests) 710(provide 'process-tests)
758;;; process-tests.el ends here 711;;; process-tests.el ends here