From d1b987be17d4f05e79530f9f0896284fbe354205 Mon Sep 17 00:00:00 2001
From: Kevin B Kenny <kennykb@acm.org>
Date: Wed, 24 Aug 2005 15:15:43 +0000
Subject: fix formatting of fp number with smallest significand

---
 ChangeLog           |  7 ++++
 generic/tclStrToD.c |  4 +--
 tests/binary.test   | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 106 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index f5ba239..2b5a7b4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2005-08-24  Kevin Kenny  <kennykb@acm.org>
+
+	* generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of
+	* tests/binary.test (binary-65.*)         formatting floating
+	point numbers with the largest and smallest possible significands,
+	and added test cases for them.
+	
 2005-08-23  Mo DeJong  <mdejong@users.sourceforge.net>
 
 	* unix/configure.in:
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index b28a60e..68f6c30 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -15,7 +15,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.7 2005/07/16 21:29:23 kennykb Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.8 2005/08/24 15:15:45 kennykb Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -959,7 +959,7 @@ TclDoubleDigits(char * strPtr,	/* Buffer in which to store the result, must
 	     * smaller exponent when going to e's predecessor.
 	     */
 
-	    rfac2 += bits + log2FLT_RADIX - 1;
+	    rfac2 += bits + log2FLT_RADIX + 1;
 	    sfac2 = 1 + log2FLT_RADIX;
 	    mplusfac2 = bits + log2FLT_RADIX;
 	    mminusfac2 = bits;
diff --git a/tests/binary.test b/tests/binary.test
index a73108c..26444f7 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: binary.test,v 1.22 2005/08/05 19:03:04 kennykb Exp $
+# RCS: @(#) $Id: binary.test,v 1.23 2005/08/24 15:15:46 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -2078,6 +2078,102 @@ test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
     set x
 } 6442450944
 
+# Big test for correct ordering of data in [expr]
+
+proc testIEEE {} {
+    variable ieeeValues
+    binary scan [binary format dd -1.0 1.0] c* c
+    switch -exact -- $c {
+	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+	    # little endian
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+		ieeeValues(-Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+		ieeeValues(-Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+		ieeeValues(+Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+		ieeeValues(+Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 1
+	    return 1
+	}
+	{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+	    binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Infinity)
+	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Normal)
+	    binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Normal)
+	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Infinity)
+	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 0
+	    return 1
+	}
+	default {
+	    return 0
+	}
+    }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+
+test binary-65.1 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fcfffffffffffff] q d
+    set d
+} 0.24999999999999997
+test binary-65.2 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fd0000000000000] q d
+    set d
+} 0.25
+test binary-65.3 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fdfffffffffffff] q d
+    set d
+} 0.49999999999999994
+test binary-65.4 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fe0000000000000] q d
+    set d
+} 0.5
+test binary-65.5 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fffffffffffffff] q d
+    set d
+} 1.9999999999999998
+test binary-65.6 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4000000000000000] q d
+    set d
+} 2.0
+test binary-65.7 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x434fffffffffffff] q d
+    set d
+} 18014398509481982.0
+test binary-65.8 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4350000000000000] q d
+    set d
+} 18014398509481984.0
+test binary-65.8 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4350000000000001] q d
+    set d
+} 18014398509481988.0
+
 
 # cleanup
 ::tcltest::cleanupTests
-- 
cgit v0.12