Made format less keen on converting numeric types. [Bug #699060]

FossilOrigin-Name: c6d6036ce4012b26001f02390f56792d6971eeab

3 files changed, 52 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index e6f9771..74d3258 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,8 @@
 
 	* generic/tclCmdAH.c (Tcl_FileObjCmd): Remove assumption that file
 	times and longs are the same size.  [Bug #698146]
+	(Tcl_FormatObjCmd): Stop surprising type conversions from
+	happening when working with integer and wide values.  [Bug #699060]
 
 	* generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier
 	that indicates we've got a wide int when we're formatting in an
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index e7bd499..596cab0 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.2 2003/03/14 21:48:46 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.3 2003/03/14 23:19:45 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2198,21 +2198,55 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 	case 'u':
 	case 'x':
 	case 'X':
+	    size = 40 + precision;
+
 #ifndef TCL_WIDE_INT_IS_LONG
-	    if (useWide) {
-		if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
-			objv[objIndex], &wideValue) != TCL_OK) {
+	    /*
+	     * 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;
+		    intValue = (int) 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) {
 		    goto fmtError;
 		}
-		whichValue = WIDE_VALUE;
-		size = 40 + precision;
-		break;
 	    }
-#endif /* TCL_WIDE_INT_IS_LONG */
+#else /* TCL_WIDE_INT_IS_LONG */
 	    if (Tcl_GetLongFromObj(interp,	      /* INTL: Tcl source. */
 		    objv[objIndex], &intValue) != TCL_OK) {
 		goto fmtError;
 	    }
+#endif /* !TCL_WIDE_INT_IS_LONG */
 #if (LONG_MAX > INT_MAX)
 	    /*
 	     * Add the 'l' for long format type because we are on an
@@ -2225,7 +2259,6 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 	    newPtr[-2] = 'l';
 #endif /* LONG_MAX > INT_MAX */
 	    whichValue = INT_VALUE;
-	    size = 40 + precision;
 	    break;
 	case 's':
 	    /*
diff --git a/tests/format.test b/tests/format.test
index 7374b46..423c476 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.1 2003/03/14 16:19:13 dkf Exp $
+# RCS: @(#) $Id: format.test,v 1.11.2.2 2003/03/14 23:19:45 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -504,6 +504,13 @@ test format-17.3 {testing %ld with non-wide} {64bitInts} {
 test format-17.4 {testing %l with non-integer} {
     format %lf 1
 } 1.000000
+test format-17.5 {type conversions with wides} {
+    set a 0xAAAAAAAA ;# NB: Careful to make separate objects here!
+    set b 0xAAAAAAA; append b A
+    set result [expr {$a == $b}]
+    format %x $a
+    lappend result [expr {$a == $b}]
+} {1 1}
 
 # cleanup
 catch {unset a}