Attachment "format64.patch" to
ticket [219223ffff]
added by
dkf
2001-03-19 20:06:49.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.381
diff -u -r1.381 ChangeLog
--- ChangeLog 2001/03/15 14:36:32 1.381
+++ ChangeLog 2001/03/19 13:04:15
@@ -1,3 +1,21 @@
+2001-03-19 Donal K. Fellows <[email protected]>
+
+ * doc/scan.n: Changed to indicate that the 'l' format modifier is
+ now supported for integer values.
+ * doc/format.n: Changed to indicate that the 'l' format modifier
+ is now supported for integer values.
+ * tests/format.test (format-1.12,format-1.13): Improved tests so
+ as to check for correct behaviour of 'l' format modifier, but at
+ least one test is non-portable.
+ * tests/scan.test (scan-4.62,scan-4.63,scan-4.64): Improved tests
+ so as to give more informative failure message and added test for
+ large-range decimal case.
+ * generic/tclCmdAH.c (Tcl_FormatObjCmd): Added support for 'l'
+ format modifier on integer values.
+ * generic/tclScan.c (Tcl_ScanObjCmd): Added support for 'l' format
+ modifier on integer values.
+ * generic/tclCmdMZ.c: Removed flags which were moved to tclScan.c
+
2001-03-15 Donal K. Fellows <[email protected]>
* tests/set-old.test (set-old-7.2): Changed error behaviour of
Index: doc/format.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/format.n,v
retrieving revision 1.5
diff -u -r1.5 format.n
--- doc/format.n 2000/09/07 14:27:48 1.5
+++ doc/format.n 2001/03/19 13:04:16
@@ -131,7 +131,12 @@
If it is \fBh\fR it specifies that the numeric value should be
truncated to a 16-bit value before converting.
This option is rarely useful.
-The \fBl\fR modifier is ignored.
+.VS 8.4
+The \fBl\fR modifier is effectively ignored except on 64-bit
+architectures where it is necessary if you are trying to format a
+number whose \fIsigned\fR representation will not fit in a 32-bit
+word.
+.VE
.PP
The last thing in a conversion specifier is an alphabetic character
that determines what kind of conversion to perform.
@@ -203,12 +208,13 @@
For \fB%c\fR conversions the argument must be a decimal string,
which will then be converted to the corresponding character value.
.IP [3]
-The \fBl\fR modifier is ignored; integer values are always converted
-as if there were no modifier present and real values are always
+The \fBl\fR modifier is ignored for real values, which are always
converted as if the \fBl\fR modifier were present (i.e. type
\fBdouble\fR is used for the internal representation).
If the \fBh\fR modifier is specified then integer values are truncated
to \fBshort\fR before conversion.
+Note that there is no difference between using and omitting the
+\fBl\fR modifier on 32-bit architectures.
.SH "SEE ALSO"
sprintf(3), string(n)
Index: doc/scan.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/scan.n,v
retrieving revision 1.7
diff -u -r1.7 scan.n
--- doc/scan.n 2000/12/10 03:27:03 1.7
+++ doc/scan.n 2001/03/19 13:04:16
@@ -70,6 +70,17 @@
is generated, or in the inline case, any position can be specified
at most once and the empty positions will be filled in with empty strings.
.PP
+.VS 8.4
+The next character (after the \fB%\fR and any positional specifier)
+may be an optional modifier; \fBh\fR, \fBl\fR, or \fBL\fR. The
+\fBh\fR modifier is always ignored, and the \fBl\fR and \fBL\fR
+modifiers only have meaning for integer values, and then only on
+64-bit platforms where they specify that the value scanned be
+interpreted as a long value. This can make a difference when the
+value scanned is close to the limits of representation of, or not
+representable at all, in a 32-bit integer.
+.VE
+.PP
The following conversion characters are supported:
.TP 10
\fBd\fR
@@ -177,11 +188,13 @@
corresponding \fIvarName\fR;
no field width may be specified for this conversion.
.IP [3]
-The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored; integer
-values are always converted as if there were no modifier present
-and real values are always converted as if the \fBl\fR modifier
-were present (i.e. type \fBdouble\fR is used for the internal
-representation).
+.VS 8.4
+The \fBl\fR, \fBh\fR, and \fBL\fR modifiers are ignored for real
+values, which are converted as if the \fBl\fR modifier were present
+(i.e. type \fBdouble\fR is used for the internal representation), and
+only the \fBl\fR and \fBL\fR modifiers have any meaning for integer
+values (and then only on 64-bit architectures.)
+.VE
.IP [4]
.VS 8.3
If the end of the input string is reached before any conversions have been
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.12
diff -u -r1.12 tclCmdAH.c
--- generic/tclCmdAH.c 2000/01/21 02:25:26 1.12
+++ generic/tclCmdAH.c 2001/03/19 13:04:16
@@ -1932,13 +1932,15 @@
* ("e", "s", etc.), width, and precision. */
int intValue; /* Used to hold value to pass to sprintf, if
* it's a one-word integer or char value */
+ long longValue; /* Used to hold value to pass to sprintf, if
+ * it's a long integer */
char *ptrValue = NULL; /* Used to hold value to pass to sprintf, if
* it's a one-word value. */
double doubleValue; /* Used to hold value to pass to sprintf if
* it's a double value. */
- int whichValue; /* Indicates which of intValue, ptrValue,
- * or doubleValue has the value to pass to
- * sprintf, according to the following
+ int whichValue; /* Indicates which of intValue/longValue,
+ * ptrValue, or doubleValue has the value to
+ * pass to sprintf, according to the following
* definitions: */
# define INT_VALUE 0
# define CHAR_VALUE 1
@@ -1964,6 +1966,7 @@
* (non-XPG3) conversion specifier has been
* seen. */
int useShort; /* Value to be printed is short (half word). */
+ int useLong; /* Value to be printed is long (double word). */
char *end; /* Used to locate end of numerical fields. */
int stringLen = 0; /* Length of string in characters rather
* than bytes. Used for %s substitution. */
@@ -2000,7 +2003,7 @@
while (format < endPtr) {
register char *newPtr = newFormat;
- width = precision = noPercent = useShort = 0;
+ width = precision = noPercent = useShort = useLong = 0;
gotZero = gotMinus = gotPrecision = 0;
whichValue = PTR_VALUE;
@@ -2145,6 +2148,9 @@
}
}
if (*format == 'l') {
+ useLong = 1;
+ *newPtr = 'l';
+ newPtr++;
format++;
} else if (*format == 'h') {
useShort = 1;
@@ -2166,7 +2172,12 @@
case 'u':
case 'x':
case 'X':
- if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
+ if (useLong) {
+ if (Tcl_GetLongFromObj(interp, /* INTL: Tcl source. */
+ objv[objIndex], &longValue) != TCL_OK) {
+ goto fmtError;
+ }
+ } else if (Tcl_GetIntFromObj(interp, /* INTL: Tcl source. */
objv[objIndex], &intValue) != TCL_OK) {
goto fmtError;
}
@@ -2257,6 +2268,8 @@
case INT_VALUE: {
if (useShort) {
sprintf(dst, newFormat, (short) intValue);
+ } else if (useLong) {
+ sprintf(dst, newFormat, longValue);
} else {
sprintf(dst, newFormat, intValue);
}
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.32
diff -u -r1.32 tclCmdMZ.c
--- generic/tclCmdMZ.c 2001/03/13 11:10:44 1.32
+++ generic/tclCmdMZ.c 2001/03/19 13:04:16
@@ -22,22 +22,6 @@
#include "tclRegexp.h"
/*
- * Flag values used by Tcl_ScanObjCmd.
- */
-
-#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */
-#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */
-#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
-#define SCAN_WIDTH 0x8 /* A width value was supplied. */
-
-#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */
-#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */
-#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */
-#define SCAN_XOK 0x80 /* An 'x' is allowed. */
-#define SCAN_PTOK 0x100 /* Decimal point is allowed. */
-#define SCAN_EXPOK 0x200 /* An exponent is allowed. */
-
-/*
* Structure used to hold information about variable traces:
*/
Index: generic/tclScan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclScan.c,v
retrieving revision 1.7
diff -u -r1.7 tclScan.c
--- generic/tclScan.c 2000/12/10 03:27:04 1.7
+++ generic/tclScan.c 2001/03/19 13:04:16
@@ -28,8 +28,8 @@
#define SCAN_XOK 0x80 /* An 'x' is allowed. */
#define SCAN_PTOK 0x100 /* Decimal point is allowed. */
#define SCAN_EXPOK 0x200 /* An exponent is allowed. */
+#define SCAN_LONGINT 0x400 /* Long value being scanned. */
-
/*
* The following structure contains the information associated with
* a character set.
@@ -660,10 +660,13 @@
}
/*
- * Ignore size specifier.
+ * Handle size specifier.
*/
- if ((ch == 'l') || (ch == 'L') || (ch == 'h')) {
+ if ((ch == 'l') || (ch == 'L')) {
+ flags |= SCAN_LONGINT;
+ format += Tcl_UtfToUniChar(format, &ch);
+ } else if (ch == 'h') {
format += Tcl_UtfToUniChar(format, &ch);
}
@@ -954,12 +957,22 @@
if (!(flags & SCAN_SUPPRESS)) {
*end = '\0';
- value = (int) (*fn)(buf, NULL, base);
- if ((flags & SCAN_UNSIGNED) && (value < 0)) {
- sprintf(buf, "%u", value); /* INTL: ISO digit */
- objPtr = Tcl_NewStringObj(buf, -1);
+ if (flags & SCAN_LONGINT) {
+ long longValue = (*fn)(buf, NULL, base);
+ if ((flags & SCAN_UNSIGNED) && (longValue < 0L)) {
+ sprintf(buf, "%lu", longValue); /* INTL: ISO digit */
+ objPtr = Tcl_NewStringObj(buf, -1);
+ } else {
+ objPtr = Tcl_NewLongObj(longValue);
+ }
} else {
- objPtr = Tcl_NewIntObj(value);
+ value = (int) (*fn)(buf, NULL, base);
+ if ((flags & SCAN_UNSIGNED) && (value < 0)) {
+ sprintf(buf, "%u", value); /* INTL: ISO digit */
+ objPtr = Tcl_NewStringObj(buf, -1);
+ } else {
+ objPtr = Tcl_NewIntObj(value);
+ }
}
Tcl_IncrRefCount(objPtr);
objs[objIndex++] = objPtr;
Index: tests/format.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/format.test,v
retrieving revision 1.8
diff -u -r1.8 format.test
--- tests/format.test 2000/04/10 17:18:59 1.8
+++ tests/format.test 2001/03/19 13:04:16
@@ -68,6 +68,15 @@
test format-1.11 {integer formatting} {nonPortable} {
format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
} {06 042 041033 037777777764 }
+test format-1.12 {integer formatting, long value with specifier} {
+ format "%lx" 4294967290
+} {fffffffa}
+
+# This test only works with 64-bit longs, so it is non-portable.
+
+test format-1.13 {integer formatting, long value without specifier} {nonPortable} {
+ list [catch {format "%x" 4294967290} msg] $msg
+} {1 {integer value too large to represent as non-long integer}}
test format-2.1 {string formatting} {
format "%s %s %c %s" abcd {This is a very long test string.} 120 x
@@ -499,15 +508,3 @@
catch {unset d}
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
Index: tests/scan.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/scan.test,v
retrieving revision 1.11
diff -u -r1.11 scan.test
--- tests/scan.test 2000/12/10 03:27:04 1.11
+++ tests/scan.test 2001/03/19 13:04:16
@@ -336,18 +336,30 @@
test scan-4.62 {scanning of large and negative octal integers} {
foreach { MIN_INT MAX_INT } [int_range] {}
- set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
- list [scan $scanstring {%o %o %o} a b c] \
- [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+ set scanstring [format {%lo %lo %lo} -1 $MIN_INT $MAX_INT]
+ list [scan $scanstring {%lo %lo %lo} a b c] \
+ [expr { $a == -1 ? 1 : ">>$a<<" }] \
+ [expr { $b == $MIN_INT ? 1 : ">>$b<<" }] \
+ [expr { $c == $MAX_INT ? 1 : ">>$c<<" }]
} {3 1 1 1}
test scan-4.63 {scanning of large and negative hex integers} {
foreach { MIN_INT MAX_INT } [int_range] {}
- set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
- list [scan $scanstring {%x %x %x} a b c] \
- [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
+ set scanstring [format {%lx %lx %lx} -1 $MIN_INT $MAX_INT]
+ list [scan $scanstring {%lx %lx %lx} a b c] \
+ [expr { $a == -1 ? 1 : ">>$a<<" }] \
+ [expr { $b == $MIN_INT ? 1 : ">>$b<<" }] \
+ [expr { $c == $MAX_INT ? 1 : ">>$c<<" }]
} {3 1 1 1}
+test scan-4.64 {scanning of large and negative decimal integers} {
+ foreach { MIN_INT MAX_INT } [int_range] {}
+ set scanstring [format {%ld %ld %ld} -1 $MIN_INT $MAX_INT]
+ list [scan $scanstring {%ld %ld %ld} a b c] \
+ [expr { $a == -1 ? 1 : ">>$a<<" }] \
+ [expr { $b == $MIN_INT ? 1 : ">>$b<<" }] \
+ [expr { $c == $MAX_INT ? 1 : ">>$c<<" }]
+} {3 1 1 1}
-# clean up from last two tests
+# clean up from last three tests
catch {
rename int_range {}
