diff options
Diffstat (limited to 'test/src/process-tests.el')
| -rw-r--r-- | test/src/process-tests.el | 55 |
1 files changed, 47 insertions, 8 deletions
diff --git a/test/src/process-tests.el b/test/src/process-tests.el index e62bcb3f7c0..9bab523708e 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -26,9 +26,9 @@ (require 'cl-lib) (require 'ert) (require 'puny) -(require 'rx) (require 'subr-x) (require 'dns) +(require 'url-http) ;; Timeout in seconds; the test fails if the timeout is reached. (defvar process-test-sentinel-wait-timeout 2.0) @@ -348,8 +348,7 @@ See Bug#30460." invocation-directory)) :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. +;; The following tests require working DNS ;; This will need updating when IANA assign more IPv6 global ranges. (defun ipv6-is-available () @@ -360,9 +359,16 @@ See Bug#30460." (= (logand (aref elt 0) #xe000) #x2000))) (network-interface-list)))) +;; Check if the Internet seems to be working. Mainly to pacify +;; Debian's CI system. +(defvar internet-is-working + (progn + (require 'dns) + (dns-query "google.com"))) + (ert-deftest lookup-family-specification () "`network-lookup-address-info' should only accept valid family symbols." - (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (skip-unless internet-is-working) (with-timeout (60 (ert-fail "Test timed out")) (should-error (network-lookup-address-info "localhost" 'both)) (should (network-lookup-address-info "localhost" 'ipv4)) @@ -371,20 +377,20 @@ See Bug#30460." (ert-deftest lookup-unicode-domains () "Unicode domains should fail." - (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (skip-unless internet-is-working) (with-timeout (60 (ert-fail "Test timed out")) (should-error (network-lookup-address-info "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"))) + (skip-unless internet-is-working) (with-timeout (60 (ert-fail "Test timed out")) (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"))) + (skip-unless internet-is-working) (with-timeout (60 (ert-fail "Test timed out")) (let ((addresses-both (network-lookup-address-info "google.com")) (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))) @@ -396,10 +402,12 @@ See Bug#30460." (ert-deftest non-existent-lookup-failure () "Check that looking up non-existent domain returns nil." - (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (skip-unless internet-is-working) (with-timeout (60 (ert-fail "Test timed out")) (should (eq nil (network-lookup-address-info "emacs.invalid"))))) +;; End of tests requiring DNS + (defmacro process-tests--ignore-EMFILE (&rest body) "Evaluate BODY, ignoring EMFILE errors." (declare (indent 0) (debug t)) @@ -619,6 +627,8 @@ FD_SETSIZE file descriptors (Bug#24325)." FD_SETSIZE file descriptors (Bug#24325)." (skip-unless (featurep 'make-network-process '(:server t))) (skip-unless (featurep 'make-network-process '(:family local))) + ;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496). + (skip-unless (not (eq system-type 'cygwin))) (with-timeout (60 (ert-fail "Test timed out")) (process-tests--with-temp-directory directory (process-tests--with-processes processes @@ -907,5 +917,34 @@ Return nil if FILENAME doesn't exist." ;; ...and the change description should be "interrupt". (should (equal '("interrupt\n") events))))) +(ert-deftest process-async-https-with-delay () + "Bug#49449: asynchronous TLS connection with delayed completion." + (skip-unless (and internet-is-working (gnutls-available-p))) + (let* ((status nil) + (buf (url-http + #s(url "https" nil nil "elpa.gnu.org" nil + "/packages/archive-contents" nil nil t silent t t) + (lambda (s) (setq status s)) + '(nil) nil 'tls))) + (unwind-protect + (progn + ;; Busy-wait for 1 s to allow for the TCP connection to complete. + (let ((delay 1.0) + (t0 (float-time))) + (while (< (float-time) (+ t0 delay)))) + ;; Wait for the entire operation to finish. + (let ((limit 4.0) + (t0 (float-time))) + (while (and (null status) + (< (float-time) (+ t0 limit))) + (sit-for 0.1))) + (should status) + (should-not (assq :error status)) + (should buf) + (should (> (buffer-size buf) 0)) + ) + (when buf + (kill-buffer buf))))) + (provide 'process-tests) ;;; process-tests.el ends here |