From: Michael Albinus Date: Tue, 29 Dec 2020 17:40:23 +0000 (+0100) Subject: Instrument process-tests.el for timeouts on emba X-Git-Tag: emacs-28.0.90~4505 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=154d4b856fb9cfbe8b595a7894e7318e29cefdea;p=emacs.git Instrument process-tests.el for timeouts on emba --- diff --git a/test/src/process-tests.el b/test/src/process-tests.el index daf49759500..464541a9387 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.