master 154d4b8: Instrument process-tests.el for timeouts on emba

[Michael Albinus]

branch: master
commit 154d4b856fb9cfbe8b595a7894e7318e29cefdea
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Instrument process-tests.el for timeouts on emba
---
 test/src/process-tests.el | 57 +++++++++++++++++++++++++++++++----------------
 1 file changed, 38 insertions(+), 19 deletions(-)

diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index daf4975..464541a 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -47,13 +47,15 @@
 
 (ert-deftest process-test-sentinel-accept-process-output ()
   (skip-unless (executable-find "bash"))
+  (with-timeout (60)
   (should (process-test-sentinel-wait-function-working-p
-           #'accept-process-output)))
+           #'accept-process-output))))
 
 (ert-deftest process-test-sentinel-sit-for ()
   (skip-unless (executable-find "bash"))
+  (with-timeout (60)
   (should
-   (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 
t)))))
+   (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 
t))))))
 
 (when (eq system-type 'windows-nt)
   (ert-deftest process-test-quoted-batfile ()
@@ -79,6 +81,7 @@
 
 (ert-deftest process-test-stderr-buffer ()
   (skip-unless (executable-find "bash"))
+  (with-timeout (60)
   (let* ((stdout-buffer (generate-new-buffer "*stdout*"))
         (stderr-buffer (generate-new-buffer "*stderr*"))
         (proc (make-process :name "test"
@@ -103,10 +106,11 @@
              (looking-at "hello stdout!")))
     (should (with-current-buffer stderr-buffer
              (goto-char (point-min))
-             (looking-at "hello stderr!")))))
+             (looking-at "hello stderr!"))))))
 
 (ert-deftest process-test-stderr-filter ()
   (skip-unless (executable-find "bash"))
+  (with-timeout (60)
   (let* ((sentinel-called nil)
         (stderr-sentinel-called nil)
         (stdout-output nil)
@@ -145,10 +149,11 @@
     (should (equal 1 (with-current-buffer stderr-buffer
                       (point-max))))
     (should (equal "hello stderr!\n"
-                  (mapconcat #'identity (nreverse stderr-output) "")))))
+                  (mapconcat #'identity (nreverse stderr-output) ""))))))
 
 (ert-deftest set-process-filter-t ()
   "Test setting process filter to t and back." ;; Bug#36591
+  (with-timeout (60)
   (with-temp-buffer
     (let* ((print-level nil)
            (print-length nil)
@@ -180,11 +185,12 @@
                           (line-beginning-position) (point-max))
                          "2> "))
         (accept-process-output proc))   ; Read "Two".
-      (should (equal (buffer-string) "0> one\n1> two\n2> ")))))
+      (should (equal (buffer-string) "0> one\n1> two\n2> "))))))
 
 (ert-deftest start-process-should-not-modify-arguments ()
   "`start-process' must not modify its arguments in-place."
   ;; See bug#21831.
+  (with-timeout (60)
   (let* ((path (pcase system-type
                  ((or 'windows-nt 'ms-dos)
                   ;; Make sure the file name uses forward slashes.
@@ -198,11 +204,12 @@
     (should (process-live-p (condition-case nil
                                 (start-process "" nil path)
                               (error nil))))
-    (should (equal path samepath))))
+    (should (equal path samepath)))))
 
 (ert-deftest make-process/noquery-stderr ()
   "Checks that Bug#30031 is fixed."
   (skip-unless (executable-find "sleep"))
+  (with-timeout (60)
   (with-temp-buffer
     (let* ((previous-processes (process-list))
            (process (make-process :name "sleep"
@@ -217,7 +224,7 @@
             (should new-processes)
             (dolist (process new-processes)
               (should-not (process-query-on-exit-flag process))))
-        (kill-process process)))))
+        (kill-process process))))))
 
 ;; Return t if OUTPUT could have been generated by merging the INPUTS somehow.
 (defun process-tests--mixable (output &rest inputs)
@@ -233,6 +240,7 @@
 (ert-deftest make-process/mix-stderr ()
   "Check that `make-process' mixes the output streams if STDERR is nil."
   (skip-unless (executable-find "bash"))
+  (with-timeout (60)
   ;; Frequent random (?) failures on hydra.nixos.org, with no process output.
   ;; Maybe this test should be tagged unstable?  See bug#31214.
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
@@ -251,11 +259,12 @@
       (should (eq (process-exit-status process) 0))
       (should (process-tests--mixable (string-to-list (buffer-string))
                                       (string-to-list "stdout\n")
-                                      (string-to-list "stderr\n"))))))
+                                      (string-to-list "stderr\n")))))))
 
 (ert-deftest make-process-w32-debug-spawn-error ()
   "Check that debugger runs on `make-process' failure (Bug#33016)."
   (skip-unless (eq system-type 'windows-nt))
+  (with-timeout (60)
   (let* ((debug-on-error t)
          (have-called-debugger nil)
          (debugger (lambda (&rest _)
@@ -271,11 +280,12 @@
                     ;; code.
                     (make-process :name "test" :command 
'("c:/No-Such-Command"))
                   (error :got-error))))
-    (should have-called-debugger)))
+    (should have-called-debugger))))
 
 (ert-deftest make-process/file-handler/found ()
   "Check that the ‘:file-handler’ argument of ‘make-process’
 works as expected if a file name handler is found."
+  (with-timeout (60)
   (let ((file-handler-calls 0))
     (cl-flet ((file-handler
                (&rest args)
@@ -292,27 +302,29 @@ works as expected if a file name handler is found."
                                   :command '("/some/binary")
                                   :file-handler t)
                     'fake-process))
-        (should (= file-handler-calls 1))))))
+        (should (= file-handler-calls 1)))))))
 
 (ert-deftest make-process/file-handler/not-found ()
   "Check that the ‘:file-handler’ argument of ‘make-process’
 works as expected if no file name handler is found."
+  (with-timeout (60)
   (let ((file-name-handler-alist ())
         (default-directory invocation-directory)
         (program (expand-file-name invocation-name invocation-directory)))
     (should (processp (make-process :name "name"
                                     :command (list program "--version")
-                                    :file-handler t)))))
+                                    :file-handler t))))))
 
 (ert-deftest make-process/file-handler/disable ()
   "Check ‘make-process’ works as expected if it shouldn’t use the
 file name handler."
+  (with-timeout (60)
   (let ((file-name-handler-alist (list (cons (rx bos "test-handler:")
                                              #'process-tests--file-handler)))
         (default-directory "test-handler:/dir/")
         (program (expand-file-name invocation-name invocation-directory)))
     (should (processp (make-process :name "name"
-                                    :command (list program "--version"))))))
+                                    :command (list program "--version")))))))
 
 (defun process-tests--file-handler (operation &rest _args)
   (cl-ecase operation
@@ -325,11 +337,12 @@ file name handler."
 (ert-deftest make-process/stop ()
   "Check that `make-process' doesn't accept a `:stop' key.
 See Bug#30460."
+  (with-timeout (60)
   (should-error
    (make-process :name "test"
                  :command (list (expand-file-name invocation-name
                                                   invocation-directory))
-                 :stop t)))
+                 :stop t))))
 
 ;; All the following tests require working DNS, which appears not to
 ;; be the case for hydra.nixos.org, so disable them there for now.
@@ -337,40 +350,46 @@ See Bug#30460."
 (ert-deftest lookup-family-specification ()
   "network-lookup-address-info should only accept valid family symbols."
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (with-timeout (60)
   (should-error (network-lookup-address-info "google.com" 'both))
   (should (network-lookup-address-info "google.com" 'ipv4))
   (when (featurep 'make-network-process '(:family ipv6))
-    (should (network-lookup-address-info "google.com" 'ipv6))))
+    (should (network-lookup-address-info "google.com" 'ipv6)))))
 
 (ert-deftest lookup-unicode-domains ()
   "Unicode domains should fail"
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (with-timeout (60)
   (should-error (network-lookup-address-info "faß.de"))
-  (should (network-lookup-address-info (puny-encode-domain "faß.de"))))
+  (should (network-lookup-address-info (puny-encode-domain "faß.de")))))
 
 (ert-deftest unibyte-domain-name ()
   "Unibyte domain names should work"
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
-  (should (network-lookup-address-info (string-to-unibyte "google.com"))))
+  (with-timeout (60)
+  (should (network-lookup-address-info (string-to-unibyte "google.com")))))
 
 (ert-deftest lookup-google ()
   "Check that we can look up google IP addresses"
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (with-timeout (60)
   (let ((addresses-both (network-lookup-address-info "google.com"))
         (addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
     (should addresses-both)
     (should addresses-v4))
   (when (featurep 'make-network-process '(:family ipv6))
-    (should (network-lookup-address-info "google.com" 'ipv6))))
+    (should (network-lookup-address-info "google.com" 'ipv6)))))
 
 (ert-deftest non-existent-lookup-failure ()
   (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (with-timeout (60)
   "Check that looking up non-existent domain returns nil"
-  (should (eq nil (network-lookup-address-info "emacs.invalid"))))
+  (should (eq nil (network-lookup-address-info "emacs.invalid")))))
 
 (ert-deftest process-tests/fd-setsize-no-crash ()
   "Check that Emacs doesn't crash when trying to use more than
 FD_SETSIZE file descriptors (Bug#24325)."
+  (with-timeout (60)
   (let ((sleep (executable-find "sleep"))
         ;; FD_SETSIZE is typically 1024 on Unix-like systems.
         (fd-setsize 1024)
@@ -401,7 +420,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
       (while (accept-process-output process))
       (should (eq (process-status process) 'exit))
       (should (eql (process-exit-status process) 0))
-      (delete-process process))))
+      (delete-process process)))))
 
 (provide 'process-tests)
 ;; process-tests.el ends here.