Tcl Source Code

Changes On Branch tip-551
Login

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

Changes In Branch tip-551 Excluding Merge-Ins

This is equivalent to a diff from 76f0ccb22a to 002a6fdc7d

2020-05-30
23:47
tip-551 implementation. check-in: 3785bbf5a3 user: griffin tags: core-8-branch
2020-05-23
03:32
Update for TIP-551:

Add documentation for this feature to the expr man page. The keyword "integ... Closed-Leaf check-in: 002a6fdc7d user: griffin tags: tip-551

2019-12-07
18:25
merge-mark check-in: 2ccf0dd179 user: jan.nijtmans tags: core-8-branch
05:52
Initial implementation for TIP-551 Permit underscores in numeric literals check-in: 64b80d4ecd user: griffin tags: tip-551
05:46
Create new branch named "tip-551" check-in: 21eb23dc11 user: griffin tags: tip-551
2019-12-06
16:02
merge 8.7 check-in: 7dc752550c user: dgp tags: trunk
14:38
Merge 8.6 check-in: 76f0ccb22a user: jan.nijtmans tags: core-8-branch
14:35
Unnecessary double ;; in tclTimer.c. Update compat/zlib to exactly the same content as in the core-8... check-in: 9cd9b0463a user: jan.nijtmans tags: core-8-6-branch
13:47
merge-mark check-in: 771f469916 user: jan.nijtmans tags: core-8-branch

Changes to doc/expr.n.

13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27







-
+







.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
42
43
44
45
46
47
48
















49
50
51
52
53
54
55







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form.  For
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR.  The
following are all valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values.  An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
An operand may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
\fBboolean\fR.
99
100
101
102
103
104
105











































106
107
108
109
110
111
112
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139







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







.CS
.ta 9c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.PP
\fBInteger value\fR
.PP
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form.  For
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
.PP
\fBFloating-point value\fR
.PP
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR.  The
following are all valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values.  An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
\fBBoolean value\fR
.PP
A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR,
or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR.
.PP
\fBDigit Separator\fR
.PP
Digits in any numeric value may be separated with one or more underscore
characters, "\fB_\fR", to improve readability.  These separators may only
appear between digits.  The separator may not appear at the start of a
numeric value, between the leading 0 and radix specifier, or at the
end of a numeric value.  Here are some examples:
.PP
.CS
.ta 9c
\fBexpr\fR 100_000_000		\fI100000000\fR
\fBexpr\fR 0xffff_ffff		\fI4294967295\fR
\fBformat\fR 0x%x 0b1111_1110_1101_1011		\fI0xfedb\fR
.CE
.PP
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
chosen when all operands have a numeric interpretation.  The integer
interpretation of an operand is preferred over the floating-point
interpretation.  To ensure string operations on arbitrary values it is generally a
good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of
470
471
472
473
474
475
476
477

478
479
480
481
482
483
484
485
486
497
498
499
500
501
502
503

504
505
506
507
508
509
510
511
512
513







-
+









.CS
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
.SH "SEE ALSO"
array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison
arithmetic, boolean, compare, expression, fuzzy comparison, integer value
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/string.n.

501
502
503
504
505
506
507
508

509
510
511
512
501
502
503
504
505
506
507

508
509
510
511
512







-
+




} else {
    set isPrefix [\fBstring equal\fR \-length $length $string "foobar"]
}
.CE
.SH "SEE ALSO"
expr(n), list(n)
.SH KEYWORDS
case conversion, compare, index, match, pattern, string, word, equal,
case conversion, compare, index, integer value, match, pattern, string, word, equal,
ctype, character, reverse
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to generic/tclInt.h.

2699
2700
2701
2702
2703
2704
2705


2706
2707
2708
2709
2710
2711
2712
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714







+
+







#define TCL_PARSE_SCAN_PREFIXES		16
				/* 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. */
#define TCL_PARSE_NO_UNDERSCORE	128
				/* Reject underscore digit separator */

/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

Changes to generic/tclScan.c.

898
899
900
901
902
903
904
905

906
907
908
909
910
911
912
898
899
900
901
902
903
904

905
906
907
908
909
910
911
912







-
+







	     */
	    objPtr = Tcl_NewWideIntObj(0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		    &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
		&end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
		Tcl_DecrRefCount(objPtr);
		if (width < 0) {
		    if (*end == '\0') {
			underflow = 1;
		    }
		} else {
		    if (end == string + width) {
1002
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015
1016







-
+








	    objPtr = Tcl_NewDoubleObj(0.0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
		Tcl_DecrRefCount(objPtr);
		if (width < 0) {
		    if (*end == '\0') {
			underflow = 1;
		    }
		} else {
		    if (end == string + width) {

Changes to generic/tclStrToD.c.

525
526
527
528
529
530
531


532

533
534
535
536
537
538
539
525
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541







+
+
-
+







    size_t acceptLen;		/* Number of characters following that
				 * point. */
    int status = TCL_OK;	/* Status to return to caller. */
    char d = 0;			/* Last hexadecimal digit scanned; initialized
				 * to avoid a compiler warning. */
    int shift = 0;		/* Amount to shift when accumulating binary */
    int explicitOctal = 0;
    int under = 0;              /* Flag trailing '_' as error if true once
				 * number is accepted. */

    
#define ALL_BITS	((Tcl_WideUInt)-1)
#define MOST_BITS	(ALL_BITS >> 1)

    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
     */
633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648
649
650
651
652
653

654
655
656
657
658
659
660
661
662



663
664
665
666
667



668
669
670
671
672
673
674
635
636
637
638
639
640
641

642
643
644
645
646
647
648
649
650
651
652
653
654

655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682







-
+












-
+









+
+
+





+
+
+







	     * OCTAL state differ only in whether they recognize 'X' and 'b'.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == 'x' || c == 'X') {
		if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) {
		if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY) || under) {
		    goto endgame;
		}
		state = ZERO_X;
		break;
	    }
	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
		goto zerox;
	    }
	    if (flags & TCL_PARSE_SCAN_PREFIXES) {
		goto zeroo;
	    }
	    if (c == 'b' || c == 'B') {
		if (flags & TCL_PARSE_OCTAL_ONLY) {
		if ((flags & TCL_PARSE_OCTAL_ONLY) || under) {
		    goto endgame;
		}
		state = ZERO_B;
		break;
	    }
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {
		if (under) {
		    goto endgame;
		}
		explicitOctal = 1;
		state = ZERO_O;
		break;
	    }
	    if (c == 'd' || c == 'D') {
		if (under) {
		    goto endgame;
		}
		state = ZERO_D;
		break;
	    }
#ifdef TCL_NO_DEPRECATED
	    goto decimal;
#endif
	    /* FALLTHROUGH */
684
685
686
687
688
689
690

691
692
693

694
695
696
697
698
699
700
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710







+



+







	    acceptPoint = p;
	    acceptLen = len;
	    /* FALLTHROUGH */
	case ZERO_O:
	zeroo:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = OCTAL;
		break;
	    } else if (c >= '1' && c <= '7') {
		under = 0;
		if (objPtr != NULL) {
		    shift = 3 * (numTrailZeros + 1);
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);

729
730
731
732
733
734
735




736
737
738
739
740
741
742
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756







+
+
+
+







		    numSigDigs += numTrailZeros+1;
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		state = OCTAL;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    /* FALLTHROUGH */

	case BAD_OCTAL:
	    if (explicitOctal) {
		/*
		 * No forgiveness for bad digits in explicitly octal numbers.
757
758
759
760
761
762
763

764
765
766
767
768
769
770
771
772
773
774
775
776
777
778

779
780
781

782
783
784

785
786
787
788
789
790
791
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809







+















+



+



+







	     * Scanned a number with a leading zero that contains an 8, 9,
	     * radix point or E. This is an invalid octal number, but might
	     * still be floating point.
	     */

	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = BAD_OCTAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		if (numSigDigs != 0) {
		    numSigDigs += (numTrailZeros + 1);
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		under = 0;
		state = BAD_OCTAL;
		break;
	    } else if (c == '.') {
		under = 0;
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		under = 0;
		state = EXPONENT_START;
		break;
	    }
#endif
	    goto endgame;

	    /*
800
801
802
803
804
805
806

807
808
809

810
811

812
813

814




815
816
817
818
819
820
821
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847







+



+


+


+

+
+
+
+







	    acceptLen = len;
	    /* FALLTHROUGH */

	case ZERO_X:
	zerox:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = HEXADECIMAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		under = 0;
		d = (c-'0');
	    } else if (c >= 'A' && c <= 'F') {
		under = 0;
		d = (c-'A'+10);
	    } else if (c >= 'a' && c <= 'f') {
		under = 0;
		d = (c-'a'+10);
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else {
		goto endgame;
	    }
	    if (objPtr != NULL) {
		shift = 4 * (numTrailZeros + 1);
		if (!significandOverflow) {
		    /*
847
848
849
850
851
852
853

854
855




856
857
858
859
860
861
862
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893







+


+
+
+
+







	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	case ZERO_B:
	zerob:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = BINARY;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else if (c != '1') {
		goto endgame;
	    }
	    if (objPtr != NULL) {
		shift = numTrailZeros + 1;
		if (!significandOverflow) {
		    /*
882
883
884
885
886
887
888

889
890





891
892

893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910

911
912
913
914
915
916
917
918
919
920
921

922
923




924
925
926

927
928
929

930
931
932
933
934
935
936
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982







+


+
+
+
+
+


+


















+











+


+
+
+
+



+



+







	    }
	    numTrailZeros = 0;
	    state = BINARY;
	    break;

	case ZERO_D:
	    if (c == '0') {
		under = 0;
		numTrailZeros++;
	    } else if ( ! isdigit(UCHAR(c))) {
                if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                    /* Ignore numeric "white space" */
                    under = 1;
                    break;
                }
		goto endgame;
	    }
	    under = 0;
	    state = DECIMAL;
	    flags |= TCL_PARSE_INTEGER_ONLY;
	    /* FALLTHROUGH */

	case DECIMAL:
	    /*
	     * Scanned an optional + or - followed by a string of decimal
	     * digits.
	     */

#ifdef TCL_NO_DEPRECATED
	decimal:
#endif
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = DECIMAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c - '0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		numSigDigs += numTrailZeros+1;
		numTrailZeros = 0;
		under = 0;
		state = DECIMAL;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
		goto endgame;
	    } else if (c == '.') {
		under = 0;
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		under = 0;
		state = EXPONENT_START;
		break;
	    }
	    goto endgame;

	    /*
	     * Found a decimal point. If no digits have yet been scanned, E is
948
949
950
951
952
953
954

955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970

971
972




973
974
975
976
977
978
979
980
981
982
983

984
985
986
987

988
989
990
991
992
993
994
995
996
997
998
999
1000

1001
1002




1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020

1021
1022




1023
1024
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038

1039
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053

1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065

1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127

1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157



1158
1159
1160
1161



1162
1163
1164
1165
1166
1167
1168
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
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
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239


1240
1241
1242
1243
1244
1245
1246
1247
1248
1249







+
















+


+
+
+
+











+




+













+


+
+
+
+


















+


+
+
+
+










+






+








+







+






+






+






+











+






+









+










+






+














+












+

















-
+
+
+


-
-
+
+
+







	    }
	    /* FALLTHROUGH */

	case LEADING_RADIX_POINT:
	    if (c == '0') {
		numDigitsAfterDp++;
		numTrailZeros++;
		under = 0;
		state = FRACTION;
		break;
	    } else if (isdigit(UCHAR(c))) {
		numDigitsAfterDp++;
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		if (numSigDigs != 0) {
		    numSigDigs += numTrailZeros+1;
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		under = 0;
		state = FRACTION;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	case EXPONENT_START:
	    /*
	     * Scanned the E at the start of an exponent. Make sure a legal
	     * character follows before using the C library strtol routine,
	     * which allows whitespace.
	     */

	    if (c == '+') {
		under = 0;
		state = EXPONENT_SIGNUM;
		break;
	    } else if (c == '-') {
		exponentSignum = 1;
		under = 0;
		state = EXPONENT_SIGNUM;
		break;
	    }
	    /* FALLTHROUGH */

	case EXPONENT_SIGNUM:
	    /*
	     * Found the E at the start of the exponent, followed by a sign
	     * character.
	     */

	    if (isdigit(UCHAR(c))) {
		exponent = c - '0';
		under = 0;
		state = EXPONENT;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	case EXPONENT:
	    /*
	     * Found an exponent with at least one digit. Accumulate it,
	     * making sure to hard-pin it to LONG_MAX on overflow.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (isdigit(UCHAR(c))) {
		if (exponent < (LONG_MAX - 9) / 10) {
		    exponent = 10 * exponent + (c - '0');
		} else {
		    exponent = LONG_MAX;
		}
		under = 0;
		state = EXPONENT;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	    /*
	     * Parse out INFINITY by simply spelling it out. INF is accepted
	     * as an abbreviation; other prefices are not.
	     */

	case sI:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sIN;
		break;
	    }
	    goto endgame;
	case sIN:
	    if (c == 'f' || c == 'F') {
		under = 0;
		state = sINF;
		break;
	    }
	    goto endgame;
	case sINF:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
            under = 0;
	    if (c == 'i' || c == 'I') {
		state = sINFI;
		break;
	    }
	    goto endgame;
	case sINFI:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sINFIN;
		break;
	    }
	    goto endgame;
	case sINFIN:
	    if (c == 'i' || c == 'I') {
		under = 0;
		state = sINFINI;
		break;
	    }
	    goto endgame;
	case sINFINI:
	    if (c == 't' || c == 'T') {
		under = 0;
		state = sINFINIT;
		break;
	    }
	    goto endgame;
	case sINFINIT:
	    if (c == 'y' || c == 'Y') {
		under = 0;
		state = sINFINITY;
		break;
	    }
	    goto endgame;

	    /*
	     * Parse NaN's.
	     */
#ifdef IEEE_FLOATING_POINT
	case sN:
	    if (c == 'a' || c == 'A') {
		under = 0;
		state = sNA;
		break;
	    }
	    goto endgame;
	case sNA:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sNAN;
		break;
	    }
	    goto endgame;
	case sNAN:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '(') {
		under = 0;
		state = sNANPAREN;
		break;
	    }
	    goto endgame;

	    /*
	     * Parse NaN(hexdigits)
	     */
	case sNANHEX:
	    if (c == ')') {
		under = 0;
		state = sNANFINISH;
		break;
	    }
	    /* FALLTHROUGH */
	case sNANPAREN:
	    if (TclIsSpaceProc(c)) {
		under = 0;
		break;
	    }
	    if (numSigDigs < 13) {
		if (c >= '0' && c <= '9') {
		    d = c - '0';
		} else if (c >= 'a' && c <= 'f') {
		    d = 10 + c - 'a';
		} else if (c >= 'A' && c <= 'F') {
		    d = 10 + c - 'A';
		} else {
		    goto endgame;
		}
		numSigDigs++;
		significandWide = (significandWide << 4) + d;
		under = 0;
		state = sNANHEX;
		break;
	    }
	    goto endgame;
	case sNANFINISH:
#endif

	case sINFINITY:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    goto endgame;

	}
	p++;
	len--;
    }

  endgame:
    if (acceptState == INITIAL) {
	/*
	 * No numeric string at all found.
	 */

	status = TCL_ERROR;
	if (endPtrPtr != NULL) {
	    *endPtrPtr = p;
	}
    } else {
	/*
	 * Back up to the last accepting state in the lexer.
	 * Back up to the last accepting state in the lexer.  
	 * If the last char seen is the numeric whitespace character '_',
	 * backup to that.
	 */

	p = acceptPoint;
	len = acceptLen;
	p = under ? acceptPoint-1 : acceptPoint;
	len = under ? acceptLen-1 : acceptLen;

	if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
	    /*
	     * Accept trailing whitespace.
	     */

	    while (len != 0 && TclIsSpaceProc(*p)) {
		p++;

Changes to tests/get.test.

105
106
107
108
109
110
111






112
113
114
115
116
117
118
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124







+
+
+
+
+
+







} {44 44 44 44 54 51 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
    lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
	catch {testdoubleobj set 1 $x} x
	set x
    }
} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint {
    lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } {
	catch {testgetint $x} x
	set x
    }
} {0 10 2 33 1423324 10 7 8 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/scan.test.

551
552
553
554
555
556
557





558
559
560
561
562
563
564
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569







+
+
+
+
+







} -returnCodes 1 -result {unsigned bignum scans are invalid}
test scan-5.19 {bigint scanning invalid} -setup {
    set a {};
} -body {
    list [scan "207698809136909011942886895" \
           %llu a] $a
} -result {1 207698809136909011942886895}
test scan-5.20 {ignore digit separators} -setup {
    set a {}; set b {}; set c {};
} -body {
    list [scan "10_23_45" %d_%d_%d a b c] $a $b $c
} -result {3 10 23 45}

test scan-6.1 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
} -result {3 2.1 -300000000.0 0.99962 {}}
test scan-6.2 {floating-point scanning} -setup {
596
597
598
599
600
601
602





603
604
605
606
607
608
609
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619







+
+
+
+
+







    list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
} -result {1 4.6 {} {} {}}
test scan-6.8 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
} -result {2 4.6 5.2 {} {}}
test scan-6.8 {disallow diget separator in floating-point} -setup {
    set a {}; set b {}; set c {};
} -body {
    list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c
} -result {3 3.14 2.35 98.6}

test scan-7.1 {string and character scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result {4 abc def ghijk dum}
test scan-7.2 {string and character scanning} -setup {