diff options
| author | Paul Eggert | 2018-09-24 19:13:34 -0700 |
|---|---|---|
| committer | Paul Eggert | 2018-09-24 19:15:23 -0700 |
| commit | d0c77a189423dbf648ca5ae9d831a5a2e04e6947 (patch) | |
| tree | 0c4cf84c21071605699678116a28ebf8eadd2c3d | |
| parent | 19ab7686ae42dcce1e0861bce4713c69a64eec45 (diff) | |
| download | emacs-d0c77a189423dbf648ca5ae9d831a5a2e04e6947.tar.gz emacs-d0c77a189423dbf648ca5ae9d831a5a2e04e6947.zip | |
Remove some assumptions about timestamp format
These changes remove some assumptions of Lisp code on timestamp
format. Although we’re not going to change the default format any
time soon, I went looking for code that was too intimate about
details of timestamp format and removed assumptions where this was
easy to do with current Emacs primitives.
* lisp/ido.el (ido-wash-history):
Fix test for zero timestamp.
* lisp/time.el (display-time-event-handler):
Use time-less-p rather than doing it by hand.
(display-time-update): Simplify by using float-time
instead of doing the equivalent by hand.
* lisp/url/url-auth.el (url-digest-auth-make-cnonce):
* test/lisp/calendar/parse-time-tests.el (parse-time-tests):
* test/lisp/emacs-lisp/timer-tests.el (timer-test-multiple-of-time):
* test/lisp/net/tramp-tests.el:
(tramp-test19-directory-files-and-attributes)
(tramp-test22-file-times, tramp-test23-visited-file-modtime):
Don’t assume detailed format of returned Lisp timestamps.
| -rw-r--r-- | lisp/ido.el | 4 | ||||
| -rw-r--r-- | lisp/time.el | 32 | ||||
| -rw-r--r-- | lisp/url/url-auth.el | 4 | ||||
| -rw-r--r-- | test/lisp/calendar/parse-time-tests.el | 42 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/timer-tests.el | 8 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 20 |
6 files changed, 57 insertions, 53 deletions
diff --git a/lisp/ido.el b/lisp/ido.el index 64d820333f4..7bf4a92b229 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -1518,9 +1518,7 @@ Removes badly formatted data and ignored directories." | |||
| 1518 | (consp time) | 1518 | (consp time) |
| 1519 | (cond | 1519 | (cond |
| 1520 | ((integerp (car time)) | 1520 | ((integerp (car time)) |
| 1521 | (and (/= (car time) 0) | 1521 | (and (not (zerop (float-time time))) |
| 1522 | (integerp (car (cdr time))) | ||
| 1523 | (/= (car (cdr time)) 0) | ||
| 1524 | (ido-may-cache-directory dir))) | 1522 | (ido-may-cache-directory dir))) |
| 1525 | ((eq (car time) 'ftp) | 1523 | ((eq (car time) 'ftp) |
| 1526 | (and (numberp (cdr time)) | 1524 | (and (numberp (cdr time)) |
diff --git a/lisp/time.el b/lisp/time.el index f8d933d48aa..bfecba9f9dd 100644 --- a/lisp/time.el +++ b/lisp/time.el | |||
| @@ -336,15 +336,10 @@ would give mode line times like `94/12/30 21:07:48 (UTC)'." | |||
| 336 | (next-time (timer-relative-time | 336 | (next-time (timer-relative-time |
| 337 | (list (aref timer 1) (aref timer 2) (aref timer 3)) | 337 | (list (aref timer 1) (aref timer 2) (aref timer 3)) |
| 338 | (* 5 (aref timer 4)) 0))) | 338 | (* 5 (aref timer 4)) 0))) |
| 339 | ;; If the activation time is far in the past, | 339 | ;; If the activation time is not in the future, |
| 340 | ;; skip executions until we reach a time in the future. | 340 | ;; skip executions until we reach a time in the future. |
| 341 | ;; This avoids a long pause if Emacs has been suspended for hours. | 341 | ;; This avoids a long pause if Emacs has been suspended for hours. |
| 342 | (or (> (nth 0 next-time) (nth 0 current)) | 342 | (or (time-less-p current next-time) |
| 343 | (and (= (nth 0 next-time) (nth 0 current)) | ||
| 344 | (> (nth 1 next-time) (nth 1 current))) | ||
| 345 | (and (= (nth 0 next-time) (nth 0 current)) | ||
| 346 | (= (nth 1 next-time) (nth 1 current)) | ||
| 347 | (> (nth 2 next-time) (nth 2 current))) | ||
| 348 | (progn | 343 | (progn |
| 349 | (timer-set-time timer (timer-next-integral-multiple-of-time | 344 | (timer-set-time timer (timer-next-integral-multiple-of-time |
| 350 | current display-time-interval) | 345 | current display-time-interval) |
| @@ -439,23 +434,16 @@ update which can wait for the next redisplay." | |||
| 439 | ((and (stringp mail-spool-file) | 434 | ((and (stringp mail-spool-file) |
| 440 | (or (null display-time-server-down-time) | 435 | (or (null display-time-server-down-time) |
| 441 | ;; If have been down for 20 min, try again. | 436 | ;; If have been down for 20 min, try again. |
| 442 | (> (- (nth 1 now) display-time-server-down-time) | 437 | (< 1200 (- (float-time now) |
| 443 | 1200) | 438 | display-time-server-down-time)))) |
| 444 | (and (< (nth 1 now) display-time-server-down-time) | 439 | (let ((start-time (float-time))) |
| 445 | (> (- (nth 1 now) | ||
| 446 | display-time-server-down-time) | ||
| 447 | -64336)))) | ||
| 448 | (let ((start-time (current-time))) | ||
| 449 | (prog1 | 440 | (prog1 |
| 450 | (display-time-file-nonempty-p mail-spool-file) | 441 | (display-time-file-nonempty-p mail-spool-file) |
| 451 | (if (> (- (nth 1 (current-time)) | 442 | ;; Record whether mail file is accessible. |
| 452 | (nth 1 start-time)) | 443 | (setq display-time-server-down-time |
| 453 | 20) | 444 | (let ((end-time (float-time))) |
| 454 | ;; Record that mail file is not accessible. | 445 | (and (< 20 (- end-time start-time)) |
| 455 | (setq display-time-server-down-time | 446 | end-time)))))))) |
| 456 | (nth 1 (current-time))) | ||
| 457 | ;; Record that mail file is accessible. | ||
| 458 | (setq display-time-server-down-time nil))))))) | ||
| 459 | (24-hours (substring time 11 13)) | 447 | (24-hours (substring time 11 13)) |
| 460 | (hour (string-to-number 24-hours)) | 448 | (hour (string-to-number 24-hours)) |
| 461 | (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) | 449 | (12-hours (int-to-string (1+ (% (+ hour 11) 12)))) |
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 67e701ecb16..401baece838 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el | |||
| @@ -192,7 +192,9 @@ key cache `url-digest-auth-storage'." | |||
| 192 | (defun url-digest-auth-make-cnonce () | 192 | (defun url-digest-auth-make-cnonce () |
| 193 | "Compute a new unique client nonce value." | 193 | "Compute a new unique client nonce value." |
| 194 | (base64-encode-string | 194 | (base64-encode-string |
| 195 | (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t)) | 195 | (apply #'format "%016x%08x%08x" (random) |
| 196 | (read (format-time-string "(%s %N)"))) | ||
| 197 | t)) | ||
| 196 | 198 | ||
| 197 | (defun url-digest-auth-nonce-count (_nonce) | 199 | (defun url-digest-auth-nonce-count (_nonce) |
| 198 | "The number requests sent to server with the given NONCE. | 200 | "The number requests sent to server with the given NONCE. |
diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 9689997f793..ca71ff71b7a 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el | |||
| @@ -45,20 +45,34 @@ | |||
| 45 | '(42 35 19 22 2 2016 1 nil -28800))) | 45 | '(42 35 19 22 2 2016 1 nil -28800))) |
| 46 | (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58 PDT") | 46 | (should (equal (parse-time-string "Friday, 21 Sep 2018 13:47:58 PDT") |
| 47 | '(58 47 13 21 9 2018 5 t -25200))) | 47 | '(58 47 13 21 9 2018 5 t -25200))) |
| 48 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0200") | 48 | (should (equal (format-time-string |
| 49 | '(13818 33666))) | 49 | "%Y-%m-%d %H:%M:%S" |
| 50 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-0230") | 50 | (parse-iso8601-time-string "1998-09-12T12:21:54-0200") t) |
| 51 | '(13818 35466))) | 51 | "1998-09-12 14:21:54")) |
| 52 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") | 52 | (should (equal (format-time-string |
| 53 | '(13818 33666))) | 53 | "%Y-%m-%d %H:%M:%S" |
| 54 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54-02") | 54 | (parse-iso8601-time-string "1998-09-12T12:21:54-0230") t) |
| 55 | '(13818 33666))) | 55 | "1998-09-12 14:51:54")) |
| 56 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+0230") | 56 | (should (equal (format-time-string |
| 57 | '(13818 17466))) | 57 | "%Y-%m-%d %H:%M:%S" |
| 58 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54+02") | 58 | (parse-iso8601-time-string "1998-09-12T12:21:54-02:00") t) |
| 59 | '(13818 19266))) | 59 | "1998-09-12 14:21:54")) |
| 60 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54Z") | 60 | (should (equal (format-time-string |
| 61 | '(13818 26466))) | 61 | "%Y-%m-%d %H:%M:%S" |
| 62 | (parse-iso8601-time-string "1998-09-12T12:21:54-02") t) | ||
| 63 | "1998-09-12 14:21:54")) | ||
| 64 | (should (equal (format-time-string | ||
| 65 | "%Y-%m-%d %H:%M:%S" | ||
| 66 | (parse-iso8601-time-string "1998-09-12T12:21:54+0230") t) | ||
| 67 | "1998-09-12 09:51:54")) | ||
| 68 | (should (equal (format-time-string | ||
| 69 | "%Y-%m-%d %H:%M:%S" | ||
| 70 | (parse-iso8601-time-string "1998-09-12T12:21:54+02") t) | ||
| 71 | "1998-09-12 10:21:54")) | ||
| 72 | (should (equal (format-time-string | ||
| 73 | "%Y-%m-%d %H:%M:%S" | ||
| 74 | (parse-iso8601-time-string "1998-09-12T12:21:54Z") t) | ||
| 75 | "1998-09-12 12:21:54")) | ||
| 62 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54") | 76 | (should (equal (parse-iso8601-time-string "1998-09-12T12:21:54") |
| 63 | (encode-time 54 21 12 12 9 1998)))) | 77 | (encode-time 54 21 12 12 9 1998)))) |
| 64 | 78 | ||
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index fa92c1b64aa..1d3ba757f63 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el | |||
| @@ -40,8 +40,10 @@ | |||
| 40 | (should (debug-timer-check)) t)) | 40 | (should (debug-timer-check)) t)) |
| 41 | 41 | ||
| 42 | (ert-deftest timer-test-multiple-of-time () | 42 | (ert-deftest timer-test-multiple-of-time () |
| 43 | (should (equal | 43 | (should (zerop |
| 44 | (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) | 44 | (float-time |
| 45 | (list (ash 1 (- 53 16)) 1 0 0)))) | 45 | (time-subtract |
| 46 | (timer-next-integral-multiple-of-time '(0 0 0 1) (1+ (ash 1 53))) | ||
| 47 | (list (ash 1 (- 53 16)) 1)))))) | ||
| 46 | 48 | ||
| 47 | ;;; timer-tests.el ends here | 49 | ;;; timer-tests.el ends here |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 55884f30a7e..79013558fdb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -2882,16 +2882,16 @@ This tests also `file-readable-p', `file-regular-p' and | |||
| 2882 | ;; able to return the date correctly. They say "don't know". | 2882 | ;; able to return the date correctly. They say "don't know". |
| 2883 | (dolist (elt attr) | 2883 | (dolist (elt attr) |
| 2884 | (unless | 2884 | (unless |
| 2885 | (equal | 2885 | (zerop |
| 2886 | (nth | 2886 | (float-time |
| 2887 | 5 (file-attributes (expand-file-name (car elt) tmp-name2))) | 2887 | (nth 5 (file-attributes |
| 2888 | '(0 0)) | 2888 | (expand-file-name (car elt) tmp-name2))))) |
| 2889 | (should | 2889 | (should |
| 2890 | (equal (file-attributes (expand-file-name (car elt) tmp-name2)) | 2890 | (equal (file-attributes (expand-file-name (car elt) tmp-name2)) |
| 2891 | (cdr elt))))) | 2891 | (cdr elt))))) |
| 2892 | (setq attr (directory-files-and-attributes tmp-name2 'full)) | 2892 | (setq attr (directory-files-and-attributes tmp-name2 'full)) |
| 2893 | (dolist (elt attr) | 2893 | (dolist (elt attr) |
| 2894 | (unless (equal (nth 5 (file-attributes (car elt))) '(0 0)) | 2894 | (unless (zerop (float-time (nth 5 (file-attributes (car elt))))) |
| 2895 | (should | 2895 | (should |
| 2896 | (equal (file-attributes (car elt)) (cdr elt))))) | 2896 | (equal (file-attributes (car elt)) (cdr elt))))) |
| 2897 | (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) | 2897 | (setq attr (directory-files-and-attributes tmp-name2 nil "^b")) |
| @@ -3215,14 +3215,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3215 | (write-region "foo" nil tmp-name1) | 3215 | (write-region "foo" nil tmp-name1) |
| 3216 | (should (file-exists-p tmp-name1)) | 3216 | (should (file-exists-p tmp-name1)) |
| 3217 | (should (consp (nth 5 (file-attributes tmp-name1)))) | 3217 | (should (consp (nth 5 (file-attributes tmp-name1)))) |
| 3218 | ;; '(0 0) means don't know, and will be replaced by | 3218 | ;; A zero timestamp means don't know, and will be replaced by |
| 3219 | ;; `current-time'. Therefore, we use '(0 1). We skip the | 3219 | ;; `current-time'. Therefore, use timestamp 1. Skip the |
| 3220 | ;; test, if the remote handler is not able to set the | 3220 | ;; test, if the remote handler is not able to set the |
| 3221 | ;; correct time. | 3221 | ;; correct time. |
| 3222 | (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) | 3222 | (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) |
| 3223 | ;; Dumb remote shells without perl(1) or stat(1) are not | 3223 | ;; Dumb remote shells without perl(1) or stat(1) are not |
| 3224 | ;; able to return the date correctly. They say "don't know". | 3224 | ;; able to return the date correctly. They say "don't know". |
| 3225 | (unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0)) | 3225 | (unless (zerop (float-time (nth 5 (file-attributes tmp-name1)))) |
| 3226 | (should | 3226 | (should |
| 3227 | (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) | 3227 | (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1))) |
| 3228 | (write-region "bla" nil tmp-name2) | 3228 | (write-region "bla" nil tmp-name2) |
| @@ -3250,9 +3250,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 3250 | (with-temp-buffer | 3250 | (with-temp-buffer |
| 3251 | (insert-file-contents tmp-name) | 3251 | (insert-file-contents tmp-name) |
| 3252 | (should (verify-visited-file-modtime)) | 3252 | (should (verify-visited-file-modtime)) |
| 3253 | (set-visited-file-modtime '(0 1)) | 3253 | (set-visited-file-modtime (seconds-to-time 1)) |
| 3254 | (should (verify-visited-file-modtime)) | 3254 | (should (verify-visited-file-modtime)) |
| 3255 | (should (equal (visited-file-modtime) '(0 1 0 0))))) | 3255 | (should (= 1 (float-time (visited-file-modtime)))))) |
| 3256 | 3256 | ||
| 3257 | ;; Cleanup. | 3257 | ;; Cleanup. |
| 3258 | (ignore-errors (delete-file tmp-name)))))) | 3258 | (ignore-errors (delete-file tmp-name)))))) |