From: Brian Mastenbrook Date: Thu, 11 Aug 2005 00:13:28 +0000 (+0000) Subject: 0.9.3.38: further fixes to ENCODE- and DECODE-UNIVERSAL-TIME: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=881c3a215e3a82faf928265f8606f940f3e44e1e;p=sbcl.git 0.9.3.38: further fixes to ENCODE- and DECODE-UNIVERSAL-TIME: * DECODE-UNIVERSAL-TIME now calls out to UNIX time functions to obtain daylight savings time and timezone information for the entire range of 32-bit time_t, and when below that calls with a plausable date in 1903. * ENCODE-UNIVERSAL-TIME now no longer errors when passed a decoded time with a year in 1899, so long as the encoded time is non-negative. --- diff --git a/src/code/time.lisp b/src/code/time.lisp index 3a77099..72abe21 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -106,6 +106,18 @@ ;;; history (Perq time base?) could be cleaned up any on this basis. ;;; -- dan, 2003-08-08 +;;; In order to accomodate universal times between January 1st 1900 +;;; and sometime on December 13th 1901, I'm doing the same calculation +;;; as described above in order to handle dates in that interval, by +;;; normalizing them to March 1st 1903, which shares the same special +;;; properties described above (except for the 400-year property, but +;;; this isn't an issue for the limited range we need to handle). + +;;; One open issue is whether to pass UNIX a 64-bit time_t value on +;;; 64-bit platforms. I don't know if time_t is always 64-bit on those +;;; platforms, and looking at this file reveals a scary amount of +;;; literal 31 and 32s. +;;; -- bem, 2005-08-09 ;;; Subtract from the returned Internal-Time to get the universal ;;; time. The offset between our time base and the Perq one is 2145 @@ -138,6 +150,8 @@ (defconstant +mar-1-2000+ #.(encode-universal-time 0 0 0 1 3 2000 0)) (defconstant +mar-1-2035+ #.(encode-universal-time 0 0 0 1 3 2035 0)) +(defconstant +mar-1-1903+ #.(encode-universal-time 0 0 0 1 3 1903 0)) + (defun years-since-mar-2000 (utime) "Returns number of complete years since March 1st 2000, and remainder in seconds" (let* ((days-in-year (* 86400 365)) @@ -159,13 +173,17 @@ (defun truncate-to-unix-range (utime) (let ((unix-time (- utime unix-to-universal-time))) - (if (and (>= unix-time 0) - (< unix-time (ash 1 31))) - unix-time - (multiple-value-bind (year offset) (years-since-mar-2000 utime) - (declare (ignore year)) - (+ +mar-1-2035+ (- unix-to-universal-time) offset))))) - + (cond + ((< unix-time (- (ash 1 31))) + (multiple-value-bind (year offset) (years-since-mar-2000 utime) + (declare (ignore year)) + (+ +mar-1-1903+ (- unix-to-universal-time) offset))) + ((>= unix-time (ash 1 31)) + (multiple-value-bind (year offset) (years-since-mar-2000 utime) + (declare (ignore year)) + (+ +mar-1-2035+ (- unix-to-universal-time) offset))) + (t unix-time)))) + (defun decode-universal-time (universal-time &optional time-zone) #!+sb-doc "Converts a universal-time to decoded time format returning the following @@ -247,7 +265,11 @@ (type (mod 24) hour) (type (integer 1 31) date) (type (integer 1 12) month) - (type (or (integer 0 99) (integer 1900)) year) + (type (or (integer 0 99) (integer 1899)) year) + ;; that type used to say (integer 1900), but that's + ;; incorrect when a time-zone is specified: we should be + ;; able to encode to produce 0 when a non-zero timezone is + ;; specified - bem, 2005-08-09 (type (or null rational) time-zone)) (let* ((year (if (< year 100) (pick-obvious-year year) @@ -258,9 +280,10 @@ (leap-years-before (1+ year)) (leap-years-before year)) (* (- year 1900) 365))) - (hours (+ hour (* days 24)))) + (hours (+ hour (* days 24))) + (encoded-time 0)) (if time-zone - (+ second (* (+ minute (* (+ hours time-zone) 60)) 60)) + (setf encoded-time (+ second (* (+ minute (* (+ hours time-zone) 60)) 60))) (let* ((secwest-guess (sb!unix::unix-get-seconds-west (truncate-to-unix-range (* hours 60 60)))) @@ -269,7 +292,9 @@ (secwest (sb!unix::unix-get-seconds-west (truncate-to-unix-range guess)))) - (+ guess (- secwest secwest-guess)))))) + (setf encoded-time (+ guess (- secwest secwest-guess))))) + (assert (typep encoded-time '(integer 0))) + encoded-time)) ;;;; TIME diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp index 829a4d4..156c535 100644 --- a/tests/interface.pure.lisp +++ b/tests/interface.pure.lisp @@ -129,6 +129,15 @@ (test (* 86400 365) 0 (0 0 0 1 1 1901 1 0)) (test (* 86400 365) 1/3600 (59 59 23 31 12 1900 0 1/3600))) +;;; DECODE-UNIVERSAL-TIME shouldn't fail when the time is outside UNIX +;;; 32-bit time_t and a timezone wasn't passed +(decode-universal-time 0 nil) + +;;; ENCODE-UNIVERSAL-TIME should be able to encode the universal time +;;; 0 when passed a representation in a timezone where the +;;; representation of 0 as a decoded time is in 1899. +(encode-universal-time 0 0 23 31 12 1899 1) + ;;; DISASSEMBLE shouldn't fail on purified functions (disassemble 'cl:+) (disassemble 'sb-ext:run-program) @@ -137,4 +146,4 @@ ;;; comprehensive test. (loop repeat 2 do (compile nil '(lambda (x) x)) - do (sb-ext:gc :full t)) + do (sb-ext:gc :full t)) \ No newline at end of file diff --git a/version.lisp-expr b/version.lisp-expr index 15fc5fb..0661f99 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.3.37" +"0.9.3.38"