Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7'

4 files changed, 91 insertions, 32 deletions

diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a9d48e29a8a..3a7462b6ada 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -653,6 +653,13 @@ comparing the subr with a much slower lisp implementation."
     (data-tests-check-sign (% -1 -3) (% nb1 nb3))
     (data-tests-check-sign (mod -1 -3) (mod nb1 nb3))))
 
+(ert-deftest data-tests-mod-0 ()
+  (dolist (num (list (1- most-negative-fixnum) -1 0 1
+                     (1+ most-positive-fixnum)))
+    (should-error (mod num 0)))
+  (when (ignore-errors (/ 0.0 0))
+    (should (equal (abs (mod 0.0 0)) (abs (- 0.0 (/ 0.0 0)))))))
+
 (ert-deftest data-tests-ash-lsh ()
   (should (= (ash most-negative-fixnum 1)
              (* most-negative-fixnum 2)))
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 82b75b195ca..ba5bfe0145d 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -220,4 +220,7 @@ literals (Bug#20852)."
                    (* most-positive-fixnum most-positive-fixnum)))
     (should (= n (string-to-number (format "%d." n))))))
 
+(ert-deftest lread-circular-hash ()
+  (should-error (read "#s(hash-table data #0=(#0# . #0#))")))
+
 ;;; lread-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 7745fccaf9d..158c036aaa7 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -22,6 +22,7 @@
 ;;; Code:
 
 (require 'ert)
+(require 'puny)
 
 ;; Timeout in seconds; the test fails if the timeout is reached.
 (defvar process-test-sentinel-wait-timeout 2.0)
@@ -154,24 +155,30 @@
                   (concat invocation-directory invocation-name)
                   "-Q" "--batch" "--eval"
                   (prin1-to-string
-                   '(let (s)
-                      (while (setq s (read-from-minibuffer "$ "))
+                   '(let ((s nil) (count 0))
+                      (while (setq s (read-from-minibuffer
+                                      (format "%d> " count)))
                         (princ s)
-                        (princ "\n")))))))
+                        (princ "\n")
+                        (setq count (1+ count))))))))
       (set-process-query-on-exit-flag proc nil)
       (send-string proc "one\n")
-      (should
-       (accept-process-output proc 1))  ; Read "one".
-      (should (equal (buffer-string) "$ one\n$ "))
+      (while (not (equal (buffer-substring
+                          (line-beginning-position) (point-max))
+                         "1> "))
+        (accept-process-output proc))   ; Read "one".
+      (should (equal (buffer-string) "0> one\n1> "))
       (set-process-filter proc t)       ; Stop reading from proc.
       (send-string proc "two\n")
       (should-not
        (accept-process-output proc 1))  ; Can't read "two" yet.
-      (should (equal (buffer-string) "$ one\n$ "))
+      (should (equal (buffer-string) "0> one\n1> "))
       (set-process-filter proc nil)     ; Resume reading from proc.
-      (should
-       (accept-process-output proc 1))  ; Read "two" from proc.
-      (should (equal (buffer-string) "$ one\n$ two\n$ ")))))
+      (while (not (equal (buffer-substring
+                          (line-beginning-position) (point-max))
+                         "2> "))
+        (accept-process-output proc))   ; Read "Two".
+      (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."
@@ -322,5 +329,41 @@ 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.
+
+(ert-deftest lookup-family-specification ()
+  "network-lookup-address-info should only accept valid family symbols."
+  (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (should-error (network-lookup-address-info "google.com" 'both))
+  (should (network-lookup-address-info "google.com" 'ipv4))
+  (should (network-lookup-address-info "google.com" 'ipv6)))
+
+(ert-deftest lookup-unicode-domains ()
+  "Unicode domains should fail"
+  (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  (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")))
+  (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")))
+  (let ((addresses-both (network-lookup-address-info "google.com"))
+        (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))
+        (addresses-v6 (network-lookup-address-info "google.com" 'ipv6)))
+    (should addresses-both)
+    (should addresses-v4)
+    (should addresses-v6)))
+
+(ert-deftest non-existent-lookup-failure ()
+  (skip-unless (not (getenv "EMACS_HYDRA_CI")))
+  "Check that looking up non-existent domain returns nil"
+  (should (eq nil (network-lookup-address-info "emacs.invalid"))))
+
 (provide 'process-tests)
 ;; process-tests.el ends here.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index a30b2de3a5b..3a18a4a24dd 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -19,6 +19,12 @@
 
 (require 'ert)
 
+(defun timefns-tests--decode-time (look zone decoded-time)
+  (should (equal (decode-time look zone t) decoded-time))
+  (should (equal (decode-time look zone 'integer)
+                 (cons (time-convert (car decoded-time) 'integer)
+                       (cdr decoded-time)))))
+
 ;;; Check format-time-string and decode-time with various TZ settings.
 ;;; Use only POSIX-compatible TZ values, since the tests should work
 ;;; even if tzdb is not in use.
@@ -40,31 +46,29 @@
                     (7879679999900 . 100000)
                     (78796799999999999999 . 1000000000000)))
       ;; UTC.
-     (let ((sec (time-add 59 (time-subtract (time-convert look t)
-                                            (time-convert look 'integer)))))
+     (let* ((look-ticks-hz (time-convert look t))
+            (hz (cdr look-ticks-hz))
+            (look-integer (time-convert look 'integer))
+            (sec (time-add (time-convert 59 hz)
+                           (time-subtract look-ticks-hz
+                                          (time-convert look-integer hz)))))
       (should (string-equal
                (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" look t)
                "1972-06-30 23:59:59.999 +0000"))
-      (should (equal (decode-time look t 'integer)
-                     '(59 59 23 30 6 1972 5 nil 0)))
-      (should (equal (decode-time look t t)
-                     (list sec 59 23 30 6 1972 5 nil 0)))
+      (timefns-tests--decode-time look t
+                                  (list sec 59 23 30 6 1972 5 nil 0))
       ;; "UTC0".
       (should (string-equal
                (format-time-string format look "UTC0")
                "1972-06-30 23:59:59.999 +0000 (UTC)"))
-      (should (equal (decode-time look "UTC0" 'integer)
-                     '(59 59 23 30 6 1972 5 nil 0)))
-      (should (equal (decode-time look "UTC0" t)
-                     (list sec 59 23 30 6 1972 5 nil 0)))
+      (timefns-tests--decode-time look "UTC0"
+                                  (list sec 59 23 30 6 1972 5 nil 0))
       ;; Negative UTC offset, as a Lisp list.
       (should (string-equal
                (format-time-string format look '(-28800 "PST"))
                "1972-06-30 15:59:59.999 -0800 (PST)"))
-      (should (equal (decode-time look '(-28800 "PST") 'integer)
-                     '(59 59 15 30 6 1972 5 nil -28800)))
-      (should (equal (decode-time look '(-28800 "PST") t)
-                     (list sec 59 15 30 6 1972 5 nil -28800)))
+      (timefns-tests--decode-time look '(-28800 "PST")
+                                  (list sec 59 15 30 6 1972 5 nil -28800))
       ;; Negative UTC offset, as a Lisp integer.
       (should (string-equal
                (format-time-string format look -28800)
@@ -73,18 +77,14 @@
                (if (eq system-type 'windows-nt)
                    "1972-06-30 15:59:59.999 -0800 (ZZZ)"
                  "1972-06-30 15:59:59.999 -0800 (-08)")))
-      (should (equal (decode-time look -28800 'integer)
-                     '(59 59 15 30 6 1972 5 nil -28800)))
-      (should (equal (decode-time look -28800 t)
-                     (list sec 59 15 30 6 1972 5 nil -28800)))
+      (timefns-tests--decode-time look -28800
+                                  (list sec 59 15 30 6 1972 5 nil -28800))
       ;; Positive UTC offset that is not an hour multiple, as a string.
       (should (string-equal
                (format-time-string format look "IST-5:30")
                "1972-07-01 05:29:59.999 +0530 (IST)"))
-      (should (equal (decode-time look "IST-5:30" 'integer)
-                     '(59 29 5 1 7 1972 6 nil 19800)))
-      (should (equal (decode-time look "IST-5:30" t)
-                     (list sec 29 5 1 7 1972 6 nil 19800)))))))
+      (timefns-tests--decode-time look "IST-5:30"
+                                  (list sec 29 5 1 7 1972 6 nil 19800))))))
 
 (ert-deftest decode-then-encode-time ()
   (let ((time-values (list 0 -2 1 0.0 -0.0 -2.0 1.0
@@ -129,6 +129,12 @@
                            most-negative-fixnum most-positive-fixnum
                            (1- most-negative-fixnum)
                            (1+ most-positive-fixnum)
+                           1e1 -1e1 1e-1 -1e-1
+                           1e8 -1e8 1e-8 -1e-8
+                           1e9 -1e9 1e-9 -1e-9
+                           1e10 -1e10 1e-10 -1e-10
+                           1e16 -1e16 1e-16 -1e-16
+                           1e37 -1e37 1e-37 -1e-37
                            1e+INF -1e+INF 1e+NaN -1e+NaN
                            '(0 0 0 1) '(0 0 1 0) '(0 1 0 0) '(1 0 0 0)
                            '(-1 0 0 0) '(1 2 3 4) '(-1 2 3 4)