summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2004-10-27 15:39:11 (GMT)
committerKevin B Kenny <kennykb@acm.org>2004-10-27 15:39:11 (GMT)
commiteac8637a05c20c906f723ad02ade6d3ca62dce8a (patch)
tree9edf4167cc20c7609343bf8cb87d71e5789b4249
parent7768c358ff0263882be1f1a102de414447307797 (diff)
downloadtcl-eac8637a05c20c906f723ad02ade6d3ca62dce8a.zip
tcl-eac8637a05c20c906f723ad02ade6d3ca62dce8a.tar.gz
tcl-eac8637a05c20c906f723ad02ade6d3ca62dce8a.tar.bz2
backport fixes for 868489 and 1026125
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclCmdAH.c60
-rw-r--r--generic/tclObj.c8
-rw-r--r--tests/format.test10
4 files changed, 33 insertions, 54 deletions
diff --git a/ChangeLog b/ChangeLog
index 0569fbf..59e4f7b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-10-26 Kevin B. Kenny <kennykb@acm.org>
+
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Backport a missing bit
+ of the bug 868486 fix.
+ * generic/tclObj.c (SetBooleanFromAny): Backport fix for Bug
+ 1026125.
+ * tests/format.test (format-19.1): Additional regression test for
+ Bug 868489.
+
2004-10-26 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* doc/*.n: Backporting of documentation updates.
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4bb76d2..4c43b87 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.8 2003/12/12 16:47:47 vincentdarley Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.9 2004/10/27 15:39:35 kennykb Exp $
*/
#include "tclInt.h"
@@ -2193,55 +2193,21 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
case 'u':
case 'x':
case 'X':
- size = 40 + precision;
-
- /*
- * Peek what kind of value we've got so as not to be
- * converting stuff unduly. [Bug #699060]
- */
- if (objv[objIndex]->typePtr == &tclWideIntType) {
- Tcl_GetWideIntFromObj(NULL, objv[objIndex], &wideValue);
- if (useWide) {
- whichValue = WIDE_VALUE;
- break;
- } else {
- whichValue = INT_VALUE;
- 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);
- if (useWide) {
- whichValue = WIDE_VALUE;
- wideValue = Tcl_LongAsWide(intValue);
- break;
- } else {
- whichValue = INT_VALUE;
- }
- } else {
- /*
- * No existing numeric interpretation, so we can
- * coerce to whichever is convenient.
- */
- if (useWide) {
- if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &wideValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = WIDE_VALUE;
- break;
- }
- if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &intValue) != TCL_OK) {
+ if ( useWide ) {
+ if ( Tcl_GetWideIntFromObj( interp, /* INTL: Tcl source. */
+ objv[objIndex], &wideValue )
+ != TCL_OK ) {
goto fmtError;
}
+ whichValue = WIDE_VALUE;
+ size = 40 + precision;
+ break;
}
+ if ( Tcl_GetLongFromObj( interp, /* INTL: Tcl source. */
+ objv[objIndex], &intValue ) != TCL_OK ) {
+ goto fmtError;
+ }
+
#if (LONG_MAX > INT_MAX)
/*
* Add the 'l' for long format type because we are on an
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8394f46..9c34908 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.42.2.8 2004/09/14 16:30:32 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.42.2.9 2004/10/27 15:39:36 kennykb Exp $
*/
#include "tclInt.h"
@@ -1118,11 +1118,7 @@ SetBooleanFromAny(interp, objPtr)
} else if (objPtr->typePtr == &tclDoubleType) {
newBool = (objPtr->internalRep.doubleValue != 0.0);
} else if (objPtr->typePtr == &tclWideIntType) {
-#ifdef TCL_WIDE_INT_IS_LONG
- newBool = (objPtr->internalRep.longValue != 0);
-#else /* !TCL_WIDE_INT_IS_LONG */
- newBool = (objPtr->internalRep.wideValue != Tcl_LongAsWide(0));
-#endif /* TCL_WIDE_INT_IS_LONG */
+ newBool = (objPtr->internalRep.wideValue != 0);
} else {
/*
* Copy the string converting its characters to lower case.
diff --git a/tests/format.test b/tests/format.test
index 487f6c5..6338d0c 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.4 2003/05/14 23:01:56 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.11.2.5 2004/10/27 15:39:36 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -535,6 +535,14 @@ test format-18.2 {do not demote existing numeric values} {wideIntExpressions} {
list [catch {format %08x $a} msg] $msg [expr {$a == $b}]
} {1 {integer value too large to represent} 1}
+test format-19.1 {
+ regression test - tcl-core message by Brian Griffin on
+ 26 0ctober 2004
+} {
+ set x 0x8fedc654
+ list [expr { ~ $x }] [format %08x [expr { ~$x }]]
+} {-2414724693 701239ab}
+
# cleanup
catch {unset a}
catch {unset b}