summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/GetInt.37
-rw-r--r--doc/expr.n3
-rw-r--r--doc/format.n2
-rw-r--r--generic/tclLink.c4
-rw-r--r--generic/tclStrToD.c17
-rw-r--r--generic/tclStringObj.c4
-rw-r--r--tests/cmdIL.test4
-rw-r--r--tests/format.test12
-rw-r--r--tests/link.test21
-rw-r--r--tests/util.test18
10 files changed, 78 insertions, 14 deletions
diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 5a3304a..eba549d 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -57,6 +57,9 @@ after the optional white space and sign are
.QW \fB0x\fR
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
if the first such characters are
+.QW \fB0d\fR
+then \fIsrc\fR is expected to be in decimal form; otherwise,
+if the first such characters are
.QW \fB0o\fR
then \fIsrc\fR is expected to be in octal form; otherwise,
if the first such characters are
@@ -65,8 +68,8 @@ then \fIsrc\fR is expected to be in binary form; otherwise,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
-is expected to be in octal form; otherwise, \fIsrc\fR is
-expected to be in decimal form.
+is expected to be in octal form; otherwise, \fIsrc\fR
+is expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
diff --git a/doc/expr.n b/doc/expr.n
index b76b6a2..b2723c7 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -43,7 +43,8 @@ parentheses and commas.
White space may be used between the operands and operators and
parentheses (or commas); it is ignored by the expression's instructions.
Where possible, operands are interpreted as integer values.
-Integer values may be specified in decimal (the normal case), in binary
+Integer values may be specified in decimal (the normal case, the optional
+first two characters are \fB0d\fR), in binary
(if the first two characters of the operand are \fB0b\fR), in octal
(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
(if the first two characters of the operand are \fB0x\fR). For
diff --git a/doc/format.n b/doc/format.n
index ba044f2..4eb566d 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -89,6 +89,8 @@ 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 \fBd\fR conversions, \fB0d\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.
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 7d1e3a8..70fe7d1 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -677,7 +677,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
@@ -687,7 +687,7 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr,
const char *str = TclGetString(objPtr);
if ((objPtr->length == 0) ||
- ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
+ ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
*intPtr = 0;
return TCL_OK;
} else if ((objPtr->length == 1) && strchr("+-", str[0])) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 2091928..5e49846 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -489,7 +489,7 @@ TclParseNumber(
{
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
- ZERO_O, ZERO_B, BINARY,
+ ZERO_O, ZERO_B, ZERO_D, BINARY,
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
@@ -657,6 +657,10 @@ TclParseNumber(
state = ZERO_O;
break;
}
+ if (c == 'd' || c == 'D') {
+ state = ZERO_D;
+ break;
+ }
#ifdef KILL_OCTAL
goto decimal;
#endif
@@ -873,6 +877,16 @@ TclParseNumber(
state = BINARY;
break;
+ case ZERO_D:
+ if (c == '0') {
+ numTrailZeros++;
+ } else if ( ! isdigit(UCHAR(c))) {
+ goto endgame;
+ }
+ state = DECIMAL;
+ flags |= TCL_PARSE_INTEGER_ONLY;
+ /* FALLTHROUGH */
+
case DECIMAL:
/*
* Scanned an optional + or - followed by a string of decimal
@@ -1169,6 +1183,7 @@ TclParseNumber(
case ZERO_X:
case ZERO_O:
case ZERO_B:
+ case ZERO_D:
case LEADING_RADIX_POINT:
case EXPONENT_START:
case EXPONENT_SIGNUM:
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 4a3b6f1..b84470b 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2036,6 +2036,10 @@ Tcl_AppendFormatToObj(
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
+ case 'd':
+ Tcl_AppendToObj(segment, "0d", 2);
+ segmentLimit -= 2;
+ break;
}
}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 23a5f96..70ac6bb 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -219,8 +219,8 @@ test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
lsort -integer {3 q}
} -returnCodes error -result {expected integer but got "q"}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
- lsort -integer {35 21 0x20 30 0o23 100 8}
-} {8 0o23 21 30 0x20 35 100}
+ lsort -integer {35 21 0x20 0d30 0o23 100 8}
+} {8 0o23 21 0d30 0x20 35 100}
test cmdIL-3.12 {SortCompare procedure, -real option} -body {
lsort -real {6...4 3}
} -returnCodes error -result {expected floating-point number but got "6...4"}
diff --git a/tests/format.test b/tests/format.test
index 2795ac2..8842315 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -80,22 +80,22 @@ test format-1.12 {integer formatting} {
} {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-1.13 {integer formatting} longIs32bit {
format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12}
+} {0d0 0d6 0d34 0d16923 -0d12}
test format-1.13.1 {integer formatting} longIs64bit {
format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12}
+} {0d0 0d6 0d34 0d16923 -0d12}
test format-1.14 {integer formatting} longIs32bit {
format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
-} { 0 6 34 16923 -12}
+} { 0d0 0d6 0d34 0d16923 -0d12}
test format-1.14.1 {integer formatting} longIs64bit {
format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
-} { 0 6 34 16923 -12}
+} { 0d0 0d6 0d34 0d16923 -0d12}
test format-1.15 {integer formatting} longIs32bit {
format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12 }
+} {0d0 0d6 0d34 0d16923 -0d12 }
test format-1.15.1 {integer formatting} longIs64bit {
format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12 }
+} {0d0 0d6 0d34 0d16923 -0d12 }
test format-2.1 {string formatting} {
diff --git a/tests/link.test b/tests/link.test
index 6bff356..a12759d 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -173,6 +173,27 @@ test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup {
set uwide 0
concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -60.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -60.00e+ 0}
+test link-2.10 {writing C variables from Tcl} -constraints {testlink} -setup {
+ testlink delete
+} -body {
+ testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
+ testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ set int "0x"
+ set real "0b"
+ set bool 0
+ set string "0"
+ set wide "0D"
+ set char "0X"
+ set uchar "0B"
+ set short "0D"
+ set ushort "0x"
+ set uint "0b"
+ set long "0d"
+ set ulong "0X"
+ set float "0B"
+ set uwide "0D"
+ concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
+} -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0D 0X 0B 0D 0x 0b 0d 0X 0B 0D}
test link-3.1 {read-only variables} -constraints {testlink} -setup {
testlink delete
diff --git a/tests/util.test b/tests/util.test
index 2ac11bf..46bb945 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -552,6 +552,12 @@ test util-9.0.6 {TclGetIntForIndex} {
test util-9.0.7 {TclGetIntForIndex} {
string index abcd { 01 }
} b
+test util-9.0.8 {TclGetIntForIndex} {
+ string index abcd { 0d0 }
+} a
+test util-9.0.9 {TclGetIntForIndex} {
+ string index abcd { -0d0 }
+} a
test util-9.1.0 {TclGetIntForIndex} {
string index abcd 3
} d
@@ -564,6 +570,12 @@ test util-9.1.2 {TclGetIntForIndex} {
test util-9.1.3 {TclGetIntForIndex} {
string index abcdefghijk { 0xa }
} k
+test util-9.1.4 {TclGetIntForIndex} {
+ string index abcdefghijk 0d10
+} k
+test util-9.1.5 {TclGetIntForIndex} {
+ string index abcdefghijk { 0d10 }
+} k
test util-9.2.0 {TclGetIntForIndex} {
string index abcd end
} d
@@ -671,12 +683,18 @@ test util-9.30 {TclGetIntForIndex} -body {
test util-9.31 {TclGetIntForIndex} -body {
string index a 0x
} -returnCodes error -match glob -result *
+test util-9.31.1 {TclGetIntForIndex} -body {
+ string index a 0d
+} -returnCodes error -match glob -result *
test util-9.32 {TclGetIntForIndex} -body {
string index a 0x1FFFFFFFF+0
} -returnCodes error -match glob -result *
test util-9.33 {TclGetIntForIndex} -body {
string index a 100000000000+0
} -returnCodes error -match glob -result *
+test util-9.33.1 {TclGetIntForIndex} -body {
+ string index a 0d100000000000+0
+} -returnCodes error -match glob -result *
test util-9.34 {TclGetIntForIndex} -body {
string index a 1.0
} -returnCodes error -match glob -result *
generated by cgit v0.12 at 2024-09-12 05:06:34 (GMT)