emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master df60587 1/2: Simplify TTY allocation.


From: Philipp Stephani
Subject: master df60587 1/2: Simplify TTY allocation.
Date: Sat, 2 Jan 2021 07:55:36 -0500 (EST)

branch: master
commit df605870fde7e31d2ca76fd7e69961ba94604a34
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>

    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.
---
 test/src/process-tests.el | 71 ++++++++---------------------------------------
 1 file changed, 12 insertions(+), 59 deletions(-)

diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index cddf955..e1e2506 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -512,18 +512,6 @@ FD_SETSIZE."
            (delete-process (pop ,processes))
            ,@body)))))
 
-(defmacro process-tests--with-temp-file (var &rest body)
-  "Bind VAR to the name of a new regular file and evaluate BODY.
-Afterwards, delete the file."
-  (declare (indent 1) (debug (symbolp body)))
-  (cl-check-type var symbol)
-  (let ((file (make-symbol "file")))
-    `(let ((,file (make-temp-file "emacs-test-")))
-       (unwind-protect
-           (let ((,var ,file))
-             ,@body)
-         (delete-file ,file)))))
-
 (defmacro process-tests--with-temp-directory (var &rest body)
   "Bind VAR to the name of a new directory and evaluate BODY.
 Afterwards, delete the directory."
@@ -654,12 +642,6 @@ FD_SETSIZE file descriptors (Bug#24325)."
   "Check that Emacs doesn't crash when trying to use more than
 FD_SETSIZE file descriptors (Bug#24325)."
   (with-timeout (60 (ert-fail "Test timed out"))
-    (skip-unless (file-executable-p shell-file-name))
-    (skip-unless (executable-find "tty"))
-    (skip-unless (executable-find "sleep"))
-    ;; `process-tests--new-pty' probably only works with GNU Bash.
-    (skip-unless (string-equal
-                  (file-name-nondirectory shell-file-name) "bash"))
     (process-tests--with-processes processes
       ;; In order to use `make-serial-process', we need to create some
       ;; pseudoterminals.  The easiest way to do that is to start a
@@ -667,14 +649,22 @@ FD_SETSIZE file descriptors (Bug#24325)."
       ;; ensure that the terminal stays around while we connect to it.
       ;; Create the host processes before the dummy pipes so we have a
       ;; high chance of succeeding here.
-      (let ((tty-names ()))
-        (dotimes (_ 10)
-          (cl-destructuring-bind
-              (host tty-name) (process-tests--new-pty)
+      (let ((sleep (executable-find "sleep"))
+            (tty-names ()))
+        (skip-unless sleep)
+        (dotimes (i 10)
+          (let* ((host (make-process :name (format "tty host %d" i)
+                                     :command (list sleep "60")
+                                     :buffer nil
+                                     :coding 'utf-8-unix
+                                     :connection-type 'pty
+                                     :noquery t))
+                 (tty-name (process-tty-name host)))
             (should (processp host))
             (push host processes)
             (should tty-name)
             (should (file-exists-p tty-name))
+            (should-not (member tty-name tty-names))
             (push tty-name tty-names)))
         (process-tests--fd-setsize-test
           (process-tests--with-processes processes
@@ -717,42 +707,5 @@ Return nil if that can't be determined."
                 (match-string-no-properties 1))))))
   process-tests--EMFILE-message)
 
-(defun process-tests--new-pty ()
-  "Allocate a new pseudoterminal.
-Return a list (PROCESS TTY-NAME)."
-  ;; The command below will typically only work with GNU Bash.
-  (should (string-equal (file-name-nondirectory shell-file-name)
-                        "bash"))
-  (process-tests--with-temp-file temp-file
-    (should-not (file-remote-p temp-file))
-    (let* ((command (list shell-file-name shell-command-switch
-                          (format "tty > %s && sleep 60"
-                                  (shell-quote-argument
-                                   (file-name-unquote temp-file)))))
-           (process (make-process :name "tty host"
-                                  :command command
-                                  :buffer nil
-                                  :coding 'utf-8-unix
-                                  :connection-type 'pty
-                                  :noquery t))
-           (tty-name nil)
-           (coding-system-for-read 'utf-8-unix)
-           (coding-system-for-write 'utf-8-unix))
-      ;; Wait until TTY name has arrived.
-      (with-timeout (2 (message "Timed out waiting for TTY name"))
-        (while (and (process-live-p process) (not tty-name))
-          (sleep-for 0.1)
-          (when-let ((attributes (file-attributes temp-file)))
-            (when (cl-plusp (file-attribute-size attributes))
-              (with-temp-buffer
-                (insert-file-contents temp-file)
-                (goto-char (point-max))
-                ;; `tty' has printed a trailing newline.
-                (skip-chars-backward "\n")
-                (unless (bobp)
-                  (setq tty-name (buffer-substring-no-properties
-                                  (point-min) (point)))))))))
-      (list process tty-name))))
-
 (provide 'process-tests)
 ;;; process-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]