[Emacs-diffs] emacs-26 3aee7be: Avoid unnecessary rounding errors in timestamps

[Paul Eggert]

branch: emacs-26
commit 3aee7be62eaf8caef6f2fab31bee79674b3abbb7
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Avoid unnecessary rounding errors in timestamps
    
    Avoid the rounding errors of float-time when it’s easy.  E.g.,
    replace (< (float-time a) (float-time b)) with (time-less-p a b).
    * lisp/desktop.el (desktop-save):
    * lisp/ecomplete.el (ecomplete-add-item):
    * lisp/epg.el (epg-wait-for-completion):
    * lisp/files.el (dir-locals-find-file, dir-locals-read-from-dir):
    * lisp/image-dired.el (image-dired-get-thumbnail-image)
    (image-dired-create-thumb-1):
    * lisp/info.el (info-insert-file-contents):
    * lisp/ls-lisp.el (ls-lisp-format-time):
    * lisp/net/ange-ftp.el (ange-ftp-file-newer-than-file-p)
    (ange-ftp-verify-visited-file-modtime):
    * lisp/net/rcirc.el (rcirc-ctcp-sender-PING):
    * lisp/textmodes/remember.el (remember-store-in-mailbox):
    * lisp/url/url-cookie.el (url-cookie-expired-p):
    Bypass float-time to avoid rounding errors.
    
    * lisp/files.el (dir-locals-find-file):
---
 lisp/desktop.el            |  3 ++-
 lisp/ecomplete.el          |  2 +-
 lisp/epg.el                |  5 ++---
 lisp/files.el              | 31 ++++++++++++++-----------------
 lisp/image-dired.el        | 15 +++++++--------
 lisp/info.el               |  2 +-
 lisp/ls-lisp.el            |  5 +++--
 lisp/net/ange-ftp.el       |  4 ++--
 lisp/net/rcirc.el          |  2 +-
 lisp/textmodes/remember.el |  2 +-
 lisp/url/url-cookie.el     |  2 +-
 11 files changed, 35 insertions(+), 38 deletions(-)

diff --git a/lisp/desktop.el b/lisp/desktop.el
index 73228ce..52cdbaf 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1046,7 +1046,8 @@ without further confirmation."
          (or (not new-modtime)         ; nothing to overwrite
              (equal desktop-file-modtime new-modtime)
              (yes-or-no-p (if desktop-file-modtime
-                              (if (> (float-time new-modtime) (float-time 
desktop-file-modtime))
+                              (if (time-less-p desktop-file-modtime
+                                               new-modtime)
                                   "Desktop file is more recent than the one 
loaded.  Save anyway? "
                                 "Desktop file isn't the one loaded.  Overwrite 
it? ")
                             "Current desktop was not loaded from a file.  
Overwrite this desktop file? "))
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index ed23d9f..014b4b2 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -55,7 +55,7 @@
 
 (defun ecomplete-add-item (type key text)
   (let ((elems (assq type ecomplete-database))
-       (now (string-to-number (format "%.0f" (float-time))))
+       (now (string-to-number (format-time-string "%s")))
        entry)
     (unless elems
       (push (setq elems (list type)) ecomplete-database))
diff --git a/lisp/epg.el b/lisp/epg.el
index 407b0f5..fee6ad7 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -757,9 +757,8 @@ callback data (if any)."
   ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
   (if (with-current-buffer (process-buffer (epg-context-process context))
        (and epg-agent-file
-            (> (float-time (or (nth 5 (file-attributes epg-agent-file))
-                               '(0 0 0 0)))
-               (float-time epg-agent-mtime))))
+            (time-less-p epg-agent-mtime
+                         (or (nth 5 (file-attributes epg-agent-file)) 0))))
       (redraw-frame))
   (epg-context-set-result-for
    context 'error
diff --git a/lisp/files.el b/lisp/files.el
index 211457a..9d46d5f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3947,11 +3947,12 @@ This function returns either:
                   ;; The entry MTIME should match the most recent
                   ;; MTIME among matching files.
                   (and cached-files
-                       (= (float-time (nth 2 dir-elt))
-                          (apply #'max (mapcar (lambda (f)
-                                                 (float-time
-                                                  (nth 5 (file-attributes f))))
-                                               cached-files))))))
+                      (equal (nth 2 dir-elt)
+                             (let ((latest 0))
+                               (dolist (f cached-files latest)
+                                 (let ((f-time (nth 5 (file-attributes f))))
+                                   (if (time-less-p latest f-time)
+                                       (setq latest f-time)))))))))
             ;; This cache entry is OK.
             dir-elt
           ;; This cache entry is invalid; clear it.
@@ -3973,10 +3974,15 @@ Return the new class name, which is a symbol named DIR."
   (let* ((class-name (intern dir))
          (files (dir-locals--all-files dir))
          (read-circle nil)
-         (success nil)
+        ;; If there was a problem, use the values we could get but
+        ;; don't let the cache prevent future reads.
+        (latest 0) (success 0)
          (variables))
     (with-demoted-errors "Error reading dir-locals: %S"
       (dolist (file files)
+       (let ((file-time (nth 5 (file-attributes file))))
+         (if (time-less-p latest file-time)
+           (setq latest file-time)))
         (with-temp-buffer
           (insert-file-contents file)
           (condition-case-unless-debug nil
@@ -3985,18 +3991,9 @@ Return the new class name, which is a symbol named DIR."
                                     variables
                                     (read (current-buffer))))
             (end-of-file nil))))
-      (setq success t))
+      (setq success latest))
     (dir-locals-set-class-variables class-name variables)
-    (dir-locals-set-directory-class
-     dir class-name
-     (seconds-to-time
-      (if success
-          (apply #'max (mapcar (lambda (file)
-                                 (float-time (nth 5 (file-attributes file))))
-                               files))
-        ;; If there was a problem, use the values we could get but
-        ;; don't let the cache prevent future reads.
-        0)))
+    (dir-locals-set-directory-class dir class-name success)
     class-name))
 
 (define-obsolete-function-alias 'dir-locals-read-from-file
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 30ecc2b..175d9df 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -582,10 +582,11 @@ Create the thumbnails directory if it does not exist."
   "Return the image descriptor for a thumbnail of image file FILE."
   (unless (string-match (image-file-name-regexp) file)
     (error "%s is not a valid image file" file))
-  (let ((thumb-file (image-dired-thumb-name file)))
-    (unless (and (file-exists-p thumb-file)
-                (<= (float-time (nth 5 (file-attributes file)))
-                    (float-time (nth 5 (file-attributes thumb-file)))))
+  (let* ((thumb-file (image-dired-thumb-name file))
+        (thumb-attr (file-attributes thumb-file)))
+    (when (or (not thumb-attr)
+             (time-less-p (nth 5 thumb-attr)
+                          (nth 5 (file-attributes file))))
       (image-dired-create-thumb file thumb-file))
     (create-image thumb-file)
 ;;     (list 'image :type 'jpeg
@@ -748,10 +749,8 @@ Increase at own risk.")
    'image-dired-cmd-create-thumbnail-program)
   (let* ((width (int-to-string (image-dired-thumb-size 'width)))
          (height (int-to-string (image-dired-thumb-size 'height)))
-         (modif-time
-          (format "%.0f"
-                  (ffloor (float-time
-                           (nth 5 (file-attributes original-file))))))
+        (modif-time (format-time-string
+                     "%s" (nth 5 (file-attributes original-file))))
          (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
                                                        thumbnail-file))
          (spec
diff --git a/lisp/info.el b/lisp/info.el
index 6f87adb..e2f9953 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -649,7 +649,7 @@ Do the right thing if the file has been compressed or 
zipped."
           (attribs-new (and (stringp fullname) (file-attributes fullname)))
           (modtime-new (and attribs-new (nth 5 attribs-new))))
       (when (and modtime-old modtime-new
-                (> (float-time modtime-new) (float-time modtime-old)))
+                (time-less-p modtime-old modtime-new))
        (setq Info-index-nodes (remove (assoc (or Info-current-file filename)
                                              Info-index-nodes)
                                       Info-index-nodes))
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 280e7f4..66dddbb 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -861,7 +861,7 @@ Use the same method as ls to decide whether to show 
time-of-day or year,
 depending on distance between file date and the current time.
 All ls time options, namely c, t and u, are handled."
   (let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
-        (diff (- (float-time time) (float-time)))
+        (diff (time-subtract time nil))
         ;; Consider a time to be recent if it is within the past six
         ;; months.  A Gregorian year has 365.2425 * 24 * 60 * 60 ==
         ;; 31556952 seconds on the average, and half of that is 15778476.
@@ -878,7 +878,8 @@ All ls time options, namely c, t and u, are handled."
          (if (member locale '("C" "POSIX"))
              (setq locale nil))
          (format-time-string
-          (if (and (<= past-cutoff diff) (<= diff 0))
+          (if (and (not (time-less-p diff past-cutoff))
+                   (not (time-less-p 0 diff)))
               (if (and locale (not ls-lisp-use-localized-time-format))
                   "%m-%d %H:%M"
                 (nth 0 ls-lisp-format-time-list))
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 73f62c8..cf65e10 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3479,7 +3479,7 @@ system TYPE.")
               (f2-mt (nth 5 (file-attributes f2))))
           (cond ((null f1-mt) nil)
                 ((null f2-mt) t)
-                (t (> (float-time f1-mt) (float-time f2-mt)))))
+               (t (time-less-p f2-mt f1-mt))))
       (ange-ftp-real-file-newer-than-file-p f1 f2))))
 
 (defun ange-ftp-file-writable-p (file)
@@ -3561,7 +3561,7 @@ Value is (0 0) if the modification time cannot be 
determined."
         (let ((file-mdtm (ange-ftp-file-modtime name))
               (buf-mdtm (with-current-buffer buf (visited-file-modtime))))
           (or (zerop (car file-mdtm))
-              (<= (float-time file-mdtm) (float-time buf-mdtm))))
+             (not (time-less-p buf-mdtm file-mdtm))))
       (ange-ftp-real-verify-visited-file-modtime buf))))
 
 (defun ange-ftp-file-size (file &optional ascii-mode)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 5c785da..3b6b6c8 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2333,7 +2333,7 @@ With a prefix arg, prompt for new topic."
 
 (defun rcirc-ctcp-sender-PING (process target _request)
   "Send a CTCP PING message to TARGET."
-  (let ((timestamp (format "%.0f" (float-time))))
+  (let ((timestamp (format-time-string "%s")))
     (rcirc-send-ctcp process target "PING" timestamp)))
 
 (defun rcirc-cmd-me (args &optional process target)
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index b20ee8f..730eaec 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -349,7 +349,7 @@ In which case `remember-mailbox' should be the name of the 
mailbox.
 Each piece of pseudo-mail created will have an `X-Todo-Priority'
 field, for the purpose of appropriate splitting."
   (let ((who (read-string "Who is this item related to? "))
-        (moment (format "%.0f" (float-time)))
+        (moment (format-time-string "%s"))
         (desc (remember-buffer-desc))
         (text (buffer-string)))
     (with-temp-buffer
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 453d4fe..28dfced 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -161,7 +161,7 @@ telling Microsoft that."
   (let ((exp (url-cookie-expires cookie)))
     (and (> (length exp) 0)
         (condition-case ()
-            (> (float-time) (float-time (date-to-time exp)))
+            (time-less-p nil (date-to-time exp))
           (error nil)))))
 
 (defun url-cookie-retrieve (host &optional localpart secure)