fix for Martin Lemburg's DST conversion bug.

http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0

4 files changed, 93 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 9d7c832..88fb007 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2006-04-19  Kevin B. Kenny  <kennykb@acm.org>
+
+	* library/clock.tcl: Fixed a bug with Daylight Saving Time and
+	Posix time zone specifiers reported by Martin Lemburg in
+	http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/9a8b15a4dfc0b7a0
+	(and not at SourceForge).
+	* tests/clock.test: Added test case for the above bug.
+	
 2006-04-18  Donal K. Fellows  <dkf@users.sf.net>
 
 	* doc/IntObj.3: Minor review fixes, including better documentation of
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index f5ff814..41d13f8 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStrToD.c,v 1.20 2006/03/21 20:03:06 dgp Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.21 2006/04/19 16:43:02 kennykb Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -118,6 +118,13 @@ static CONST double pow_10_2_n[] = {	/* Inexact higher powers of ten. */
     1.0e+128,
     1.0e+256
 };
+static int n770_fp;		/* Flag is 1 on Nokia N770 floating point.
+				 * Nokia's floating point has the words
+				 * reversed: if big-endian is 7654 3210,
+				 * and little-endian is       0123 4567,
+				 * then Nokia's FP is         4567 0123;
+				 * little-endian within the 32-bit words
+				 * but big-endian between them. */
 
 /*
  * Static functions defined in this file.
@@ -134,6 +141,7 @@ static double		MakeLowPrecisionDouble(int signum,
 			    Tcl_WideUInt significand, int nSigDigs,
 			    int exponent);
 static double		MakeNaN(int signum, Tcl_WideUInt tag);
+static Tcl_WideUInt	Nokia770Twiddle(Tcl_WideUInt w);
 static double		Pow10TimesFrExp(int exponent, double fraction,
 			    int *machexp);
 static double		RefineApproximation(double approx,
@@ -1508,7 +1516,9 @@ MakeNaN(
     } else {
 	theNaN.iv |= ((Tcl_WideUInt) NAN_START) << 48;
     }
-
+    if (n770_fp) {
+	theNaN.iv = Nokia770Twiddle(theNaN.iv);
+    }
     return theNaN.dv;
 }
 #endif
@@ -1989,9 +1999,15 @@ AbsoluteValue(
 	double dv;
     } bitwhack;
     bitwhack.dv = v;
+    if (n770_fp) {
+	bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+    }
     if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
 	*signum = 1;
 	bitwhack.iv &= ~((Tcl_WideUInt) 1 << 63);
+	if (n770_fp) {
+	    bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+	}
 	v = bitwhack.dv;
     } else {
 	*signum = 0;
@@ -2114,6 +2130,13 @@ TclInitDoubleConversion(void)
     Tcl_WideUInt u;
     double d;
 
+#ifdef IEEE_FLOATING_POINT
+    union {
+	double dv;
+	Tcl_WideUInt iv;
+    } bitwhack;
+#endif
+
     /*
      * Initialize table of powers of 10 expressed as wide integers.
      */
@@ -2183,6 +2206,25 @@ TclInitDoubleConversion(void)
 	    * log((double) FLT_RADIX) / log(10.));
     mantDIGIT = (mantBits + DIGIT_BIT-1) / DIGIT_BIT;
     log10_DIGIT_MAX = (int) floor(DIGIT_BIT * log(2.) / log(10.));
+
+    /*
+     * Nokia 770's software-emulated floating point is "middle endian":
+     * the bytes within a 32-bit word are little-endian (like the native
+     * integers), but the two words of a 'double' are presented most
+     * significant word first.
+     */
+
+#ifdef IEEE_FLOATING_POINT
+    bitwhack.dv = 1.000000238418579;
+				/* 3ff0 0000 4000 0000 */
+    if ((bitwhack.iv >> 32) == 0x3ff00000) {
+	n770_fp = 0;
+    } else if ((bitwhack.iv & 0xffffffff) == 0x3ff00000) {
+	n770_fp = 1;
+    } else {
+	Tcl_Panic("unknown floating point word order on this machine.");
+    }
+#endif
 }
 
 /*
@@ -2623,6 +2665,9 @@ TclFormatNaN(
     } bitwhack;
 
     bitwhack.dv = value;
+    if (n770_fp) {
+	bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
+    }
     if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
 	bitwhack.iv &= ~ ((Tcl_WideUInt) 1 << 63);
 	*buffer++ = '-';
@@ -2640,6 +2685,24 @@ TclFormatNaN(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * Nokia770Twiddle --
+ *
+ * 	Transpose the two words of a number for Nokia 770 floating
+ *	point handling.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideUInt
+Nokia770Twiddle(
+    Tcl_WideUInt w		/* Number to transpose */
+) {
+    return (((w >> 32) & 0xffffffff) | (w << 32));
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/library/clock.tcl b/library/clock.tcl
index 1d75b7d..37d475f 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: clock.tcl,v 1.29 2005/12/27 17:39:02 kennykb Exp $
+# RCS: @(#) $Id: clock.tcl,v 1.30 2006/04/19 16:43:03 kennykb Exp $
 #
 #----------------------------------------------------------------------
 
@@ -3947,12 +3947,12 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
 	# Time was specified as a day of the week within a month
 
 	dict set date month [dict get $z ${bound}Month]
-	dict set date dayOfWeekInMonth [dict get $z ${bound}WeekOfMonth]
-	set dow [dict get $z ${bound}DayOfWeek]
-	if { $dow >= 5 } {
-	    set dow -1
+	dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
+	set dowim [dict get $z ${bound}WeekOfMonth]
+	if { $dowim >= 5 } {
+	    set dowim -1
 	}
-	dict set date dayOfWeek $dow
+	dict set date dayOfWeekInMonth $dowim
 	set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]
 
     }
diff --git a/tests/clock.test b/tests/clock.test
index 50892b6..8c4a882 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: clock.test,v 1.62 2006/04/05 15:17:39 dgp Exp $
+# RCS: @(#) $Id: clock.test,v 1.63 2006/04/19 16:43:03 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -35482,6 +35482,19 @@ test clock-51.1 {correct conversion of times in Sydney} {
     set result
 } {01:59:59 03:00:00 12:59:59 13:00:00}
 
+test clock-52.1 {Posix timezone and conversion on last Sunday} {
+    # Martin Lemburg reported a bug where if tzdata is missing, then
+    # times are converted incorrectly in locales where DST conversion
+    # happens in the last (nominal 5th) week of a month.
+    set result {}
+    set timezone <MEZ>-01:00:00<MESZ>-02:00:00,M3.5.0/02:00:00,M10.5.0/01:00:00
+    foreach t {1143334799 1143334800} {
+	lappend result [clock format $t -format %H:%M:%S -timezone $timezone] \
+	    [clock format $t -format %H:%M:%S -timezone :Europe/Berlin]
+    }
+    set result
+} {01:59:59 01:59:59 03:00:00 03:00:00}
+
 # cleanup
 
 namespace delete ::testClock