diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2005-10-13 21:45:29 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2005-10-13 21:45:29 (GMT) |
| commit | 06be524fb096bbdcf2eb156ca47dfd09cdf92fbe (patch) | |
| tree | dd93e3b7e7385c094dc9b69337f67e1f9d162feb | |
| parent | 298c91d0d2026e4bfb0630d0cee9bfbb1f73e760 (diff) | |
| download | tcl-06be524fb096bbdcf2eb156ca47dfd09cdf92fbe.zip tcl-06be524fb096bbdcf2eb156ca47dfd09cdf92fbe.tar.gz tcl-06be524fb096bbdcf2eb156ca47dfd09cdf92fbe.tar.bz2 | |
Fix [Bug 1284178] and tweak tests to accommodate.
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 8 | ||||
| -rw-r--r-- | tests/format.test | 14 |
3 files changed, 20 insertions, 7 deletions
@@ -1,3 +1,8 @@ +2005-10-13 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCmdAH.c (Tcl_FormatObjCmd): Stop [format] from seeing + the difference between ints and wides. [Bug 1284178] + 2005-10-13 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> * generic/tclIO.c (Tcl_ClearChannelHandlers): temporary diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 545af15..aaf37ac 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.13 2005/07/05 21:18:23 dgp Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.14 2005/10/13 21:45:32 dkf Exp $ */ #include "tclInt.h" @@ -2195,7 +2195,11 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) } if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */ objv[objIndex], &intValue) != TCL_OK) { - goto fmtError; + if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */ + objv[objIndex], &wideValue) != TCL_OK) { + goto fmtError; + } + intValue = Tcl_WideAsLong(wideValue); } #if (LONG_MAX > INT_MAX) diff --git a/tests/format.test b/tests/format.test index 448f162..02af0d3 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.7 2005/06/17 23:26:20 dkf Exp $ +# RCS: @(#) $Id: format.test,v 1.11.2.8 2005/10/13 21:45:32 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -369,6 +369,10 @@ test format-10.4 {"h" format specifier} { # Bug 1154163: This is minimal behaviour for %hx specifier! format %hx 1 } 1 +test format-10.5 {"h" format specifier} { + # Bug 1284178: Highly out-of-range values shouldn't cause errors + format %hu 0x100000000 +} 0 test format-11.1 {XPG3 %$n specifiers} { format {%2$d %1$d} 4 5 @@ -497,8 +501,8 @@ for {set i 290} {$i < 400} {incr i} { [expr {wide(0x80000000) != int(0x80000000)}] test format-17.1 {testing %d with wide} {64bitInts wideIntExpressions} { - list [catch {format %d 7810179016327718216} msg] $msg -} {1 {integer value too large to represent}} + format %d 7810179016327718216 +} 1819043144 test format-17.2 {testing %ld with wide} {64bitInts} { format %ld 7810179016327718216 } 7810179016327718216 @@ -536,8 +540,8 @@ test format-18.1 {do not demote existing numeric values} { 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} + list [format %08x $a] [expr {$a == $b}] +} {aaaaaaab 1} test format-19.1 { regression test - tcl-core message by Brian Griffin on |