branch: elpa/datetime
commit c51eeb6df180f6c7d1676d1c0af78255bb0fdf95
Author: Paul Pogonyshev <pogonys...@gmail.com>
Commit: Paul Pogonyshev <pogonys...@gmail.com>
Fix parsing (most likely also formatting) of future timestamps in certain
timezones.
---
datetime.el | 64 +++++++++++++++++++++++++++++++++--------------------------
test/parse.el | 8 ++++++++
2 files changed, 44 insertions(+), 28 deletions(-)
diff --git a/datetime.el b/datetime.el
index 5e1f2690ab..202cf4803f 100644
--- a/datetime.el
+++ b/datetime.el
@@ -757,34 +757,42 @@ to this function.
(when (>= year-offset num-years)
(setf (cadr timezone-data) (setq all-year-transitions (vconcat
all-year-transitions (make-vector (max (1+ (- year-offset num-years)) (/
num-years 2) 10) nil)))))
(let ((year (+ (nth 2 timezone-data) year-offset))
- (year-base (+ (nth 0 timezone-data) (* year-offset
datetime--average-seconds-in-year))))
- (dolist (rule (nth 3 timezone-data))
- (let* ((month (plist-get rule :month))
- (day-of-month (plist-get rule :day-of-month))
- (effective-month (if (< day-of-month 0) month (1- month)))
- (day-of-week (plist-get rule :day-of-week))
- (year-day (+ (aref
datetime--gregorian-cumulative-month-days effective-month)
- (if (and (>= effective-month 2)
(datetime--gregorian-leap-year-p year)) 1 0)
- day-of-month -1))
- (offset-before (plist-get rule :before)))
- (unless transitions
- (push offset-before transitions))
- (when day-of-week
- (let ((current-weekday (% (+ year-day (aref
datetime--gregorian-first-day-of-year (mod year 400))) 7)))
- (setq year-day (if (< day-of-month 0) (- year-day (mod (-
day-of-week current-weekday) 7)) (+ year-day (mod (- day-of-week
current-weekday) 7))))))
- (when (plist-get rule :end-of-day)
- (setq year-day (1+ year-day)))
- (push (round (- (+ (datetime--start-of-day year year-day) (plist-get
rule :time))
- (pcase (plist-get rule :time-definition)
- (`utc 0)
- (`standard (plist-get rule :standard-offset))
- (`wall offset-before)
- (type (error "Unhandled time definition type
`%s'" type)))
- year-base))
- transitions)
- (let ((after (plist-get rule :after)))
- ;; Mark transitions to DST by making offset a float.
- (push (if (plist-get rule :dst) (float after) after)
transitions)))))
+ (year-base (+ (nth 0 timezone-data) (* year-offset
datetime--average-seconds-in-year)))
+ (rules (nth 3 timezone-data)))
+ (if rules
+ (dolist (rule rules)
+ (let* ((month (plist-get rule :month))
+ (day-of-month (plist-get rule :day-of-month))
+ (effective-month (if (< day-of-month 0) month (1- month)))
+ (day-of-week (plist-get rule :day-of-week))
+ (year-day (+ (aref
datetime--gregorian-cumulative-month-days effective-month)
+ (if (and (>= effective-month 2)
(datetime--gregorian-leap-year-p year)) 1 0)
+ day-of-month -1))
+ (offset-before (plist-get rule :before)))
+ (unless transitions
+ (push offset-before transitions))
+ (when day-of-week
+ (let ((current-weekday (% (+ year-day (aref
datetime--gregorian-first-day-of-year (mod year 400))) 7)))
+ (setq year-day (if (< day-of-month 0) (- year-day (mod (-
day-of-week current-weekday) 7)) (+ year-day (mod (- day-of-week
current-weekday) 7))))))
+ (when (plist-get rule :end-of-day)
+ (setq year-day (1+ year-day)))
+ (push (round (- (+ (datetime--start-of-day year year-day)
(plist-get rule :time))
+ (pcase (plist-get rule :time-definition)
+ (`utc 0)
+ (`standard (plist-get rule :standard-offset))
+ (`wall offset-before)
+ (type (error "Unhandled time definition
type `%s'" type)))
+ year-base))
+ transitions)
+ (let ((after (plist-get rule :after)))
+ ;; Mark transitions to DST by making offset a float.
+ (push (if (plist-get rule :dst) (float after) after)
transitions))))
+ ;; No transition rules. Take the offset after the last historical
transition.
+ (let ((k (length all-year-transitions)))
+ (while (null transitions)
+ (let ((historic-transitions (aref all-year-transitions (setf k (1-
k)))))
+ (when historic-transitions
+ (setf transitions `(,(car (last historic-transitions))))))))))
(aset all-year-transitions year-offset (nreverse transitions))))
diff --git a/test/parse.el b/test/parse.el
index 4e6166f779..9a0d589b6a 100644
--- a/test/parse.el
+++ b/test/parse.el
@@ -138,3 +138,11 @@
(datetime--test-set-up-parser 'UTC 'en "dd 'of' MMMM '(month' M')'"
(datetime--test-parser "12 of March (month 3)")
(should-error (funcall datetime--test-parser "12 of March (month 1)")
:type 'datetime-invalid-string)))
+
+
+(ert-deftest datetime-parsing-future-timestamp-1 ()
+ ;; Real failure: would cause an exception on certain timezones
+ ;; without transition rules (e.g. `Africa/Algiers').
+ (dolist (timezone (datetime-list-timezones))
+ (datetime--test-set-up-parser timezone 'en "yyyy-MM-dd HH:mm:ss"
+ (datetime--test-parser '("2100-01-01 00:00:00")))))
