From 9b9b51c2fab5fd17f252834c55be6dfbbc1c286a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 14 May 2003 23:01:55 +0000
Subject: Consequent fixes from [Bug 699060]; [format] should not be too eager
 to demote wides to ints, and should throw errors when appropriate.

---
 ChangeLog          |  6 ++++++
 generic/tclCmdAH.c | 11 +++++++++--
 tests/format.test  | 25 ++++++++++++++++++++++++-
 3 files changed, 39 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index d5c1b64..26b30f5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-05-14  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Values which can't be
+	anything but wide shouldn't be demoted to long.  [consequence of
+	HEAD fixes for Bug 699060]
+
 2003-05-14  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* library/encoding/gb2312.enc: copy euc-cn.enc over original
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 596795a..2e6ba99 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -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: tclCmdAH.c,v 1.27.2.5 2003/04/16 23:31:42 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.6 2003/05/14 23:01:56 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2203,7 +2203,14 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 		    break;
 		} else {
 		    whichValue = INT_VALUE;
-		    intValue = (int) Tcl_WideAsLong(wideValue);
+		    if (wideValue>ULONG_MAX || wideValue<LONG_MIN) {
+			/*
+			 * Value too big for type.  Generate an error.
+			 */
+			Tcl_GetLongFromObj(interp, objv[objIndex], &intValue);
+			goto fmtError;
+		    }
+		    intValue = Tcl_WideAsLong(wideValue);
 		}
 	    } else if (objv[objIndex]->typePtr == &tclIntType) {
 		Tcl_GetLongFromObj(NULL, objv[objIndex], &intValue);
diff --git a/tests/format.test b/tests/format.test
index 909c993..487f6c5 100644
--- a/tests/format.test
+++ b/tests/format.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: format.test,v 1.11.2.3 2003/03/27 13:11:11 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.11.2.4 2003/05/14 23:01:56 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -512,6 +512,29 @@ test format-17.5 {type conversions with wides} {
     lappend result [expr {$a == $b}]
 } {1 1}
 
+test format-18.1 {do not demote existing numeric values} {
+    set a 0xaaaaaaaa
+    # Ensure $a and $b are separate objects
+    set b 0xaaaa
+    append b aaaa
+
+    set result [expr {$a == $b}]
+    format %08lx $b
+    lappend result [expr {$a == $b}]
+
+    set b 0xaaaa
+    append b aaaa
+
+    lappend result [expr {$a == $b}]
+    format %08x $b
+    lappend result [expr {$a == $b}]
+} {1 1 1 1}
+test format-18.2 {do not demote existing numeric values} {wideIntExpressions} {
+    set a [expr {0xaaaaaaaaaa + 1}]
+    set b 0xaaaaaaaaab
+    list [catch {format %08x $a} msg] $msg [expr {$a == $b}]
+} {1 {integer value too large to represent} 1}
+
 # cleanup
 catch {unset a}
 catch {unset b}
-- 
cgit v0.12