Rebase to core-8-6-branch (who told that fossil doesn't know how to rebase ....)

10 files changed, 94 insertions, 12 deletions

diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 3e7204c..eba549d 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -4,7 +4,7 @@
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" 
+'\"
 .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures"
 .so man.macros
 .BS
@@ -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 67b6482..4377832 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
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 9afedd9..8842315 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -78,6 +78,25 @@ test format-1.11.1 {integer formatting} longIs64bit {
 test format-1.12 {integer formatting} {
     format "%b %#b %#b %llb" 5 0 5 [expr {2**100}]
 } {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
+test format-1.13 {integer formatting} longIs32bit {
+    format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
+} {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
+} {0d0 0d6 0d34 0d16923 -0d12}
+test format-1.14 {integer formatting} longIs32bit {
+    format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
+} {  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
+} {  0d0                  0d6                 0d34              0d16923           -0d12}
+test format-1.15 {integer formatting} longIs32bit {
+    format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
+} {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
+} {0d0   0d6                  0d34                 0d16923              -0d12      }
+
 
 test format-2.1 {string formatting} {
     format "%s %s %c %s" abcd {This is a very long test string.} 120 x
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 7782f35..46bb945 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -208,7 +208,7 @@ test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
 } \xe0
 test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
     # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
-    # symptoms was Bug #2055782. 
+    # symptoms was Bug #2055782.
     testconcatobj
 } {}
 
@@ -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,9 +570,15 @@ 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 
+} d
 test util-9.2.1 {TclGetIntForIndex} -body {
     string index abcd { end}
 } -returnCodes error -match glob -result *
@@ -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 *
@@ -4007,7 +4025,7 @@ test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
     }
     set r
 } [list {*}{
-    0x43fffffffffffffc 0xc3fffffffffffffc 
+    0x43fffffffffffffc 0xc3fffffffffffffc
     0x43fffffffffffffc 0xc3fffffffffffffc
     0x43fffffffffffffd 0xc3fffffffffffffd
     0x43fffffffffffffe 0xc3fffffffffffffe