From 8f2192e73834a1ba84a6ea73b4970f9ad2dc102b Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 18 Jan 2010 09:31:01 +0000 Subject: [Bug 2932421]: Make [format] less likely to smash intreps. --- ChangeLog | 7 ++++ generic/tclStringObj.c | 88 +++++++++++++++++++++++++++----------------------- tests/format.test | 17 ++++++---- 3 files changed, 65 insertions(+), 47 deletions(-) diff --git a/ChangeLog b/ChangeLog index 3eb1c99..6f1e8db 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2010-01-18 Donal K. Fellows + + * generic/tclStringObj.c (Tcl_AppendFormatToObj): [Bug 2932421]: Stop + the [format] command from causing argument objects to change their + internal representation when not needed. Thanks to Alexandre Ferrieux + for this fix. + 2010-01-13 Donal K. Fellows * tools/tcltk-man2html.tcl: More factoring out of special cases diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 8787fd9..0780089 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.130 2009/09/30 03:11:26 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.131 2010/01/18 09:31:01 dkf Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -1710,6 +1710,7 @@ Tcl_AppendFormatToObj( newXpg = 0; if (isdigit(UCHAR(ch))) { int position = strtoul(format, &end, 10); + if (*end == '$') { newXpg = 1; objIndex = position - 1; @@ -1849,8 +1850,8 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = Tcl_UtfToUniChar(format, &ch); - } else { #ifndef TCL_WIDE_INT_IS_LONG + } else { useWide = 1; #endif } @@ -1864,6 +1865,7 @@ Tcl_AppendFormatToObj( */ segment = objv[objIndex]; + numChars = -1; if (ch == 'i') { ch = 'd'; } @@ -1871,15 +1873,17 @@ Tcl_AppendFormatToObj( case '\0': msg = "format string ended in middle of field specifier"; goto errorMsg; - case 's': { - numChars = Tcl_GetCharLength(segment); - if (gotPrecision && (precision < numChars)) { - segment = Tcl_GetRange(segment, 0, precision - 1); - Tcl_IncrRefCount(segment); - allocSegment = 1; + case 's': + if (gotPrecision) { + numChars = Tcl_GetCharLength(segment); + if (precision < numChars) { + segment = Tcl_GetRange(segment, 0, precision - 1); + numChars = precision; + Tcl_IncrRefCount(segment); + allocSegment = 1; + } } break; - } case 'c': { char buf[TCL_UTF_MAX]; int code, length; @@ -1904,7 +1908,7 @@ Tcl_AppendFormatToObj( case 'x': case 'X': case 'b': { - short int s = 0; /* Silence compiler warning; only defined and + short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ long l; Tcl_WideInt w; @@ -1929,7 +1933,7 @@ Tcl_AppendFormatToObj( Tcl_GetWideIntFromObj(NULL, objPtr, &w); Tcl_DecrRefCount(objPtr); } - isNegative = (w < (Tcl_WideInt)0); + isNegative = (w < (Tcl_WideInt) 0); } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; @@ -1946,16 +1950,16 @@ Tcl_AppendFormatToObj( l = Tcl_WideAsLong(w); } if (useShort) { - s = (short int) l; - isNegative = (s < (short int)0); + s = (short) l; + isNegative = (s < (short) 0); } else { - isNegative = (l < (long)0); + isNegative = (l < (long) 0); } } else if (useShort) { - s = (short int) l; - isNegative = (s < (short int)0); + s = (short) l; + isNegative = (s < (short) 0); } else { - isNegative = (l < (long)0); + isNegative = (l < (long) 0); } segment = Tcl_NewObj(); @@ -2024,7 +2028,7 @@ Tcl_AppendFormatToObj( if (gotPrecision) { if (length < precision) { - segmentLimit -= (precision - length); + segmentLimit -= precision - length; } while (length < precision) { Tcl_AppendToObj(segment, "0", 1); @@ -2035,7 +2039,7 @@ Tcl_AppendFormatToObj( if (gotZero) { length += Tcl_GetCharLength(segment); if (length < width) { - segmentLimit -= (width - length); + segmentLimit -= width - length; } while (length < width) { Tcl_AppendToObj(segment, "0", 1); @@ -2056,8 +2060,8 @@ Tcl_AppendFormatToObj( case 'x': case 'X': case 'b': { - Tcl_WideUInt bits = (Tcl_WideUInt)0; - Tcl_WideInt numDigits = (Tcl_WideInt)0; + Tcl_WideUInt bits = (Tcl_WideUInt) 0; + Tcl_WideInt numDigits = (Tcl_WideInt) 0; int length, numBits = 4, base = 16; int index = 0, shift = 0; Tcl_Obj *pure; @@ -2068,12 +2072,12 @@ Tcl_AppendFormatToObj( } else if (ch == 'o') { base = 8; numBits = 3; - } else if (ch=='b') { + } else if (ch == 'b') { base = 2; numBits = 1; } if (useShort) { - unsigned short int us = (unsigned short int) s; + unsigned short us = (unsigned short) s; bits = (Tcl_WideUInt) us; while (us) { @@ -2093,7 +2097,7 @@ Tcl_AppendFormatToObj( mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); numDigits = 1 + - (((Tcl_WideInt)big.used * DIGIT_BIT) / numBits); + (((Tcl_WideInt) big.used * DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; mask >>= numBits; @@ -2103,7 +2107,7 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - unsigned long int ul = (unsigned long int) l; + unsigned long ul = (unsigned long) l; bits = (Tcl_WideUInt) ul; while (ul) { @@ -2120,16 +2124,16 @@ Tcl_AppendFormatToObj( numDigits = 1; } pure = Tcl_NewObj(); - Tcl_SetObjLength(pure, (int)numDigits); + Tcl_SetObjLength(pure, (int) numDigits); bytes = TclGetString(pure); - toAppend = length = (int)numDigits; + toAppend = length = (int) numDigits; while (numDigits--) { int digitOffset; if (useBig && big.used) { if ((size_t) shift < CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) { - bits |= (((Tcl_WideUInt)big.dp[index++]) < INT_MAX - length) { - msg=overflow; + msg = overflow; goto errorMsg; } length += precision; @@ -2261,10 +2265,12 @@ Tcl_AppendFormatToObj( } } - numChars = Tcl_GetCharLength(segment); - if (!gotMinus) { + if (width>0 && numChars<0) { + numChars = Tcl_GetCharLength(segment); + } + if (!gotMinus && width>0) { if (numChars < width) { - limit -= (width - numChars); + limit -= width - numChars; } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); @@ -2282,12 +2288,14 @@ Tcl_AppendFormatToObj( if (allocSegment) { Tcl_DecrRefCount(segment); } - if (numChars < width) { - limit -= (width - numChars); - } - while (numChars < width) { - Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); - numChars++; + if (width > 0) { + if (numChars < width) { + limit -= width-numChars; + } + while (numChars < width) { + Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); + numChars++; + } } objIndex += gotSequential; diff --git a/tests/format.test b/tests/format.test index 8aa7d0b..54d9ffb 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.29 2009/07/31 16:55:58 dgp Exp $ +# RCS: @(#) $Id: format.test,v 1.30 2010/01/18 09:31:02 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -23,7 +23,7 @@ testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}] testConstraint wideIs64bit \ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}] testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}] - + test format-1.1 {integer formatting} { format "%*d %d %d %d" 6 34 16923 -12 -1 } { 34 16923 -12 -1} @@ -536,14 +536,11 @@ test format-18.1 {do not demote existing numeric values} { # 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}] @@ -561,15 +558,21 @@ test format-19.1 { set x 0x8fedc654 list [expr { ~ $x }] [format %08x [expr { ~$x }]] } -match regexp -result {-2414724693 f*701239ab} - test format-19.2 {Bug 1867855} { format %llx 0 } 0 - test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 +# Note that this test may fail in future versions +test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body { + set x [dict create a b c d] + format %s $x + # After this, obj in $x should be a dict with a non-NULL bytes field + tcl::unsupported::representation $x +} -match glob -result {value is a dict with *, string representation "*".} + # cleanup catch {unset a} catch {unset b} -- cgit v0.12