Permalink
Browse files

Many default offset inconsistencies resolved, more tests pass

  • Loading branch information...
1 parent 058c04f commit b571a5852b0842b49a5708a5028ff2363767ad83 @dlowe-net committed Mar 24, 2010
Showing with 93 additions and 107 deletions.
  1. +56 −60 src/local-time.lisp
  2. +37 −47 test/parsing.lisp
View
@@ -168,10 +168,12 @@
(:report "The time specification is invalid"))
(define-condition invalid-timestring (error)
- ((timestring :accessor timestring-of :initarg :timestring))
+ ((timestring :accessor timestring-of :initarg :timestring)
+ (failure :accessor failure-of :initarg :failure))
(:report (lambda (condition stream)
- (format stream "Failed to parse ~S as an rfc3339 time"
- (timestring-of condition)))))
+ (format stream "Failed to parse ~S as an rfc3339 time: ~S"
+ (timestring-of condition)
+ (failure-of condition)))))
(defmethod make-load-form ((self timestamp) &optional environment)
(make-load-form-saving-slots self :environment environment))
@@ -292,13 +294,23 @@
;; time of day.
(defparameter +modified-julian-date-offset+ -51604)
-(defun %get-default-offset ()
- (multiple-value-bind (sec min hour day mon year dow daylight-p zone)
- (get-decoded-time)
- (declare (ignore sec min hour day mon year dow))
- (if daylight-p
- (* -3600 (1- zone))
- (* -3600 zone))))
+(defun %guess-offset (seconds days &optional timezone)
+ ;; 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.
+ (let* ((zone (%realize-timezone (or timezone *default-timezone*)))
+ (unix-time (timestamp-values-to-unix seconds days))
+ (subzone-idx (if (zerop (length (timezone-indexes zone)))
+ 0
+ (elt (timezone-indexes zone)
+ (transition-position unix-time
+ (timezone-transitions zone)))))
+ (subzone (elt (timezone-subzones zone) subzone-idx)))
+ (subzone-offset subzone)))
(defun %read-binary-integer (stream byte-count &optional (signed nil))
"Read BYTE-COUNT bytes from the binary stream STREAM, and return an integer which is its representation in network byte order (MSB). If SIGNED is true, interprets the most significant bit as a sign indicator."
@@ -555,7 +567,7 @@ In other words:
0
(elt (timezone-indexes zone)
(transition-position unix-time
- (timezone-transitions timezone)))))
+ (timezone-transitions zone)))))
(subzone (elt (timezone-subzones zone) subzone-idx)))
(values
(subzone-offset subzone)
@@ -963,47 +975,30 @@ the previous day given by OFFSET."
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))
- (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"))))
+ (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)))
+ (used-offset (or offset
+ (%guess-offset sec
+ days-from-zero-point
+ timezone))))
+ (multiple-value-bind (utc-sec utc-day)
+ (%adjust-to-offset sec days-from-zero-point (- used-offset))
+ (values nsec utc-sec utc-day))))
(defun encode-timestamp (nsec sec minute hour day month year
&key (timezone *default-timezone*) offset into)
@@ -1045,13 +1040,14 @@ elements."
(floor unix +seconds-per-day+)
(make-timestamp :day (- days 11017) :sec secs :nsec nsec)))
+(defun timestamp-values-to-unix (seconds day)
+ "Return the Unix time correspondint to the values used to encode a TIMESTAMP"
+ (+ (* (+ day 11017) +seconds-per-day+) seconds))
+
(defun timestamp-to-unix (timestamp)
"Return the Unix time corresponding to the TIMESTAMP"
(declare (type timestamp timestamp))
- (+ (* (+ (day-of timestamp)
- 11017)
- +seconds-per-day+)
- (sec-of timestamp)))
+ (timestamp-values-to-unix (sec-of timestamp) (day-of timestamp)))
(defun %get-current-time ()
"Cross-implementation abstraction to get the current time measured from the unix epoch (1/1/1970). Should return (values sec nano-sec)."
@@ -1348,7 +1344,7 @@ elements."
(type (or null (signed-byte 32)) nsec))
(macrolet ((passert (expression)
`(unless ,expression
- (parse-error)))
+ (parse-error ',expression)))
(parse-integer-into (start-end place &optional low-limit high-limit)
(let ((entry (gensym "ENTRY"))
(value (gensym "VALUE"))
@@ -1420,7 +1416,7 @@ elements."
:end (cdr (first parts))))
(full-date (first parts))
(done)))
- (parse-error)))
+ (parse-error nil)))
(full-date (start-end)
(let ((parts (split (car start-end) (cdr start-end) date-separator)))
(passert (%list-length= 3 parts))
@@ -1501,9 +1497,9 @@ elements."
(setf offset-minute 0))
(setf offset-hour (* offset-hour sign)
offset-minute (* offset-minute sign))))
- (parse-error ()
+ (parse-error (failure)
(if fail-on-error
- (error 'invalid-timestring :timestring time-string)
+ (error 'invalid-timestring :timestring time-string :failure failure)
(return-from %split-timestring nil)))
(done ()
(return-from %split-timestring (list year month day hour minute second nsec offset-hour offset-minute))))
@@ -1517,8 +1513,8 @@ elements."
:allow-missing-date-part nil))
(defun parse-timestring (timestring &key
- (start 0)
- (end (length timestring))
+ start
+ end
(fail-on-error t)
(time-separator #\:)
(date-separator #\-)
@@ -1530,8 +1526,8 @@ elements."
(offset 0))
"Parse a timestring and return the corresponding TIMESTAMP. See split-timestring for details. Unspecified fields in the timestring are initialized to their lowest possible value, and timezone offset is 0 (UTC) unless explicitly specified in the input string."
(let ((parts (%split-timestring (coerce timestring 'simple-string)
- :start start
- :end end
+ :start (or start 0)
+ :end (or end (length timestring))
:fail-on-error fail-on-error
:time-separator time-separator
:date-separator date-separator
View
@@ -15,54 +15,44 @@
(let ((parsed (parse-timestring (format-timestring nil time))))
(is (timestamp= parsed time))))))
-(deftest test/parsing/bug/1 ()
- ;; This test depends on the clock of the machine, but as of writing,
- ;; this test fails, 2009. oct. 29. (non-summer time).
- ;; FIXME attila: this test is probably wrong, because (local-time::%get-default-offset)
- ;; returns the default offset based on the _current time_ of the computer, whereas
- ;; ENCODE-TIMESTAMP scans the timezone definition.
- ;; this test fails for me in october (no daylight saving) in CET (Europe/Budapest, +01:00)
- (let* ((*default-timezone* (find-timezone-by-location-name "Europe/Budapest"))
- (timestamp (encode-timestamp 0 0 0 0 1 1 1)))
- (is (timestamp= timestamp
- (parse-timestring "0001-01-01T00:00:00,0"
- :offset (local-time::%get-default-offset))))))
-
(deftest test/parsing/parse-format-consistency ()
- (let ((timestamp (now)))
- (is (timestamp= timestamp
- (parse-timestring
- (format-timestring nil timestamp)))))
- ;; FIXME see comment at parse-timestring/bug/1; it applies to most of the asserts below...
- (let ((timestamp (encode-timestamp 0 0 0 0 1 1 1)))
- (is (timestamp= timestamp
- (parse-timestring "0001-01-01T00:00:00,0"
- :offset (local-time::%get-default-offset)))))
- (let ((timestamp (encode-timestamp 0 0 0 0 1 1 1 :offset 0)))
- (is (timestamp= timestamp
- (parse-timestring "0001-01-01T00:00:00Z"))))
- (let ((timestamp (encode-timestamp 0 0 0 0 1 1 2006)))
- (is (timestamp= timestamp
- (parse-timestring "2006-01-01T00:00:00,0"
- :offset (local-time::%get-default-offset)))))
- (is (eql (day-of (encode-timestamp 0 0 0 0 1 1 2006))
- (day-of (parse-timestring "xxxx 2006-01-01T00:00:00,0 xxxx"
- :start 5
- :end 15
- :offset (local-time::%get-default-offset)))))
- (is (eql (day-of (parse-timestring "2006-06-06TZ")) 2288))
- (is (timestamp= (encode-timestamp 20000000 3 4 5 6 7 2008)
- (parse-timestring "2008-07-06T05:04:03,02"
- :offset (local-time::%get-default-offset))))
- (is (timestamp= (encode-timestamp 0 02 0 0 23 3 2000)
- (parse-timestring "--23T::02"
- :allow-missing-elements t
- :offset (local-time::%get-default-offset))))
- (is (timestamp= (encode-timestamp 80000000 7 6 5 1 3 2000)
- (parse-timestring "T05:06:07,08"
- :offset (local-time::%get-default-offset))))
- (is (timestamp= (encode-timestamp 940703000 28 56 16 20 2 2008 :offset 0)
- (parse-timestring "2008-02-20T16:56:28.940703Z"))))
+ (flet ((compare (nsec sec min hour day mon year str
+ &key start end offset
+ (allow-missing-elements t))
+ (let* ((timestamp-a (encode-timestamp nsec sec min hour
+ day mon year :offset offset))
+ (used-offset (or offset
+ (local-time::%guess-offset (sec-of timestamp-a)
+ (day-of timestamp-a))))
+ (timestamp-b (parse-timestring str
+ :start start
+ :end end
+ :allow-missing-elements
+ allow-missing-elements
+ :offset used-offset)))
+ (is (timestamp= timestamp-a timestamp-b)))))
+ (let ((timestamp (now)))
+ (is (timestamp= timestamp
+ (parse-timestring
+ (format-timestring nil timestamp)))))
+
+ (let* ((*default-timezone* (find-timezone-by-location-name "Europe/Budapest")))
+ (compare 0 0 0 0 1 1 1 "0001-01-01T00:00:00,0"))
+
+ (compare 0 0 0 0 1 1 1 "0001-01-01T00:00:00Z" :offset 0)
+
+ (compare 0 0 0 0 1 1 2006 "2006-01-01T00:00:00,0")
+ (compare 0 0 0 0 1 1 2006 "xxxx 2006-01-01T00:00:00,0 xxxx"
+ :start 5
+ :end 15)
+
+ (is (eql (day-of (parse-timestring "2006-06-06TZ")) 2288))
+
+ (compare 20000000 3 4 5 6 7 2008 "2008-07-06T05:04:03,02")
+ (compare 0 2 0 0 23 3 2000 "--23T::02" :allow-missing-elements t)
+ (compare 80000000 7 6 5 1 3 2000 "T05:06:07,08" :allow-missing-elements t)
+ (compare 940703000 28 56 16 20 2 2008 "2008-02-20T16:56:28.940703Z"
+ :offset 0)))
(deftest test/parsing/reader ()
(let ((now (now)))

0 comments on commit b571a58

Please sign in to comment.