Attachment "bin2.patch" to
ticket [2368084fff]
added by
ferrieux
2008-12-09 04:19:35.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.408
diff -u -r1.408 tclInt.h
--- generic/tclInt.h 5 Dec 2008 14:27:36 -0000 1.408
+++ generic/tclInt.h 8 Dec 2008 21:15:36 -0000
@@ -2461,6 +2461,8 @@
/* Use [scan] rules dealing with 0? prefixes */
#define TCL_PARSE_NO_WHITESPACE 32
/* Reject leading/trailing whitespace */
+#define TCL_PARSE_BINARY_ONLY 64
+ /* Parse binary even without prefix */
/*
*----------------------------------------------------------------------
Index: generic/tclScan.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclScan.c,v
retrieving revision 1.29
diff -u -r1.29 tclScan.c
--- generic/tclScan.c 19 Jul 2008 22:50:42 -0000 1.29
+++ generic/tclScan.c 8 Dec 2008 21:15:37 -0000
@@ -405,6 +405,7 @@
case 'i':
case 'o':
case 'x':
+ case 'b':
break;
case 'u':
if (flags & SCAN_BIG) {
@@ -732,6 +733,10 @@
op = 'i';
parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
break;
+ case 'b':
+ op = 'i';
+ parseFlag |= TCL_PARSE_BINARY_ONLY;
+ break;
case 'u':
op = 'i';
parseFlag |= TCL_PARSE_DECIMAL_ONLY;
Index: generic/tclStrToD.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStrToD.c,v
retrieving revision 1.34
diff -u -r1.34 tclStrToD.c
--- generic/tclStrToD.c 1 Apr 2008 20:08:22 -0000 1.34
+++ generic/tclStrToD.c 8 Dec 2008 21:15:40 -0000
@@ -369,6 +369,8 @@
break;
} else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
goto zerox;
+ } else if (flags & TCL_PARSE_BINARY_ONLY) {
+ goto zerob;
} else if (flags & TCL_PARSE_OCTAL_ONLY) {
goto zeroo;
} else if (isdigit(UCHAR(c))) {
@@ -395,9 +397,9 @@
case ZERO:
/*
* Scanned a leading zero (perhaps with a + or -). Acceptable
- * inputs are digits, period, X, and E. If 8 or 9 is encountered,
+ * inputs are digits, period, X, b, and E. If 8 or 9 is encountered,
* the number can't be octal. This state and the OCTAL state
- * differ only in whether they recognize 'X'.
+ * differ only in whether they recognize 'X' and 'b'.
*/
acceptState = state;
@@ -417,6 +419,9 @@
state = ZERO_B;
break;
}
+ if (flags & TCL_PARSE_BINARY_ONLY) {
+ goto zerob;
+ }
if (c == 'o' || c == 'O') {
explicitOctal = 1;
state = ZERO_O;
@@ -602,6 +607,7 @@
acceptPoint = p;
acceptLen = len;
case ZERO_B:
+ zerob:
if (c == '0') {
++numTrailZeros;
state = BINARY;
Index: generic/tclStringObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStringObj.c,v
retrieving revision 1.74
diff -u -r1.74 tclStringObj.c
--- generic/tclStringObj.c 26 Oct 2008 18:34:04 -0000 1.74
+++ generic/tclStringObj.c 8 Dec 2008 21:15:42 -0000
@@ -1943,7 +1943,8 @@
case 'd':
case 'o':
case 'x':
- case 'X': {
+ case 'X':
+ case 'b': {
short int s = 0; /* Silence compiler warning; only defined and
* used when useShort is true. */
long l;
@@ -2016,6 +2017,9 @@
case 'X':
Tcl_AppendToObj(segment, "0x", 2);
break;
+ case 'b':
+ Tcl_AppendToObj(segment, "0b", 2);
+ break;
}
}
@@ -2074,7 +2078,8 @@
case 'u':
case 'o':
case 'x':
- case 'X': {
+ case 'X':
+ case 'b': {
Tcl_WideUInt bits = (Tcl_WideUInt)0;
int length, numBits = 4, numDigits = 0, base = 16;
int index = 0, shift = 0;
@@ -2083,10 +2088,12 @@
if (ch == 'u') {
base = 10;
- }
- if (ch == 'o') {
+ } else if (ch == 'o') {
base = 8;
numBits = 3;
+ } else if (ch=='b') {
+ base = 2;
+ numBits = 1;
}
if (useShort) {
unsigned short int us = (unsigned short int) s;
Index: tests/format.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/format.test,v
retrieving revision 1.27
diff -u -r1.27 format.test
--- tests/format.test 19 Jul 2008 22:50:39 -0000 1.27
+++ tests/format.test 8 Dec 2008 21:15:43 -0000
@@ -77,6 +77,9 @@
test format-1.11.1 {integer formatting} longIs64bit {
format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
} {06 042 041033 01777777777777777777764}
+test format-1.12 {integer formatting} {
+ format "%b %#b %llb" 5 5 [expr {2**100}]
+} {101 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-2.1 {string formatting} {
format "%s %s %c %s" abcd {This is a very long test string.} 120 x
Index: tests/scan.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/scan.test,v
retrieving revision 1.22
diff -u -r1.22 scan.test
--- tests/scan.test 19 Jul 2008 22:50:39 -0000 1.22
+++ tests/scan.test 8 Dec 2008 21:15:44 -0000
@@ -19,7 +19,7 @@
}
testConstraint wideIs64bit \
- [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+ [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
test scan-1.1 {BuildCharSet, CharInSet} {
list [scan foo {%[^o]} x] $x
@@ -248,10 +248,14 @@
catch {unset x}
list [scan {xF} {%x} x] [info exists x]
} {0 0}
+test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} {
+ set x {}
+ list [scan {1001 0b101 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} {%b %b %llb} x y z] $x $y $z
+} {3 9 5 340282366920938463463374607431768211456}
test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
set x {}
- list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
-} {3 10 8 16}
+ list [scan {10 010 0x10 0b10} {%i%i%i%i} x y z t] $x $y $z $t
+} {4 10 8 16 2}
test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
set x {}
list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
Index: doc/format.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/format.n,v
retrieving revision 1.21
diff -u -r1.21 format.n
--- doc/format.n 17 Oct 2008 10:22:25 -0000 1.21
+++ doc/format.n 8 Dec 2008 21:15:44 -0000
@@ -87,6 +87,8 @@
conversions it guarantees that the first digit is always \fB0\fR.
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
will be added to the beginning of the result unless it is zero.
+For \fBb\fR conversions, \fB0b\fR
+will be added to the beginning of the result unless it is zero.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
@@ -161,6 +163,9 @@
.QW 0123456789ABCDEF
for \fBX\fR).
.TP 10
+\fBb\fR
+Convert integer to binary string, using digits 0 and 1.
+.TP 10
\fBc\fR
Convert integer to the Unicode character it represents.
.TP 10
@@ -203,6 +208,7 @@
.IP [3]
The size modifiers are ignored when formatting floating-point values.
The \fBll\fR modifier has no \fBsprintf\fR counterpart.
+The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
Convert the numeric value of a UNICODE character to the character
Index: doc/scan.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/scan.n,v
retrieving revision 1.26
diff -u -r1.26 scan.n
--- doc/scan.n 17 Oct 2008 10:22:25 -0000 1.26
+++ doc/scan.n 8 Dec 2008 21:15:45 -0000
@@ -104,6 +104,12 @@
It is read in and the integer value is stored in the variable,
truncated as required by the size modifier value.
.TP 10
+\fBb\fR
+.
+The input substring must be a binary integer.
+It is read in and the integer value is stored in the variable,
+truncated as required by the size modifier value.
+.TP 10
\fBu\fR
.
The input substring must be a decimal integer.
