backport fixes for 868489 and 1026125

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}