diff options
| author | Philipp Stephani | 2021-01-02 13:30:53 +0100 |
|---|---|---|
| committer | Philipp Stephani | 2021-01-02 13:33:56 +0100 |
| commit | df605870fde7e31d2ca76fd7e69961ba94604a34 (patch) | |
| tree | 10d2b9ac9ce0fa0f68731b0e8cca3780ed8525f6 /test/src/process-tests.el | |
| parent | 72b048bb9650283f40c93735a5ab50f62e0f4118 (diff) | |
| download | emacs-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.el | 71 |
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. | ||
| 517 | Afterwards, 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. |
| 529 | Afterwards, delete the directory." | 517 | Afterwards, 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 |
| 655 | FD_SETSIZE file descriptors (Bug#24325)." | 643 | FD_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. | ||
| 722 | Return 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 |