Tcl Source Code

Changes On Branch bsg-0d-radix-prefix
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch bsg-0d-radix-prefix Excluding Merge-Ins

This is equivalent to a diff from 66e3be83ac to 7a62143dca

2017-06-23
08:11
TIP #472 implementation: Add Support for 0d Radix Prefix to Integer Literals check-in: 4f68bf6677 user: jan.nijtmans tags: trunk
2017-06-22
08:59
Upgrade all internal character tables to Unicode 10 check-in: f78dec2d2f user: jan.nijtmans tags: core-8-6-branch
08:16
Merge core-8-6-branch Closed-Leaf check-in: 7a62143dca user: jan.nijtmans tags: bsg-0d-radix-prefix
08:15
Add test-cases, testing the legacy behavior of "format %#d" check-in: 66e3be83ac user: jan.nijtmans tags: core-8-6-branch
2017-06-18
14:01
Factor out chunk of non-obvious code in the guts of [oo::define] into one place. check-in: 2bcf10b88e user: dkf tags: core-8-6-branch
2017-06-15
11:01
Merge core-8-6-branch. Fix gcc warning: tclStrToD.c:1180:2: warning: enumeration value ‘ZERO_D’... check-in: cf3e4e5c76 user: jan.nijtmans tags: bsg-0d-radix-prefix

Changes to doc/GetInt.3.

53
54
55
56
57
58
59



60
61
62
63
64
65
66
67
68
69


70
71
72
73
74
75
76
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70


71
72
73
74
75
76
77
78
79







+
+
+








-
-
+
+







\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded and
followed by white space.  If the first two characters of \fIsrc\fR
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
.QW \fB0b\fR
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
decimal point
.QW \fB.\fR ;
a sequence of digits;  the letter
.QW \fBe\fR ;

Changes to doc/expr.n.

39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54







-
+
+







.SS OPERANDS
.PP
A Tcl expression consists of a combination of operands, operators,
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
compatibility with older Tcl releases, an octal integer value is also
indicated simply when the first character of the operand is \fB0\fR,
whether or not the second character is also \fBo\fR.
If an operand does not have one of the integer formats given

Changes to doc/format.n.

85
86
87
88
89
90
91


92
93
94
95
96
97
98
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100







+
+







\fB#\fR
Requests an alternate output form. For \fBo\fR and \fBO\fR
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 \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.
For \fBg\fR and \fBG\fR conversions it specifies that
trailing zeroes should not be removed.
.SS "OPTIONAL FIELD WIDTH"
.PP

Changes to generic/tclLink.c.

673
674
675
676
677
678
679
680

681
682
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
673
674
675
676
677
678
679

680
681
682
683
684
685
686
687
688
689

690
691
692
693
694
695
696
697







-
+









-
+







    return TCL_ERROR;
}


/*
 * 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
GetInvalidIntFromObj(Tcl_Obj *objPtr,
				int *intPtr)
{
    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])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;
    }
    return TCL_ERROR;

Changes to generic/tclStrToD.c.

485
486
487
488
489
490
491
492

493
494
495
496
497
498
499
485
486
487
488
489
490
491

492
493
494
495
496
497
498
499







-
+







				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    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,
	sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
#ifdef IEEE_FLOATING_POINT
	, sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
#endif
652
653
654
655
656
657
658




659
660
661
662
663
664
665
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669







+
+
+
+







	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {
		explicitOctal = 1;
		state = ZERO_O;
		break;
	    }
	    if (c == 'd' || c == 'D') {
		state = ZERO_D;
		break;
	    }
#ifdef KILL_OCTAL
	    goto decimal;
#endif
	    /* FALLTHROUGH */

	case OCTAL:
869
870
871
872
873
874
875










876
877
878
879
880
881
882
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896







+
+
+
+
+
+
+
+
+
+







		    mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
		}
	    }
	    numTrailZeros = 0;
	    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
	     * digits.
	     */

#ifdef KILL_OCTAL
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193







+







	TclFreeIntRep(objPtr);
	switch (acceptState) {
	case SIGNUM:
	case BAD_OCTAL:
	case ZERO_X:
	case ZERO_O:
	case ZERO_B:
	case ZERO_D:
	case LEADING_RADIX_POINT:
	case EXPONENT_START:
	case EXPONENT_SIGNUM:
	case sI:
	case sIN:
	case sINFI:
	case sINFIN:

Changes to generic/tclStringObj.c.

2032
2033
2034
2035
2036
2037
2038




2039
2040
2041
2042
2043
2044
2045
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049







+
+
+
+







		    Tcl_AppendToObj(segment, "0x", 2);
		    segmentLimit -= 2;
		    break;
		case 'b':
		    Tcl_AppendToObj(segment, "0b", 2);
		    segmentLimit -= 2;
		    break;
		case 'd':
		    Tcl_AppendToObj(segment, "0d", 2);
		    segmentLimit -= 2;
		    break;
		}
	    }

	    switch (ch) {
	    case 'd': {
		int length;
		Tcl_Obj *pure;

Changes to tests/cmdIL.test.

215
216
217
218
219
220
221
222
223


224
225
226
227
228
229
230
215
216
217
218
219
220
221


222
223
224
225
226
227
228
229
230







-
-
+
+







test cmdIL-3.9 {SortCompare procedure, -integer option} -body {
    lsort -integer {x 3}
} -returnCodes error -result {expected integer but got "x"}
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"}
test cmdIL-3.13 {SortCompare procedure, -real option} -body {
    lsort -real {3 1x7}
} -returnCodes error -result {expected floating-point number but got "1x7"}
test cmdIL-3.14 {SortCompare procedure, -real option} {

Changes to tests/format.test.

76
77
78
79
80
81
82
83

84
85
86

87
88
89

90
91
92

93
94
95

96
97
98

99
100
101
102
103
104
105
76
77
78
79
80
81
82

83
84
85

86
87
88

89
90
91

92
93
94

95
96
97

98
99
100
101
102
103
104
105







-
+


-
+


-
+


-
+


-
+


-
+







    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
} {0     06                   042                  041033               01777777777777777777764}
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
} {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} {
    format "%s %s %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. x x}
test format-2.2 {string formatting} {
    format "%20s %20s %20c %20s" abcd {This is a very long test string.} 120 x

Changes to tests/link.test.

169
170
171
172
173
174
175





















176
177
178
179
180
181
182
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    set uint 0
    set long 0
    set ulong 0
    set float -60.00e+
    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
} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
    list [catch {set int 4} msg] $msg $int \

Changes to tests/util.test.

548
549
550
551
552
553
554






555
556
557
558
559
560
561
562
563
564
565






566
567
568
569
570
571
572
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584







+
+
+
+
+
+











+
+
+
+
+
+







} a
test util-9.0.6 {TclGetIntForIndex} {
    string index abcd 01
} b
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
test util-9.1.1 {TclGetIntForIndex} {
    string index abcd { 3 }
} d
test util-9.1.2 {TclGetIntForIndex} {
    string index abcdefghijk 0xa
} k
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
test util-9.2.1 {TclGetIntForIndex} -body {
    string index abcd { end}
} -returnCodes error -match glob -result *
666
667
668
669
670
671
672



673
674
675
676
677
678



679
680
681
682
683
684
685
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703







+
+
+






+
+
+







    string index a 0+
} -returnCodes error -match glob -result *
test util-9.30 {TclGetIntForIndex} -body {
    string index a {0+ }
} -returnCodes error -match glob -result *
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 *
test util-9.35 {TclGetIntForIndex} -body {
    string index a 1e23
} -returnCodes error -match glob -result *