[local-time-devel] [PATCH] Make local-time operate correctly with timezones

Antoni Piotr Oleksicki apoleksicki at o2.pl
Mon Jul 27 18:56:53 UTC 2009


Hi Daniel

We have (together with Maciej Katafiasz) been working on making
local-time work correctly with regard to timezones. The changes are
quite extensive, but it seems to give correct results now in about
every operation we could think of. That includes overflowing into or
from DST. To achieve that we had to add timezone/offset arguments to
several functions. The biggest changes are in the ADJUST-TIMESTAMP
helper functions (%OFFSET-TIMESTAMP-PATY and %SET-TIMESTAMP-PART).
Additionally we corrected the rather schizophrenic nature of
WITH-DECODED-TIMESTAMP, which took timezone but not offset, unlike
everything else.

The changes are API compatible, so there shouldn't be any breakage to
existing code. The semantics did change, but as far as we can tell the
old semantics were buggy, so it's unlikely that any client would want
them this way. Note that the changes include the patch from Thomas
Munro to ENCODE-TIMESTAMP, together with the DST ambiguity. That
ambiguity carries over to ADJUST-TIMESTAMP when used with symbolic
arguments (month and year) but not the precise ones i.e. nsec, sec,
day, hour, minute. If you don't like the ambiguity and have a good
idea how to solve it, we'll be glad to implement that. But personally
we think it's fine simply to document that explicitly.

Below is a simple test suite that fails in the upstream version but
works fine with our changes. It's by no means exhaustive, but it does
touch most of the interesting cases.

===============================================================
 (in-package :local-time)

(reread-timezone-repository)
(defvar *my-timezone* (find-timezone-by-location-name "Europe/Copenhagen"))

(let ((*default-timezone* *my-timezone*))
 (defvar *timestamp1* (encode-timestamp 0 0 0 12 15 6 2009))
 (defvar *timestamp2* (encode-timestamp 0 0 0  2 25 6 2009)))

;;; Version after changes
(defun check-timestamp (timestamp nsec sec minute hour day month year)
  (with-decoded-timestamp (:nsec nsec* :sec sec* :minute minute* :hour hour*
                           :day day* :month month* :year year*
:timezone *my-timezone*)
      timestamp
    (unless (and (= nsec nsec*) (= sec sec*) (= minute minute*) (= hour hour*)
                 (= day day*) (= month month*) (= year year*))
      (cerror "Continue with testing" "Got timestamp
@~d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0d.~4,'0d, expected
@~d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0d.~4,'0d instead"
              year* month* day* hour* minute* sec* nsec* year month
day hour minute sec nsec))))

(defun minimize1 ()
  (check-timestamp
   (timestamp-minimize-part *timestamp1* :day)
   0 0 0 0 1 6 2009))

(defun minimize2 ()
  (check-timestamp
   (timestamp-minimize-part *timestamp1* :month)
   0 0 0 0 1 1 2009))

(defun adjust1 ()
  (check-timestamp
   (adjust-timestamp *timestamp1* (set :month 1))
   0 0 0 12 15 1 2009))

(defun adjust2 ()
  (check-timestamp
   (adjust-timestamp *timestamp1* (offset :month 5))
   0 0 0 12 15 11 2009))

(defun adjust3 ()
  (check-timestamp
   (adjust-timestamp *timestamp2* (offset :month 4))
   0 0 0 2 25 10 2009))

(defun adjust4 ()
  (check-timestamp
   (adjust-timestamp *timestamp2* (offset :month 4) (offset :day 1))
   0 0 0 2 26 10 2009))

(defun adjust5 ()
  (check-timestamp
   (adjust-timestamp *timestamp1* (set :month 11))
   0 0 0 12 15 11 2009))

(defun adjust6 ()
  (check-timestamp
   (adjust-timestamp *timestamp2* (set :month 10))
   0 0 0 2 25 10 2009))

(defun adjust7 ()
  (check-timestamp
   (adjust-timestamp *timestamp2* (set :month 10) (set :day-of-month 26))
   0 0 0 2 26 10 2009))

(defun test ()
  (let ((*default-timezone* *my-timezone*))
    (adjust1)
    (adjust2)
    (adjust3)
    (adjust4)
    (adjust5)
    (adjust6)
    (adjust7)
    (minimize1)
    (minimize2)))

============================================================

Additionally the bundle includes a trivial patch to improve
readcase-friendliness  by using symbols instead of strings in a few
places. We hope you'll like the changes. If you have  any comments,
we'll be glad  to implement them. Also, as you've mentioned you're no
longer actively working on the project and on the other hand we'll be
making more changes in the future and we'd like to avoid maintaining
an unnecessary fork, we'd happy to take over the maintainership if
you're so inclined.

Cheers
Antoni and Maciej

============================================================

 Fri Jul 24 18:49:20 CEST 2009  Maciej Katafiasz <mathrick at gmail.com>
  * Use symbols instead of strings where possible.

Mon Jul 27 19:40:13 CEST 2009  Maciej Katafiasz <mathrick at gmail.com>
  * Make ENCODE-TIMESTAMP accept timezones instead of fixed offsets.

Mon Jul 27 19:54:00 CEST 2009  Maciej Katafiasz <mathrick at gmail.com>
  * Make WITH-DECODED-TIMESTAMP and related take timezone/offset arguments.

Mon Jul 27 20:01:03 CEST 2009  Maciej Katafiasz <mathrick at gmail.com>
  * Make timestamp manipulation functions take and respect timezone arguments.

New patches:

[Use symbols instead of strings where possible.
Maciej Katafiasz <mathrick at gmail.com>**20090724164920] {
hunk ./src/local-time.lisp 656
       (assert (or (%list-length= 3 change)
                   (and (%list-length= 4 change)
                        (symbolp (third change))
-                       (or (string= (third change) "TO")
-                           (string= (third change) "BY"))))
+                       (or (string= (third change) :to)
+                           (string= (third change) :by))))
               nil "Syntax error in expression ~S" change)
       (let ((operation (first change))
             (part (second change))
hunk ./src/local-time.lisp 665
                        (third change)
                        (fourth change))))
         (cond
-          ((string= operation "SET")
+          ((string= operation :set)
            (funcall visitor `(%set-timestamp-part ,timestamp ,part ,value)))
hunk ./src/local-time.lisp 667
-          ((string= operation "OFFSET")
+          ((string= operation :offset)
            (funcall visitor `(%offset-timestamp-part ,timestamp ,part ,value)))
           (t (error "Unexpected operation ~S" operation))))))

}
[Make ENCODE-TIMESTAMP accept timezones instead of fixed offsets.
Maciej Katafiasz <mathrick at gmail.com>**20090727174013
 Ignore-this: f6420e93d194396afb221821e1312652
] {
hunk ./src/local-time.lisp 856
        (<= 1 day (days-in-month month year))
        (/= year 0)))

-(defun encode-timestamp-into-values (nsec sec minute hour day month
year &key (offset (%get-default-offset)))
-  "Returns (VALUES NSEC SEC DAY ZONE) ready to be used for
instantiating a new timestamp object.  If the specified time is
invalid, the condition INVALID-TIME-SPECIFICATION is raised."
-  (declare (type integer nsec sec minute hour day month year offset))
+(defun encode-timestamp-into-values (nsec sec minute hour day month year
+                                     &key (timezone *default-timezone*) offset)
+  "Returns (VALUES NSEC SEC DAY ZONE) ready to be used for
+instantiating a new timestamp object.  If the specified time is
+invalid, the condition INVALID-TIME-SPECIFICATION is raised."
+  ;; If the user provided an explicit offset, we use that.  Otherwise,
+  ;; we try converting the local time to a timestamp using each available
+  ;; subtimezone, until we find one where the offset matches the offset that
+  ;; applies at that time (according to the transition table).
+  ;;
+  ;; Consequence for ambiguous cases:
+  ;; Whichever subtimezone is listed first in the tzinfo database will be
+  ;; the one that we pick to resolve ambiguous local time representations.
+
+  (declare (type integer nsec sec minute hour day month year)
+           (type (or integer null) offset))
   (unless (valid-timestamp-p nsec sec minute hour day month year)
     (error 'invalid-time-specification))
hunk ./src/local-time.lisp 874
-  (let* ((0-based-rotated-month (if (>= month 3)
-                                    (- month 3)
-                                    (+ month 9)))
-         (internal-year (if (< month 3)
-                            (- year 2001)
-                            (- year 2000)))
-         (years-as-days (years-to-days internal-year))
-         (sec (+ (* hour +seconds-per-hour+)
-                 (* minute +seconds-per-minute+)
-                 sec))
-         (days-from-zero-point (+ years-as-days
-                                  (aref
+rotated-month-offsets-without-leap-day+ 0-based-rotated-month)
-                                  (1- day))))
-    (multiple-value-bind (utc-sec utc-day)
-        (%adjust-to-offset sec days-from-zero-point (- offset))
-      (values nsec utc-sec utc-day))))
+  (if offset
+      (let* ((0-based-rotated-month (if (>= month 3)
+                                        (- month 3)
+                                        (+ month 9)))
+             (internal-year (if (< month 3)
+                                (- year 2001)
+                                (- year 2000)))
+             (years-as-days (years-to-days internal-year))
+             (sec (+ (* hour +seconds-per-hour+)
+                     (* minute +seconds-per-minute+)
+                     sec))
+             (days-from-zero-point (+ years-as-days
+                                      (aref
+rotated-month-offsets-without-leap-day+ 0-based-rotated-month)
+                                      (1- day))))
+        (multiple-value-bind (utc-sec utc-day)
+            (%adjust-to-offset sec days-from-zero-point (- offset))
+          (values nsec utc-sec utc-day)))
+      ;; find the first potential offset that is valid at the represented time
+      (loop
+         for subtimezone across (timezone-subzones timezone) do
+           (let ((timestamp (encode-timestamp nsec sec minute hour
day month year
+                                          :offset (subzone-offset
subtimezone))))
+             (if (= (timestamp-subtimezone timestamp timezone)
+                    (subzone-offset subtimezone))
+                 (return  (values (nsec-of timestamp)
+                                  (sec-of timestamp)
+                                  (day-of timestamp) ))))
+         finally
+           (error "The requested local time is not valid"))))

hunk ./src/local-time.lisp 904
-(defun encode-timestamp (nsec sec minute hour day month year &key
(offset (%get-default-offset)) into)
-  "Return a new TIMESTAMP instance corresponding to the specified
time elements."
-  (declare (type integer nsec sec minute hour day month year offset))
+(defun encode-timestamp (nsec sec minute hour day month year
+                         &key (timezone *default-timezone*) offset into)
+  "Return a new TIMESTAMP instance corresponding to the specified time
+elements."
+  (declare (type integer nsec sec minute hour day month year))
   (multiple-value-bind (nsec sec day)
hunk ./src/local-time.lisp 910
-      (encode-timestamp-into-values nsec sec minute hour day month
year :offset offset)
+      (encode-timestamp-into-values nsec sec minute hour day month year
+                                    :timezone timezone :offset offset)
     (if into
         (progn
           (setf (nsec-of into) nsec)
}
[Make WITH-DECODED-TIMESTAMP and related take timezone/offset arguments.
Maciej Katafiasz <mathrick at gmail.com>**20090727175400
 Ignore-this: 296084f8d9179fe257c69118b7123309
] {
hunk ./src/local-time.lisp 166
                              (integer -43199 43199)
                              boolean
                              string)) timestamp-subzone)
-         (ftype (function (timestamp &key (:timezone timezone))
+         (ftype (function (timestamp &key (:timezone timezone)
(:offset (or null integer)))
                           (values (integer 0 999999999)
                                   (integer 0 59)
                                   (integer 0 59)
hunk ./src/local-time.lisp 416

 (defparameter +gmt-zone+ (%make-simple-timezone "Greenwich Mean Time" "GMT" 0))

+(defparameter +none-zone+ (%make-simple-timezone "Explicit Offset
Given" "NONE" 0))
+
 (defmacro define-timezone (zone-name zone-file &key (load nil))
   "Define zone-name (a symbol or a string) as a new timezone,
lazy-loaded from zone-file (a pathname designator relative to the
zoneinfo directory on this system.  If load is true, load
immediately."
   (declare (type (or string symbol) zone-name))
hunk ./src/local-time.lisp 535
              (decf new-sec +seconds-per-day+)))
       (values new-sec new-day))))

-(defun %adjust-to-timezone (source timezone)
+(defun %adjust-to-timezone (source timezone &optional offset)
   (%adjust-to-offset (sec-of source)
                      (day-of source)
hunk ./src/local-time.lisp 538
-                     (timestamp-subtimezone source timezone)))
+                     (or offset
+                         (timestamp-subtimezone source timezone))))

 (defun timestamp-minimize-part (timestamp part &key
                                 (offset (%get-default-offset))
hunk ./src/local-time.lisp 589
                           :offset offset
                           :into into)))))

-(defmacro with-decoded-timestamp ((&key nsec sec minute hour day
month year day-of-week daylight-p timezone)
+(defmacro with-decoded-timestamp ((&key nsec sec minute hour day
month year day-of-week daylight-p timezone offset)
                                    timestamp &body forms)
   "This macro binds variables to the decoded elements of TIMESTAMP.
The TIMEZONE argument is used for decoding the timestamp, and is not
bound by the macro. The value of DAY-OF-WEEK starts from 0 which means
Sunday."
   (let ((ignores)
hunk ./src/local-time.lisp 618
       (declare-fixnum-type sec minute hour day month year)
       (initialize nsec sec minute hour day month year day-of-week daylight-p))
     `(multiple-value-bind (, at variables)
-         (decode-timestamp ,timestamp :timezone ,(or timezone
'*default-timezone*))
+         (decode-timestamp ,timestamp :timezone ,(or timezone
'*default-timezone*) :offset ,offset)
        (declare (ignore , at ignores) , at types)
        , at forms)))

hunk ./src/local-time.lisp 841
                     :sec sec
                     :day day)))

-(defun timestamp-day-of-week (timestamp &key (timezone *default-timezone*))
-  (mod (+ 3 (nth-value 1 (%adjust-to-timezone timestamp timezone))) 7))
+(defun timestamp-day-of-week (timestamp &key (timezone
*default-timezone*) offset)
+  (mod (+ 3 (nth-value 1 (%adjust-to-timezone timestamp timezone offset))) 7))

 ;; TODO read
 ;; http://java.sun.com/j2se/1.4.2/docs/api/java/util/GregorianCalendar.html
hunk ./src/local-time.lisp 1138
        minutes
        seconds))))

-(defun decode-timestamp (timestamp &key (timezone *default-timezone*))
+(defun decode-timestamp (timestamp &key (timezone *default-timezone*) offset)
   "Returns the decoded time as multiple values: nsec, ss, mm, hh,
day, month, year, day-of-week"
   (declare (type timestamp timestamp))
hunk ./src/local-time.lisp 1141
-  (multiple-value-bind (offset daylight-p abbreviation)
+  (when offset
+    (setf timezone (the timezone +none-zone+)))
+  (multiple-value-bind (offset* daylight-p abbreviation)
       (timestamp-subtimezone timestamp timezone)
       (multiple-value-bind (adjusted-secs adjusted-days)
hunk ./src/local-time.lisp 1146
-          (%adjust-to-timezone timestamp timezone)
+          (%adjust-to-timezone timestamp timezone offset)
         (multiple-value-bind (hours minutes seconds)
             (%timestamp-decode-time adjusted-secs)
           (multiple-value-bind (year month day)
hunk ./src/local-time.lisp 1155
              (nsec-of timestamp)
              seconds minutes hours
              day month year
-             (timestamp-day-of-week timestamp :timezone timezone)
+             (timestamp-day-of-week timestamp :timezone timezone
:offset offset)
              daylight-p
hunk ./src/local-time.lisp 1157
-             offset
+             (or offset offset*)
              abbreviation))))))

 (defun timestamp-year (timestamp &key (timezone *default-timezone*))
}
[Make timestamp manipulation functions take and respect timezone arguments.
Maciej Katafiasz <mathrick at gmail.com>**20090727180103
 Ignore-this: 79214728e4966f44d8d4587bd850c53b
] {
hunk ./src/local-time.lisp 542
                          (timestamp-subtimezone source timezone))))

 (defun timestamp-minimize-part (timestamp part &key
-                                (offset (%get-default-offset))
+                                offset
                                 (timezone *default-timezone*)
                                 into)
   (let* ((timestamp-parts '(:nsec :sec :min :hour :day :month))
hunk ./src/local-time.lisp 562
                         (if (> part-count 4) 1 month)
                         year
                         :offset offset
+                        :timezone timezone
                         :into into))))


hunk ./src/local-time.lisp 567
 (defun timestamp-maximize-part (timestamp part &key
-                                (offset (%get-default-offset))
+                                offset
                                 (timezone *default-timezone*)
                                 into)
   (let* ((timestamp-parts '(:nsec :sec :min :hour :day :month))
hunk ./src/local-time.lisp 588
                           month
                           year
                           :offset offset
+                          :timezone timezone
                           :into into)))))

 (defmacro with-decoded-timestamp ((&key nsec sec minute hour day
month year day-of-week daylight-p timezone offset)
hunk ./src/local-time.lisp 657
       (and c (endp (cdr c)))))

   (defun %expand-adjust-timestamp-changes (timestamp changes visitor)
-    (dolist (change changes)
-      (assert (or (%list-length= 3 change)
-                  (and (%list-length= 4 change)
-                       (symbolp (third change))
-                       (or (string= (third change) :to)
-                           (string= (third change) :by))))
-              nil "Syntax error in expression ~S" change)
-      (let ((operation (first change))
-            (part (second change))
-            (value (if (%list-length= 3 change)
-                       (third change)
-                       (fourth change))))
-        (cond
-          ((string= operation :set)
-           (funcall visitor `(%set-timestamp-part ,timestamp ,part ,value)))
-          ((string= operation :offset)
-           (funcall visitor `(%offset-timestamp-part ,timestamp ,part ,value)))
-          (t (error "Unexpected operation ~S" operation))))))
+    (loop for change in changes
+       with params = ()
+       with functions = ()
+       do
+         (progn
+           (assert (or
+                    (%list-length= 3 change)
+                    (and (%list-length= 2 change)
+                         (symbolp (first change))
+                         (or (string= (first change) :timezone)
+                             (string= (first change) :utc-offset)))
+                    (and (%list-length= 4 change)
+                         (symbolp (third change))
+                         (or (string= (third change) :to)
+                             (string= (third change) :by))))
+                   nil "Syntax error in expression ~S" change)
+           (let ((operation (first change))
+                 (part (second change))
+                 (value (if (%list-length= 3 change)
+                            (third change)
+                            (fourth change))))
+             (cond
+               ((string= operation :set)
+                (push `(%set-timestamp-part ,part ,value) functions))
+               ((string= operation :offset)
+                (push `(%offset-timestamp-part ,part ,value) functions))
+               ((or (string= operation :utc-offset)
+                    (string= operation :timezone))
+                (push (second change) params)
+                (push operation params))
+               (t (error "Unexpected operation ~S" operation)))))
+         finally
+         (loop for (function part value) in functions
+              do
+              (funcall visitor `(,function ,timestamp ,part ,value
, at params)))))

   (defun %expand-adjust-timestamp (timestamp changes &key functional)
     (let* ((old (gensym "OLD"))
hunk ./src/local-time.lisp 725
 (defmacro adjust-timestamp! (timestamp &body changes)
   (%expand-adjust-timestamp timestamp changes :functional nil))

-(defun %set-timestamp-part (time part new-value)
+(defun %set-timestamp-part (time part new-value &key (timezone
*default-timezone*) utc-offset)
   ;; TODO think about error signalling. when, how to disable if it
makes sense, ...
   (case part
     ((:nsec :sec-of-day :day)
hunk ./src/local-time.lisp 739
        (values nsec sec day)))
     (otherwise
      (with-decoded-timestamp (:nsec nsec :sec sec :minute minute :hour hour
-                              :day day :month month :year year
:timezone +utc-zone+)
+                              :day day :month month :year year
:timezone timezone :offset utc-offset)
          time
        (ecase part
          (:sec (setf sec new-value))
hunk ./src/local-time.lisp 750
                  (setf day (%fix-overflow-in-days day month year)))
          (:year (setf year new-value)
                 (setf day (%fix-overflow-in-days day month year))))
-       (encode-timestamp-into-values nsec sec minute hour day month
year :offset 0)))))
+       (encode-timestamp-into-values nsec sec minute hour day month
year :timezone timezone :offset utc-offset)))))

hunk ./src/local-time.lisp 752
-(defun %offset-timestamp-part (time part offset)
-  "Returns a time adjusted by the specified OFFSET. Takes care of
different kinds of overflows. The setting :day-of-week is possible
using a keyword symbol name of a week-day (see
+DAY-NAMES-AS-KEYWORDS+) as value. In that case point the result to
the previous day given by OFFSET."
+(defun %offset-timestamp-part (time part offset &key (timezone
*default-timezone*) utc-offset)
+  "Returns a time adjusted by the specified OFFSET. Takes care of
+different kinds of overflows. The setting :day-of-week is possible
+using a keyword symbol name of a week-day (see
++DAY-NAMES-AS-KEYWORDS+) as value. In that case point the result to
+the previous day given by OFFSET."
   (labels ((direct-adjust (part offset nsec sec day)
              (cond ((eq part :day-of-week)
hunk ./src/local-time.lisp 760
-                    (with-decoded-timestamp (:day-of-week day-of-week
:timezone +utc-zone+)
+                    (with-decoded-timestamp (:day-of-week day-of-week
+                                             :nsec nsec :sec sec
:minute minute :hour hour
+                                             :day day :month month :year year
+                                             :timezone timezone)
                         time
                       (let ((position (position offset
+day-names-as-keywords+ :test #'eq)))
                         (assert position (position) "~S is not a
valid day name" offset)
hunk ./src/local-time.lisp 771
                                                 7
                                                 day-of-week))
                                          position)))
-                          (values nsec sec (+ day offset))))))
+                          (incf day offset)
+                          (when (< day 1)
+                            (let (days-in-month)
+                              (decf month)
+                              (when (< month 1)
+                                (setf month 12)
+                                (decf year))
+                              (setf days-in-month (days-in-month month year)
+                                    day (+ days-in-month day)))) ;;
day here is always <= 0
+                          ;; FIXME don't use encode-timestamp because
it's ambiguous
+                          (encode-timestamp-into-values nsec sec
minute hour day month year :timezone timezone)))))
                    ((zerop offset)
                     ;; The offset is zero, so just return the parts
of the timestamp object
                     (values nsec sec day))
hunk ./src/local-time.lisp 786
                    (t
-                    (case part
-                      (:nsec
-                       (multiple-value-bind (sec-offset new-nsec)
-                           (floor (+ offset nsec) 1000000000)
-                         ;; the time might need to be adjusted a bit
more if q != 0
-                         (direct-adjust :sec sec-offset
-                                        new-nsec sec day)))
-                      (:day
-                       (values nsec sec (+ day offset)))
-                      (otherwise
-                       (multiple-value-bind (days-offset new-sec)
-                           (floor (+ sec (* offset (ecase part
-                                                     (:sec 1)
-                                                     (:minute
+seconds-per-minute+)
-                                                     (:hour
+seconds-per-hour+))))
-                                  +seconds-per-day+)
-                         (direct-adjust :day days-offset
-                                        nsec new-sec day)))))))
+                    (let ((old-utc-offset (or utc-offset
+                                          (timestamp-subtimezone time
timezone)))
+                          new-utc-offset)
+                      (tagbody
+                         top
+                         (ecase part
+                           (:nsec
+                            (multiple-value-bind (sec-offset new-nsec)
+                                (floor (+ offset nsec) 1000000000)
+                              ;; the time might need to be adjusted a
bit more if q != 0
+                              (setf part :sec
+                                    offset sec-offset
+                                    nsec new-nsec)
+                              (go top)))
+                           ((:sec :minute :hour)
+                            (multiple-value-bind (days-offset new-sec)
+                                (floor (+ sec (* offset (ecase part
+                                                          (:sec 1)
+                                                          (:minute
+seconds-per-minute+)
+                                                          (:hour
+seconds-per-hour+))))
+                                       +seconds-per-day+)
+                              (setf part :day
+                                    offset days-offset
+                                    sec new-sec)
+                              (go top)))
+                           (:day
+                            (incf day offset)
+                            (setf new-utc-offset (or utc-offset
+
(timestamp-subtimezone (make-timestamp :nsec nsec :sec sec :day day)
+
      timezone)))
+                            (when (not (= old-utc-offset
+                                          new-utc-offset))
+                              ;; We hit the DST boundary. We need to
restart again
+                              ;; with :sec, but this time we know
both old and new
+                              ;; UTC offset will be the same, so it's
safe to do
+                              (setf part :sec
+                                    offset (- old-utc-offset
+                                              new-utc-offset)
+                                    old-utc-offset new-utc-offset)
+                              (go top))
+                            (return-from direct-adjust (values nsec
sec day)))))))))
+
            (safe-adjust (part offset time)
              (with-decoded-timestamp (:nsec nsec :sec sec :minute
minute :hour hour :day day
hunk ./src/local-time.lisp 830
-                                      :month month :year year
:timezone +utc-zone+)
+                                            :month month :year year
:timezone timezone)
                  time
                (multiple-value-bind (month-new year-new)
                    (%normalize-month-year-pair
hunk ./src/local-time.lisp 844
                  (encode-timestamp-into-values nsec sec minute hour
                                                (%fix-overflow-in-days
day month-new year-new)
                                                month-new year-new
-                                               :offset 0)))))
+                                               :timezone timezone
:offset utc-offset)))))
     (ecase part
       ((:nsec :sec :minute :hour :day :day-of-week)
        (direct-adjust part offset
hunk ./src/local-time.lisp 887
         (incf result (/ nsec 1000000000d0)))
       result)))

-(defun timestamp+ (time amount unit)
+(defun timestamp+ (time amount unit &optional (timezone
*default-timezone*) offset)
   (multiple-value-bind (nsec sec day)
hunk ./src/local-time.lisp 889
-      (%offset-timestamp-part time unit amount)
+      (%offset-timestamp-part time unit amount :timezone timezone
:offset offset)
     (make-timestamp :nsec nsec
                     :sec sec
                     :day day)))
hunk ./src/local-time.lisp 894

-(defun timestamp- (time amount unit)
-  (multiple-value-bind (nsec sec day)
-      (%offset-timestamp-part time unit (- amount))
-    (make-timestamp :nsec nsec
-                    :sec sec
-                    :day day)))
+(defun timestamp- (time amount unit &optional (timezone
*default-timezone*) offset)
+  (timestamp+ time (- amount) unit timezone offset))

 (defun timestamp-day-of-week (timestamp &key (timezone
*default-timezone*) offset)
   (mod (+ 3 (nth-value 1 (%adjust-to-timezone timestamp timezone offset))) 7))
}

Context:

[added a once failing test
attila.lendvai at gmail.com**20090616143818
 Ignore-this: 741ad01d47b47e15cb4877567d3ba9d9
]
[add a more useful error when find-timezone-by-location-name is used
without reading in the timezone files
attila.lendvai at gmail.com**20090616143733
 Ignore-this: c982ca27ef16e7f865afece963b6c9be
]
[fix (print (now)) when *timezone* is (find-timezone-by-location-name "UTC")
attila.lendvai at gmail.com**20090616141707
 Ignore-this: ac694826aa5e9719d41c51503e0a8785
]
[clean up gettimeofday stuff, follow sbcl's changes (but remain
backward compatible)
attila.lendvai at gmail.com**20090521170712
 Ignore-this: 70b2754c0a254abb060dce0f15bb266
]
[remove superfluous eval-when around reread-timezone-repository
attila.lendvai at gmail.com**20090513213236
 Ignore-this: 337cf4b3d50d0714f2c4a4a3d84e356f
]
[Local-time now passes all tests in CCL
Daniel Lowe <dlowe at bitmuse.com>**20090417142203]
[Changed lispworks/ccl kluge to another, better kluge
Daniel Lowe <dlowe at bitmuse.com>**20090417142156]
[In WITH-DECODED-TIMESTAMP, declare nsec type as ranged integer
instead of FIXNUM
Daniel Lowe <dlowe at bitmuse.com>**20090416204555]
[clarification comment for the lispworks #_ situation
attila.lendvai at gmail.com**20090324135651
 Ignore-this: 1f97d85c23ecffd5806f7a3c137f8491
]
[Less intrusive version of the Lispworks patch for #_.
Larry Clapp <larry at theclapp.org>**20090324132813

 Use an around method in ASDF's compile-op to set the readtable to ignore #_.
 This achieves the same end, but more elegantly, and doesn't pollute the
 regular readtable.
]
[be more conservative when installing global reader macros as a
lispwork workaround
attila.lendvai at gmail.com**20090323142133
 Ignore-this: dca64a6f7daa4d478beba41d1c102a16
]
[Work with Lispworks
Larry Clapp <larry at theclapp.org>**20090323132602

 - Added a dummy reader macro for #_ so the

     #+ccl
     (... #_gettimeofday ... )

   doesn't break the compile
 - Fix %unix-gettimeofday for Lisps other than CMU, SBCL, and CCL.
]
[TAG local-time-1.0.1
Daniel Lowe <dlowe at bitmuse.com>**20090312154109]
[Update TODO plans
Daniel Lowe <dlowe at bitmuse.com>**20090312154028]
[Don't require asdf-system-connections to load
Daniel Lowe <dlowe at bitmuse.com>**20090312153914]
[TAG local-time-1.0
Daniel Lowe <dlowe at bitmuse.com>**20090312140647]
[document the interpretation of day-of-week
attila.lendvai at gmail.com**20081223002624
 Ignore-this: 26bf6ba060df9684a5e60a9464adcfb0
]
[follow :weekday change in the manual
attila.lendvai at gmail.com**20081223002030
 Ignore-this: 6b303376bed4e880911ce5e3e0f4d037
]
[fix :weekday support for format-timestamp
attila.lendvai at gmail.com**20081223000411
 Ignore-this: af6abab43e3d60e97a24a627982e09cd
]
[TAG 2008-11-27
attila.lendvai at gmail.com**20081127150407
 Ignore-this: 9d6f3d956cb6436e69f285ffeaa41207
]
Patch bundle hash:
3ac65d22cf40b42369daa8e4aa2b9ab44c57c8e3
-------------- next part --------------
A non-text attachment was scrubbed...
Name: localtime.bundle
Type: application/octet-stream
Size: 28485 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/local-time-devel/attachments/20090727/076df48f/attachment.obj>


More information about the local-time-devel mailing list