Only run IPv6 tests if we have an IPv6 address

* test/src/process-tests.el (ipv6-is-available): New function for
checking whether we have a globally routable IPv6 prefix assigned.
(lookup-family-specification): Use 'ipv6-is-available' to check for
IPv6.  Use 'localhost' instead of 'google.com' to test
'network-lookup-address-info' API.
(lookup-google): Use 'ipv6-is-available' to check for
IPv6.

* test/lisp/net/nsm-tests.el (nsm-ipv6-is-available): Rename to
'ipv6-is-available', make identical to the one in
test/src/process-tests.el.

diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
index 88c30c203953b06431649e5fe282c741d990f0ec..ff453319b3736956c67e4f4b8ac952d975a7ee40 100644 (file)
--- a/test/lisp/net/nsm-tests.el
+++ b/test/lisp/net/nsm-tests.el
@@ -49,15 +49,17 @@
       (should (eq nil (nsm-should-check "127.0.0.1")))
       (should (eq nil (nsm-should-check "localhost"))))))
 
-(defun nsm-ipv6-is-available ()
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
   (and (featurep 'make-network-process '(:family ipv6))
        (cl-rassoc-if
         (lambda (elt)
-          (eq 9 (length elt)))
+          (and (eq 9 (length elt))
+               (= (logand (aref elt 0) #xe000) #x2000)))
         (network-interface-list))))
 
 (ert-deftest nsm-check-local-subnet-ipv6 ()
-  (skip-unless (nsm-ipv6-is-available))
+  (skip-unless (ipv6-is-available))
   (let ((local-ip '[123 456 789 11 172 26 128 160 0])
         (mask '[255 255 255 255 255 255 255 0 0])
 

diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 921bcd5f85b22e35aa6d54f34a1c6ac09cea596a..57097cfa05263b033e50fb54e43ef4c0dbf513a8 100644 (file)
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -28,6 +28,7 @@
 (require 'puny)
 (require 'rx)
 (require 'subr-x)
+(require 'dns)
 
 ;; Timeout in seconds; the test fails if the timeout is reached.
 (defvar process-test-sentinel-wait-timeout 2.0)
@@ -350,14 +351,23 @@ See Bug#30460."
 ;; All the following tests require working DNS, which appears not to
 ;; be the case for hydra.nixos.org, so disable them there for now.
 
+;; This will need updating when IANA assign more IPv6 global ranges.
+(defun ipv6-is-available ()
+  (and (featurep 'make-network-process '(:family ipv6))
+       (cl-rassoc-if
+        (lambda (elt)
+          (and (eq 9 (length elt))
+               (= (logand (aref elt 0) #xe000) #x2000)))
+        (network-interface-list))))
+
 (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 (ert-fail "Test timed out"))
-  (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-error (network-lookup-address-info "localhost" 'both))
+  (should (network-lookup-address-info "localhost" 'ipv4))
+  (when (ipv6-is-available)
+    (should (network-lookup-address-info "localhost" 'ipv6)))))
 
 (ert-deftest lookup-unicode-domains ()
   "Unicode domains should fail."
@@ -380,7 +390,8 @@ See Bug#30460."
         (addresses-v4 (network-lookup-address-info "google.com" 'ipv4)))
     (should addresses-both)
     (should addresses-v4))
-  (when (featurep 'make-network-process '(:family ipv6))
+  (when (and (ipv6-is-available)
+             (dns-query "google.com" 'AAAA))
     (should (network-lookup-address-info "google.com" 'ipv6)))))
 
 (ert-deftest non-existent-lookup-failure ()