diff options
Diffstat (limited to 'test/src/process-tests.el')
| -rw-r--r-- | test/src/process-tests.el | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/test/src/process-tests.el b/test/src/process-tests.el index ca98f54bdb1..57097cfa052 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el | |||
| @@ -28,6 +28,7 @@ | |||
| 28 | (require 'puny) | 28 | (require 'puny) |
| 29 | (require 'rx) | 29 | (require 'rx) |
| 30 | (require 'subr-x) | 30 | (require 'subr-x) |
| 31 | (require 'dns) | ||
| 31 | 32 | ||
| 32 | ;; Timeout in seconds; the test fails if the timeout is reached. | 33 | ;; Timeout in seconds; the test fails if the timeout is reached. |
| 33 | (defvar process-test-sentinel-wait-timeout 2.0) | 34 | (defvar process-test-sentinel-wait-timeout 2.0) |
| @@ -350,14 +351,23 @@ See Bug#30460." | |||
| 350 | ;; All the following tests require working DNS, which appears not to | 351 | ;; All the following tests require working DNS, which appears not to |
| 351 | ;; be the case for hydra.nixos.org, so disable them there for now. | 352 | ;; be the case for hydra.nixos.org, so disable them there for now. |
| 352 | 353 | ||
| 354 | ;; This will need updating when IANA assign more IPv6 global ranges. | ||
| 355 | (defun ipv6-is-available () | ||
| 356 | (and (featurep 'make-network-process '(:family ipv6)) | ||
| 357 | (cl-rassoc-if | ||
| 358 | (lambda (elt) | ||
| 359 | (and (eq 9 (length elt)) | ||
| 360 | (= (logand (aref elt 0) #xe000) #x2000))) | ||
| 361 | (network-interface-list)))) | ||
| 362 | |||
| 353 | (ert-deftest lookup-family-specification () | 363 | (ert-deftest lookup-family-specification () |
| 354 | "`network-lookup-address-info' should only accept valid family symbols." | 364 | "`network-lookup-address-info' should only accept valid family symbols." |
| 355 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) | 365 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) |
| 356 | (with-timeout (60 (ert-fail "Test timed out")) | 366 | (with-timeout (60 (ert-fail "Test timed out")) |
| 357 | (should-error (network-lookup-address-info "google.com" 'both)) | 367 | (should-error (network-lookup-address-info "localhost" 'both)) |
| 358 | (should (network-lookup-address-info "google.com" 'ipv4)) | 368 | (should (network-lookup-address-info "localhost" 'ipv4)) |
| 359 | (when (featurep 'make-network-process '(:family ipv6)) | 369 | (when (ipv6-is-available) |
| 360 | (should (network-lookup-address-info "google.com" 'ipv6))))) | 370 | (should (network-lookup-address-info "localhost" 'ipv6))))) |
| 361 | 371 | ||
| 362 | (ert-deftest lookup-unicode-domains () | 372 | (ert-deftest lookup-unicode-domains () |
| 363 | "Unicode domains should fail." | 373 | "Unicode domains should fail." |
| @@ -380,7 +390,8 @@ See Bug#30460." | |||
| 380 | (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))) | 390 | (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))) |
| 381 | (should addresses-both) | 391 | (should addresses-both) |
| 382 | (should addresses-v4)) | 392 | (should addresses-v4)) |
| 383 | (when (featurep 'make-network-process '(:family ipv6)) | 393 | (when (and (ipv6-is-available) |
| 394 | (dns-query "google.com" 'AAAA)) | ||
| 384 | (should (network-lookup-address-info "google.com" 'ipv6))))) | 395 | (should (network-lookup-address-info "google.com" 'ipv6))))) |
| 385 | 396 | ||
| 386 | (ert-deftest non-existent-lookup-failure () | 397 | (ert-deftest non-existent-lookup-failure () |
| @@ -565,6 +576,11 @@ FD_SETSIZE file descriptors (Bug#24325)." | |||
| 565 | (should (memq (process-status process) '(run exit))) | 576 | (should (memq (process-status process) '(run exit))) |
| 566 | (when (process-live-p process) | 577 | (when (process-live-p process) |
| 567 | (process-send-eof process)) | 578 | (process-send-eof process)) |
| 579 | ;; FIXME: This `sleep-for' shouldn't be needed. It | ||
| 580 | ;; indicates a bug in Emacs; perhaps SIGCHLD is | ||
| 581 | ;; received in parallel with `accept-process-output', | ||
| 582 | ;; causing the latter to hang. | ||
| 583 | (sleep-for 0.1) | ||
| 568 | (while (accept-process-output process)) | 584 | (while (accept-process-output process)) |
| 569 | (should (eq (process-status process) 'exit)) | 585 | (should (eq (process-status process) 'exit)) |
| 570 | ;; If there's an error between fork and exec, Emacs | 586 | ;; If there's an error between fork and exec, Emacs |