summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-03-14 16:28:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-03-14 16:28:03 (GMT)
commit4bc5664112ad0e60507cf6d83a9937c7679560c6 (patch)
tree8275e54d40a4dc3ecc01e3d27d7ea9dd5d6fee47
parent92c8f1305491a082d24d929a3916522a1bd4f8e3 (diff)
downloadtcl-4bc5664112ad0e60507cf6d83a9937c7679560c6.zip
tcl-4bc5664112ad0e60507cf6d83a9937c7679560c6.tar.gz
tcl-4bc5664112ad0e60507cf6d83a9937c7679560c6.tar.bz2
* generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier
that indicates we've got a wide int when we're formatting in an integer style. Stops some libc's from going mad. [Bug #702622] Also tidied whitespace.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCmdAH.c308
-rw-r--r--tests/format.test5
3 files changed, 170 insertions, 150 deletions
diff --git a/ChangeLog b/ChangeLog
index 31694ac..1812e57 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2003-03-14 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Only add the modifier
+ that indicates we've got a wide int when we're formatting in an
+ integer style. Stops some libc's from going mad. [Bug #702622]
+ Also tidied whitespace.
+
2003-03-13 Mo DeJong <mdejong@users.sourceforge.net>
* win/tcl.m4 (SC_WITH_TCL): Port version number
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 03c1c38..aece00f 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.28 2003/03/07 11:38:29 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.29 2003/03/14 16:28:07 dkf Exp $
*/
#include "tclInt.h"
@@ -1967,12 +1967,12 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
Tcl_Obj *resultPtr; /* Where result is stored finally. */
char staticBuf[MAX_FLOAT_SIZE + 1];
- /* A static buffer to copy the format results
+ /* A static buffer to copy the format results
* into */
char *dst = staticBuf; /* The buffer that sprintf writes into each
* time the format processes a specifier */
int dstSize = MAX_FLOAT_SIZE;
- /* The size of the dst buffer */
+ /* The size of the dst buffer */
int noPercent; /* Special case for speed: indicates there's
* no field specifier, just a string to copy.*/
int objIndex; /* Index of argument to substitute next. */
@@ -2010,7 +2010,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
*/
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
@@ -2172,8 +2172,20 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
if (*format == 'l') {
#ifndef TCL_WIDE_INT_IS_LONG
useWide = 1;
- strcpy(newPtr, TCL_LL_MODIFIER);
- newPtr += TCL_LL_MODIFIER_SIZE;
+ /*
+ * Only add a 'll' modifier for integer values as it makes
+ * some libc's go into spasm otherwise. [Bug #702622]
+ */
+ switch (format[1]) {
+ case 'i':
+ case 'd':
+ case 'o':
+ case 'u':
+ case 'x':
+ case 'X':
+ strcpy(newPtr, TCL_LL_MODIFIER);
+ newPtr += TCL_LL_MODIFIER_SIZE;
+ }
#endif /* TCL_WIDE_INT_IS_LONG */
format++;
} else if (*format == 'h') {
@@ -2189,95 +2201,97 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
goto badIndex;
}
switch (*format) {
- case 'i':
- newPtr[-1] = 'd';
- case 'd':
- case 'o':
- case 'u':
- case 'x':
- case 'X':
+ case 'i':
+ newPtr[-1] = 'd';
+ case 'd':
+ case 'o':
+ case 'u':
+ case 'x':
+ case 'X':
#ifndef TCL_WIDE_INT_IS_LONG
- if (useWide) {
- if (Tcl_GetWideIntFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &wideValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = WIDE_VALUE;
- size = 40 + precision;
- break;
- }
-#endif /* TCL_WIDE_INT_IS_LONG */
- 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;
}
-#if (LONG_MAX > INT_MAX)
- /*
- * Add the 'l' for long format type because we are on
- * an LP64 archtecture and we are really going to pass
- * a long argument to sprintf.
- */
- newPtr++;
- *newPtr = 0;
- newPtr[-1] = newPtr[-2];
- newPtr[-2] = 'l';
-#endif /* LONG_MAX > INT_MAX */
- whichValue = INT_VALUE;
+ whichValue = WIDE_VALUE;
size = 40 + precision;
break;
- case 's':
- /*
- * Compute the length of the string in characters and add
- * any additional space required by the field width. All of
- * the extra characters will be spaces, so one byte per
- * character is adequate.
- */
+ }
+#endif /* TCL_WIDE_INT_IS_LONG */
+ 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
+ * LP64 archtecture and we are really going to pass a long
+ * argument to sprintf.
+ */
+ newPtr++;
+ *newPtr = 0;
+ newPtr[-1] = newPtr[-2];
+ newPtr[-2] = 'l';
+#endif /* LONG_MAX > INT_MAX */
+ whichValue = INT_VALUE;
+ size = 40 + precision;
+ break;
+ case 's':
+ /*
+ * Compute the length of the string in characters and add
+ * any additional space required by the field width. All
+ * of the extra characters will be spaces, so one byte per
+ * character is adequate.
+ */
- whichValue = STRING_VALUE;
- ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
- stringLen = Tcl_NumUtfChars(ptrValue, size);
- if (gotPrecision && (precision < stringLen)) {
- stringLen = precision;
- }
- size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
- if (width > stringLen) {
- size += (width - stringLen);
- }
- break;
- case 'c':
- if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &intValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = CHAR_VALUE;
- size = width + TCL_UTF_MAX;
- break;
- case 'e':
- case 'E':
- case 'f':
- case 'g':
- case 'G':
- if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
- objv[objIndex], &doubleValue) != TCL_OK) {
- goto fmtError;
- }
- whichValue = DOUBLE_VALUE;
- size = MAX_FLOAT_SIZE;
- if (precision > 10) {
- size += precision;
- }
- break;
- case 0:
- Tcl_SetResult(interp,
- "format string ended in middle of field specifier",
- TCL_STATIC);
+ whichValue = STRING_VALUE;
+ ptrValue = Tcl_GetStringFromObj(objv[objIndex], &size);
+ stringLen = Tcl_NumUtfChars(ptrValue, size);
+ if (gotPrecision && (precision < stringLen)) {
+ stringLen = precision;
+ }
+ size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
+ if (width > stringLen) {
+ size += (width - stringLen);
+ }
+ break;
+ case 'c':
+ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
- default: {
- char buf[40];
- sprintf(buf, "bad field specifier \"%c\"", *format);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ }
+ whichValue = CHAR_VALUE;
+ size = width + TCL_UTF_MAX;
+ break;
+ case 'e':
+ case 'E':
+ case 'f':
+ case 'g':
+ case 'G':
+ if (Tcl_GetDoubleFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &doubleValue) != TCL_OK) {
goto fmtError;
}
+ whichValue = DOUBLE_VALUE;
+ size = MAX_FLOAT_SIZE;
+ if (precision > 10) {
+ size += precision;
+ }
+ break;
+ case 0:
+ Tcl_SetResult(interp,
+ "format string ended in middle of field specifier",
+ TCL_STATIC);
+ goto fmtError;
+ default:
+ {
+ char buf[40];
+
+ sprintf(buf, "bad field specifier \"%c\"", *format);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ goto fmtError;
+ }
}
objIndex++;
format++;
@@ -2302,103 +2316,99 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
dstSize = size;
}
switch (whichValue) {
- case DOUBLE_VALUE: {
- sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
- break;
- }
+ case DOUBLE_VALUE:
+ sprintf(dst, newFormat, doubleValue); /* INTL: user locale. */
+ break;
#ifndef TCL_WIDE_INT_IS_LONG
- case WIDE_VALUE: {
- sprintf(dst, newFormat, wideValue);
- break;
- }
+ case WIDE_VALUE:
+ sprintf(dst, newFormat, wideValue);
+ break;
#endif /* TCL_WIDE_INT_IS_LONG */
- case INT_VALUE: {
- if (useShort) {
- sprintf(dst, newFormat, (short) intValue);
- } else {
- sprintf(dst, newFormat, intValue);
- }
- break;
+ case INT_VALUE:
+ if (useShort) {
+ sprintf(dst, newFormat, (short) intValue);
+ } else {
+ sprintf(dst, newFormat, intValue);
}
- case CHAR_VALUE: {
- char *ptr;
- char padChar = (gotZero ? '0' : ' ');
- ptr = dst;
- if (!gotMinus) {
- for ( ; --width > 0; ptr++) {
- *ptr = padChar;
- }
- }
- ptr += Tcl_UniCharToUtf(intValue, ptr);
+ break;
+ case CHAR_VALUE: {
+ char *ptr;
+ char padChar = (gotZero ? '0' : ' ');
+ ptr = dst;
+ if (!gotMinus) {
for ( ; --width > 0; ptr++) {
*ptr = padChar;
}
- *ptr = '\0';
- break;
}
- case STRING_VALUE: {
- char *ptr;
- char padChar = (gotZero ? '0' : ' ');
- int pad;
-
- ptr = dst;
- if (width > stringLen) {
- pad = width - stringLen;
- } else {
- pad = 0;
- }
+ ptr += Tcl_UniCharToUtf(intValue, ptr);
+ for ( ; --width > 0; ptr++) {
+ *ptr = padChar;
+ }
+ *ptr = '\0';
+ break;
+ }
+ case STRING_VALUE: {
+ char *ptr;
+ char padChar = (gotZero ? '0' : ' ');
+ int pad;
- if (!gotMinus) {
- while (pad > 0) {
- *ptr++ = padChar;
- pad--;
- }
- }
+ ptr = dst;
+ if (width > stringLen) {
+ pad = width - stringLen;
+ } else {
+ pad = 0;
+ }
- size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
- if (size) {
- memcpy(ptr, ptrValue, (size_t) size);
- ptr += size;
- }
+ if (!gotMinus) {
while (pad > 0) {
*ptr++ = padChar;
pad--;
}
- *ptr = '\0';
- break;
}
- default: {
- sprintf(dst, newFormat, ptrValue);
- break;
+
+ size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
+ if (size) {
+ memcpy(ptr, ptrValue, (size_t) size);
+ ptr += size;
+ }
+ while (pad > 0) {
+ *ptr++ = padChar;
+ pad--;
}
+ *ptr = '\0';
+ break;
+ }
+ default:
+ sprintf(dst, newFormat, ptrValue);
+ break;
}
Tcl_AppendToObj(resultPtr, dst, -1);
}
}
Tcl_SetObjResult(interp, resultPtr);
- if(dst != staticBuf) {
- ckfree(dst);
+ if (dst != staticBuf) {
+ ckfree(dst);
}
return TCL_OK;
mixedXPG:
Tcl_SetResult(interp,
- "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
+ "cannot mix \"%\" and \"%n$\" conversion specifiers", TCL_STATIC);
goto fmtError;
badIndex:
if (gotXpg) {
- Tcl_SetResult(interp,
- "\"%n$\" argument index out of range", TCL_STATIC);
+ Tcl_SetResult(interp,
+ "\"%n$\" argument index out of range", TCL_STATIC);
} else {
- Tcl_SetResult(interp,
- "not enough arguments for all format specifiers", TCL_STATIC);
+ Tcl_SetResult(interp,
+ "not enough arguments for all format specifiers", TCL_STATIC);
}
fmtError:
- if(dst != staticBuf) {
- ckfree(dst);
+ if (dst != staticBuf) {
+ ckfree(dst);
}
Tcl_DecrRefCount(resultPtr);
return TCL_ERROR;
diff --git a/tests/format.test b/tests/format.test
index 567bc9e..4050ed3 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 2002/06/22 04:19:47 dgp Exp $
+# RCS: @(#) $Id: format.test,v 1.12 2003/03/14 16:28:07 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -501,6 +501,9 @@ test format-17.2 {testing %ld with wide} {64bitInts} {
test format-17.3 {testing %ld with non-wide} {64bitInts} {
format %ld 42
} 42
+test format-17.4 {testing %l with non-integer} {
+ format %lf 1
+} 1.000000
# cleanup
catch {unset a}