0.8.7.2:

	Fix bug in DECODE-UNIVERSAL-TIME (Vincent Arkensteijn sbcl-devel
	2003-12-29)
	... some minor renaming in patch
	... delete unused SB-UNIX::UNIX-GET-TIMEZONE
	... add a rudimentary test case or three

diff --git a/NEWS b/NEWS
index e4bb460..68178d3 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2233,6 +2233,11 @@ changes in sbcl-0.8.7 relative to sbcl-0.8.6:
        SUBTYPEP.
     ** VALUES tranformer lost derived type.
 
+changes in sbcl-0.8.8 relative to sbcl-0.8.7:
+  * bug fix: DECODE-UNIVERSAL-TIME now accepts timezone arguments with
+    second-resolution: integer multiples of 1/3600 between -24 and 24.
+    (thanks to Vincent Arkesteijn)
+
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
     down, it might impact TRACE. They both encapsulate functions, and

diff --git a/src/code/time.lisp b/src/code/time.lisp
index fb35b18..e467daf 100644 (file)
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -170,56 +170,45 @@
    nine values: second, minute, hour, date, month, year, day of week (0 =
    Monday), T (daylight savings time) or NIL (standard time), and timezone.
    Completely ignores daylight-savings-time when time-zone is supplied."
-  (multiple-value-bind (weeks secs)
-      (truncate (+ universal-time seconds-offset)
-               seconds-in-week)
-    (let* ((weeks (+ weeks weeks-offset))
-          (second NIL)
-          (minute NIL)
-          (hour NIL)
-          (date NIL)
-          (month NIL)
-          (year NIL)
-          (day NIL)
-          (daylight NIL)
-          (timezone (cond
-                      ((null time-zone)
-                       (multiple-value-bind (ignore minwest dst)
-                           (sb!unix::get-timezone
-                            (truncate-to-unix-range universal-time))
-                         (declare (ignore ignore))
-                         (declare (fixnum minwest))
-                         (setf daylight dst)
-                         minwest))
-                      (t (* time-zone 60)))))
-      (declare (fixnum timezone))
-      (multiple-value-bind (t1 seconds) (truncate secs 60)
-       (setq second seconds)
-       (setq t1 (- t1 timezone))
-       (let* ((tday (if (< t1 0)
-                        (1- (truncate (1+ t1) minutes-per-day))
-                        (truncate t1 minutes-per-day))))
-         (multiple-value-setq (hour minute)
-           (truncate (- t1 (* tday minutes-per-day)) 60))
-         (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
-                (tcent (truncate t2 quarter-days-per-century)))
-           (setq t2 (mod t2 quarter-days-per-century))
-           (setq t2 (+ (- t2 (mod t2 4)) 3))
-           (setq year (+ (* tcent 100) (truncate t2 quarter-days-per-year)))
-           (let ((days-since-mar0 (1+ (truncate (mod t2 quarter-days-per-year)
-                                                4))))
-             (setq day (mod (+ tday weekday-november-17-1858) 7))
-             (let ((t3 (+ (* days-since-mar0 5) 456)))
-               (cond ((>= t3 1989)
-                      (setq t3 (- t3 1836))
-                      (setq year (1+ year))))
-               (multiple-value-setq (month t3) (truncate t3 153))
-               (setq date (1+ (truncate t3 5))))))))
-      (values second minute hour date month year day
-             daylight
-             (if daylight
-                 (1+ (/ timezone 60))
-                 (/ timezone 60))))))
+  (multiple-value-bind (daylight seconds-west)
+      (if time-zone
+         (values nil (* time-zone 60 60))
+         (multiple-value-bind (ignore seconds-west daylight)
+             (sb!unix::get-timezone (truncate-to-unix-range universal-time))
+           (declare (ignore ignore))
+           (declare (fixnum seconds-west))
+           (values daylight seconds-west)))
+    (declare (fixnum seconds-west))
+    (multiple-value-bind (weeks secs)
+       (truncate (+ (- universal-time seconds-west) seconds-offset)
+                 seconds-in-week)
+      (let ((weeks (+ weeks weeks-offset)))
+       (multiple-value-bind (t1 second)
+           (truncate secs 60)
+         (let ((tday (truncate t1 minutes-per-day)))
+           (multiple-value-bind (hour minute)
+               (truncate (- t1 (* tday minutes-per-day)) 60)
+             (let* ((t2 (1- (* (+ (* weeks 7) tday november-17-1858) 4)))
+                    (tcent (truncate t2 quarter-days-per-century)))
+               (setq t2 (mod t2 quarter-days-per-century))
+               (setq t2 (+ (- t2 (mod t2 4)) 3))
+               (let* ((year (+ (* tcent 100)
+                               (truncate t2 quarter-days-per-year)))
+                      (days-since-mar0
+                       (1+ (truncate (mod t2 quarter-days-per-year) 4)))
+                      (day (mod (+ tday weekday-november-17-1858) 7))
+                      (t3 (+ (* days-since-mar0 5) 456)))
+                 (cond ((>= t3 1989)
+                        (setq t3 (- t3 1836))
+                        (setq year (1+ year))))
+                 (multiple-value-bind (month t3)
+                     (truncate t3 153)
+                   (let ((date (1+ (truncate t3 5))))
+                     (values second minute hour date month year day
+                             daylight
+                             (if daylight
+                                 (1+ (/ seconds-west 60 60))
+                                 (/ seconds-west 60 60))))))))))))))
 
 (defun pick-obvious-year (year)
   (declare (type (mod 100) year))
@@ -275,7 +264,7 @@
        (if (> year 2037)
            (labels ((leap-year-p (year)
                       (cond ((zerop (mod year 400)) t)
-                            ((zerop (mod year 100)) t)
+                            ((zerop (mod year 100)) nil)
                             ((zerop (mod year 4)) t)
                             (t nil))))
              (let* ((fake-year (if (leap-year-p year) 2036 2037))
@@ -285,14 +274,15 @@
                   (* 86400 (+ (* 365 (- year fake-year))
                               (- (leap-years-before year)
                                  (leap-years-before fake-year)))))))
-           (let* ((minwest-guess
-                   (sb!unix::unix-get-minutes-west
+           (let* ((secwest-guess
+                   (sb!unix::unix-get-seconds-west
                     (- (* hours 60 60) unix-to-universal-time)))
-                  (guess (+ minute (* hours 60) minwest-guess))
-                  (minwest
-                   (sb!unix::unix-get-minutes-west
-                    (- (* guess 60) unix-to-universal-time))))
-             (+ second (* (+ guess (- minwest minwest-guess)) 60)))))))
+                  (guess (+ second (* 60 (+ minute (* hours 60)))
+                            secwest-guess))
+                  (secwest
+                   (sb!unix::unix-get-seconds-west
+                    (- guess unix-to-universal-time))))
+             (+ guess (- secwest secwest-guess)))))))
 \f
 ;;;; TIME
 

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index db787af..dd04eb0 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -651,19 +651,13 @@
 
 (define-alien-routine get-timezone sb!alien:void
   (when sb!alien:long :in)
-  (minutes-west sb!alien:int :out)
+  (seconds-west sb!alien:int :out)
   (daylight-savings-p sb!alien:boolean :out))
 
-(defun unix-get-minutes-west (secs)
-  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
+(defun unix-get-seconds-west (secs)
+  (multiple-value-bind (ignore seconds dst) (get-timezone secs)
     (declare (ignore ignore) (ignore dst))
-    (values minutes)))
-
-(defun unix-get-timezone (secs)
-  (multiple-value-bind (ignore minutes dst) (get-timezone secs)
-    (declare (ignore ignore) (ignore minutes))
-    (values (deref unix-tzname (if dst 1 0)))))
-
+    (values seconds)))
 \f
 ;;;; sys/time.h
 

diff --git a/src/runtime/time.c b/src/runtime/time.c
index c640399..716e7d8 100644 (file)
--- a/src/runtime/time.c
+++ b/src/runtime/time.c
@@ -17,19 +17,19 @@
 #include <time.h>
 #include "runtime.h"
 
-void get_timezone(time_t when, int *minwest, boolean *dst)
+void get_timezone(time_t when, int *secwest, boolean *dst)
 {
     struct tm ltm, gtm;
-    int mw;
+    int sw;
 
     ltm = *localtime(&when);
     gtm = *gmtime(&when);
 
-    mw = ((gtm.tm_hour*60)+gtm.tm_min) - ((ltm.tm_hour*60)+ltm.tm_min);
+    sw = (((gtm.tm_hour*60)+gtm.tm_min)*60+gtm.tm_sec) - (((ltm.tm_hour*60)+ltm.tm_min)*60+ltm.tm_sec);
     if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday)
-       mw -= 24*60;
+       sw -= 24*3600;
     else if (gtm.tm_wday == (ltm.tm_wday + 1) % 7)
-       mw += 24*60;
-    *minwest = mw;
+       sw += 24*3600;
+    *secwest = sw;
     *dst = ltm.tm_isdst;
 }

diff --git a/tests/interface.pure.lisp b/tests/interface.pure.lisp
index a9b39e3..227ab07 100644 (file)
--- a/tests/interface.pure.lisp
+++ b/tests/interface.pure.lisp
@@ -109,3 +109,22 @@
 (documentation 'fixnum 'type)
 (documentation 'class 'type)
 (documentation (find-class 'class) 'type)
+
+;;; DECODE-UNIVERSAL-TIME should accept second-resolution time-zones.
+(macrolet ((test (ut time-zone list)
+            (destructuring-bind (sec min hr date mon yr day tz)
+                list
+              `(multiple-value-bind (sec min hr date mon yr day dst tz)
+                   (decode-universal-time ,ut ,time-zone)
+                 (declare (ignore dst))
+                 (assert (= sec ,sec))
+                 (assert (= min ,min))
+                 (assert (= hr ,hr))
+                 (assert (= date ,date))
+                 (assert (= mon ,mon))
+                 (assert (= yr ,yr))
+                 (assert (= day ,day))
+                 (assert (= tz ,tz))))))
+  (test (* 86400 365) -1/3600 (1 0 0 1 1 1901 1 -1/3600))
+  (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)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 06f0393..eb511ca 100644 (file)
--- 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.8.7.1"
+"0.8.7.2"