From 3aee7be62eaf8caef6f2fab31bee79674b3abbb7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 22 Oct 2017 01:04:36 -0700 Subject: [PATCH] Avoid unnecessary rounding errors in timestamps MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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 73228ce040b..52cdbaf849d 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 ed23d9f5cc2..014b4b21122 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 407b0f5d5d3..fee6ad75119 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 211457ac7d7..9d46d5f85aa 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 30ecc2befc7..175d9df5e8c 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 6f87adb04e8..e2f9953f7c7 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 280e7f4bc3e..66dddbbc17b 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 73f62c85519..cf65e10e510 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 5c785daa8a2..3b6b6c8c807 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 b20ee8fee84..730eaecc71c 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 453d4fe5b6f..28dfcedeaca 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) -- 2.39.2