From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 30 Dec 2003 21:06:19 +0000 (+0000)
Subject: 0.8.7.2:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=020de3c04699323437f0c746fe986506b716ab97;p=sbcl.git

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
--- 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
--- 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)))))))
 
 ;;;; TIME
 
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index db787af..dd04eb0 100644
--- 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)))
 
 ;;;; sys/time.h
 
diff --git a/src/runtime/time.c b/src/runtime/time.c
index c640399..716e7d8 100644
--- 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
--- 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
--- 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"