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