summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2019-06-26 20:06:59 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2019-06-26 20:06:59 (GMT)
commita3e27be7687efc74cd599d893a2f2e5c71cf5482 (patch)
treeb3c1b3d68cf0d4f68a3858b01dd9810cc3fcc5cb
parente15611da63228794bd9b4ef72c67d80355d14e93 (diff)
parent8fc811e066034462c225778dd4e2ca614a3e13c6 (diff)
downloadtcl-a3e27be7687efc74cd599d893a2f2e5c71cf5482.zip
tcl-a3e27be7687efc74cd599d893a2f2e5c71cf5482.tar.gz
tcl-a3e27be7687efc74cd599d893a2f2e5c71cf5482.tar.bz2
Merge 8.7
-rw-r--r--README.md2
-rw-r--r--doc/binary.n174
-rw-r--r--doc/coroutine.n2
-rw-r--r--generic/tclBasic.c133
-rw-r--r--generic/tclCmdMZ.c14
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclEnsemble.c6
-rw-r--r--generic/tclEvent.c23
-rw-r--r--generic/tclExecute.c21
-rw-r--r--generic/tclInt.h7
-rw-r--r--generic/tclTomMath.h4
-rw-r--r--generic/tclZipfs.c7
-rw-r--r--libtommath/bn_mp_get_long_long.c4
-rw-r--r--tests/execute.test39
-rw-r--r--tests/namespace.test21
-rw-r--r--tests/util.test160
-rwxr-xr-xtools/tcltk-man2html.tcl2
-rw-r--r--win/tclWinPanic.c2
-rw-r--r--win/tclWinPort.h8
19 files changed, 406 insertions, 225 deletions
diff --git a/README.md b/README.md
index 8bc67db..6be63d4 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
# README: Tcl
This is the **Tcl 8.7a2** source distribution.
-
+
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).
diff --git a/doc/binary.n b/doc/binary.n
index 77a4ec2..00b29d4 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -180,11 +180,11 @@ specified length, the extra characters will be ignored. If
then all of the bytes in \fIarg\fR will be
formatted. If \fIcount\fR is omitted, then one character will be
formatted. For example, the command:
-.RS
+.RS
.PP
.CS
\fBbinary format\fR a7a*a alpha bravo charlie
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -196,7 +196,7 @@ the command:
.PP
.CS
\fBbinary format\fR a* [encoding convertto utf-8 \eu20ac]
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -209,7 +209,7 @@ UTF-8 byte sequence for a Euro-currency character), and the command:
.PP
.CS
\fBbinary format\fR a* [encoding convertto iso8859-15 \eu20ac]
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -219,11 +219,11 @@ will return a binary string equivalent to:
.PP
(which is the ISO
8859\-15 byte sequence for a Euro-currency character). Contrast these
-last two with:
+last two with:
.PP
.CS
\fBbinary format\fR a* \eu20ac
-.CE
+.CE
.PP
which returns a binary string equivalent to:
.PP
@@ -238,11 +238,11 @@ what is desired.
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
padding instead of nulls. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR A6A*A alpha bravo charlie
-.CE
+.CE
.PP
will return
.PP
@@ -265,11 +265,11 @@ digits in \fIarg\fR will be formatted. If \fIcount\fR is omitted,
then one digit will be formatted. If the number of bits formatted
does not end at a byte boundary, the remaining bits of the last byte
will be zeros. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR b5b* 11100 111000011010
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -280,11 +280,11 @@ will return a binary string equivalent to:
.IP \fBB\fR 5
This form is the same as \fBb\fR except that the bits are stored in
high-to-low order within each byte. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR B5B* 11100 111000011010
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -307,11 +307,11 @@ then all of the digits in \fIarg\fR will be formatted. If
\fIcount\fR is omitted, then one digit will be formatted. If the
number of digits formatted does not end at a byte boundary, the
remaining bits of the last byte will be zeros. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR H3H*H2 ab DEF 987
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -322,11 +322,11 @@ will return a binary string equivalent to:
.IP \fBh\fR 5
This form is the same as \fBH\fR except that the digits are stored in
low-to-high order within each byte. This is seldom required. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR h3h*h2 AB def 987
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -344,11 +344,11 @@ are stored as a one-byte value at the cursor position. If \fIcount\fR is
then all of the integers in the list are formatted. If the
number of elements in the list is greater
than \fIcount\fR, then the extra elements are ignored. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -356,11 +356,11 @@ will return a binary string equivalent to:
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
.CE
.PP
-whereas:
+whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
-.CE
+.CE
.PP
will generate an error.
.RE
@@ -370,11 +370,11 @@ This form is the same as \fBc\fR except that it stores one or more
low-order 16-bits of each integer are stored as a two-byte value at
the cursor position with the least significant byte stored first. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR s3 {3 -3 258 1}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -386,11 +386,11 @@ will return a binary string equivalent to:
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -410,11 +410,11 @@ This form is the same as \fBc\fR except that it stores one or more
low-order 32-bits of each integer are stored as a four-byte value at
the cursor position with the least significant byte stored first. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -426,11 +426,11 @@ will return a binary string equivalent to:
This form is the same as \fBi\fR except that it stores one or more one
or more 32-bit integers in big-endian byte order in the output string.
For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -451,11 +451,11 @@ This form is the same as \fBc\fR except that it stores one or more
low-order 64-bits of each integer are stored as an eight-byte value at
the cursor position with the least significant byte stored first. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR w 7810179016327718216
-.CE
+.CE
.PP
will return the binary string \fBHelloTcl\fR.
.RE
@@ -463,11 +463,11 @@ will return the binary string \fBHelloTcl\fR.
This form is the same as \fBw\fR except that it stores one or more one
or more 64-bit integers in big-endian byte order in the output string.
For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR Wc 4785469626960341345 110
-.CE
+.CE
.PP
will return the binary string \fBBigEndian\fR
.RE
@@ -491,11 +491,11 @@ as defined by the system will be used instead. Because Tcl uses
double-precision floating point numbers internally, there may be some
loss of precision in the conversion to single-precision. For example,
on a Windows system running on an Intel Pentium processor,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR f2 {1.6 3.4}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -517,11 +517,11 @@ This form is the same as \fBf\fR except that it stores one or more one
or more double-precision floating point numbers in the machine's native
representation in the output string. For example, on a
Windows system running on an Intel Pentium processor,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR d1 {1.6}
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -544,11 +544,11 @@ not specified, stores one null byte. If \fIcount\fR is
.QW \fB*\fR ,
generates an error. This type does not consume an argument. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR a3xa3x2a3 abc def ghi
-.CE
+.CE
.PP
will return a binary string equivalent to:
.PP
@@ -565,11 +565,11 @@ then the cursor is positioned at location 0 so that the next byte
stored will be the first byte in the result string. If \fIcount\fR is
omitted then the cursor is moved back one byte. This type does not
consume an argument. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR a3X*a3X2a3 abc def ghi
-.CE
+.CE
.PP
will return \fBdghi\fR.
.RE
@@ -584,11 +584,11 @@ locations and the cursor will be placed at the specified location. If
then the cursor is moved to the current end of
the output string. If \fIcount\fR is omitted, then an error will be
generated. This type does not consume an argument. For example,
-.RS
+.RS
.PP
.CS
\fBbinary format\fR a5@2a1@*a3@10a1 abcde f ghi j
-.CE
+.CE
.PP
will return
.PP
@@ -631,7 +631,7 @@ is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
-scan subcommand:
+scan subcommand:
.PP
.CS
\fBbinary scan\fR $bytes s3s first second
@@ -643,15 +643,15 @@ is long enough) assigns a list of three integers to the variable
If \fIbytes\fR contains fewer than 8 bytes (i.e. four 2-byte
integers), no assignment to \fIsecond\fR will be made, and if
\fIbytes\fR contains fewer than 6 bytes (i.e. three 2-byte integers),
-no assignment to \fIfirst\fR will be made. Hence:
+no assignment to \fIfirst\fR will be made. Hence:
.PP
.CS
puts [\fBbinary scan\fR abcdefg s3s first second]
puts $first
puts $second
-.CE
+.CE
.PP
-will print (assuming neither variable is set previously):
+will print (assuming neither variable is set previously):
.PP
.CS
1
@@ -663,17 +663,17 @@ It is \fIimportant\fR to note that the \fBc\fR, \fBs\fR, and \fBS\fR
(and \fBi\fR and \fBI\fR on 64bit systems) will be scanned into
long data size values. In doing this, values that have their high
bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints),
-will be sign extended. Thus the following will occur:
+will be sign extended. Thus the following will occur:
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
-.CE
+.CE
.PP
If you require unsigned values you can include the
.QW u
flag character following
-the field type. For example, to read an unsigned short value:
+the field type. For example, to read an unsigned short value:
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
@@ -695,30 +695,30 @@ range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command will be
needed if the string is not a binary string or a string encoded in ISO
8859\-1.
For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR abcde\e000fghi a6a10 var1 var2
-.CE
+.CE
.PP
will return \fB1\fR with the string equivalent to \fBabcde\e000\fR
-stored in \fIvar1\fR and \fIvar2\fR left unmodified, and
+stored in \fIvar1\fR and \fIvar2\fR left unmodified, and
.PP
.CS
\fBbinary scan\fR \e342\e202\e254 a* var1
set var2 [encoding convertfrom utf-8 $var1]
-.CE
+.CE
.PP
will store a Euro-currency character in \fIvar2\fR.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from
the scanned value before it is stored in the variable. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR "abc efghi \e000" A* var1
-.CE
+.CE
.PP
will return \fB1\fR with \fBabc efghi\fR stored in \fIvar1\fR.
.RE
@@ -734,11 +734,11 @@ bits in the last byte are ignored. If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bits in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one bit will be scanned. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex87\ex05 b5b* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB11100\fR stored in \fIvar1\fR and
\fB1110000110100000\fR stored in \fIvar2\fR.
@@ -746,11 +746,11 @@ will return \fB2\fR with \fB11100\fR stored in \fIvar1\fR and
.IP \fBB\fR 5
This form is the same as \fBb\fR, except the bits are taken in
high-to-low order within each byte. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and
\fB1000011100000101\fR stored in \fIvar2\fR.
@@ -766,11 +766,11 @@ byte. Any extra bits in the last byte are ignored. If \fIcount\fR is
then all of the remaining hex digits in \fIstring\fR will be
scanned. If \fIcount\fR is omitted, then one hex digit will be
scanned. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
\fB051f34\fR stored in \fIvar2\fR.
@@ -778,11 +778,11 @@ will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
.IP \fBh\fR 5
This form is the same as \fBH\fR, except the digits are taken in
reverse (low-to-high) order within each byte. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex86\ex05\ex12\ex34 h3h* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB706\fR stored in \fIvar1\fR and
\fB502143\fR stored in \fIvar2\fR.
@@ -798,11 +798,11 @@ immediately after the \fBc\fR. If \fIcount\fR is
then all of the remaining bytes in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one 8-bit integer will be scanned. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex86\ex05 c2c* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR
stored in \fIvar2\fR. Note that the integers returned are signed unless
@@ -817,11 +817,11 @@ the corresponding variable as a list. If \fIcount\fR is
then all of the remaining bytes in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one 16-bit integer will be scanned. For
example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR. Note that the integers returned are signed unless
@@ -831,11 +831,11 @@ stored in \fIvar2\fR. Note that the integers returned are signed unless
This form is the same as \fBs\fR except that the data is interpreted
as \fIcount\fR 16-bit integers represented in big-endian byte
order. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
@@ -856,12 +856,12 @@ the corresponding variable as a list. If \fIcount\fR is
then all of the remaining bytes in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one 32-bit integer will be scanned. For
example,
-.RS
+.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR. Note that the integers returned are signed unless
@@ -872,12 +872,12 @@ This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR. For example,
-.RS
+.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
@@ -898,12 +898,12 @@ the corresponding variable as a list. If \fIcount\fR is
then all of the remaining bytes in \fIstring\fR will be scanned. If
\fIcount\fR is omitted, then one 64-bit integer will be scanned. For
example,
-.RS
+.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
@@ -913,12 +913,12 @@ This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR. For example,
-.RS
+.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
@@ -944,11 +944,11 @@ bytes that are scanned may vary. If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent. For example, on a Windows system running on an
Intel Pentium processor,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
-.CE
+.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
@@ -968,11 +968,11 @@ This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
-.CE
+.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
@@ -996,11 +996,11 @@ current cursor position, then the cursor is positioned after
the last byte in \fIstring\fR. If \fIcount\fR is omitted, then the
cursor is moved forward one byte. Note that this type does not
consume an argument. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 x2H* var1
-.CE
+.CE
.PP
will return \fB1\fR with \fB0304\fR stored in \fIvar1\fR.
.RE
@@ -1013,11 +1013,11 @@ then the cursor is positioned at location 0 so that the next byte
scanned will be the first byte in \fIstring\fR. If \fIcount\fR
is omitted then the cursor is moved back one byte. Note that this
type does not consume an argument. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2XH* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
@@ -1028,11 +1028,11 @@ by \fIcount\fR. Note that position 0 refers to the first byte in
\fIstring\fR. If \fIcount\fR refers to a position beyond the end of
\fIstring\fR, then the cursor is positioned after the last byte. If
\fIcount\fR is omitted, then an error will be generated. For example,
-.RS
+.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2@1H* var1 var2
-.CE
+.CE
.PP
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
diff --git a/doc/coroutine.n b/doc/coroutine.n
index 3c1cf6c..a032d2e 100644
--- a/doc/coroutine.n
+++ b/doc/coroutine.n
@@ -119,7 +119,7 @@ The injection is a one-off. It is not retained once it has been executed. It
may \fByield\fR or \fByieldto\fR as part of its execution.
.PP
Note that running coroutines may be neither probed nor injected; the
-operations may only be applied to
+operations may only be applied to
.VE "8.7, TIP383"
.SH EXAMPLES
.PP
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a23bfc1..09c785e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -23,9 +23,33 @@
#include "tommath.h"
#include <math.h>
#include <assert.h>
-#ifndef fpclassify /* Older MSVC */
-#include <float.h>
-#endif /* !fpclassify */
+
+/*
+ * TCL_FPCLASSIFY_MODE:
+ * 0 - fpclassify
+ * 1 - _fpclass
+ * 2 - simulate
+ * 3 - __builtin_fpclassify
+ */
+
+#ifndef TCL_FPCLASSIFY_MODE
+/*
+ * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify,
+ * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to _fpclass
+ */
+# if ( defined(__MINGW32__) && defined(_X86_) ) /* mingw 32-bit */
+# define TCL_FPCLASSIFY_MODE 1
+# elif defined(fpclassify) /* fpclassify */
+# include <float.h>
+# define TCL_FPCLASSIFY_MODE 0
+# elif defined(_FPCLASS_NN) /* _fpclass */
+# define TCL_FPCLASSIFY_MODE 1
+# else /* !fpclassify && !_fpclass (older MSVC), simulate */
+# define TCL_FPCLASSIFY_MODE 2
+# endif /* !fpclassify */
+/* actually there is no fallback to builtin fpclassify */
+#endif /* !TCL_FPCLASSIFY_MODE */
+
#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE 200
@@ -8325,13 +8349,14 @@ ExprSrandFunc(
* None.
*
*----------------------------------------------------------------------
- */
-
-/*
+ *
* Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course.
- * But it does have _fpclass() which does almost the same job.
+ * But it does sometimes have _fpclass() which does almost the same job; if
+ * even that is absent, we grobble around directly in the platform's binary
+ * representation of double.
*
- * This makes it conform to the C99 standard API, and just delegates to the
+ * The ClassifyDouble() function makes all that conform to a common API
+ * (effectively the C99 standard API renamed), and just delegates to the
* standard macro on platforms that do it correctly.
*/
@@ -8339,15 +8364,90 @@ static inline int
ClassifyDouble(
double d)
{
-#ifdef fpclassify
+#if TCL_FPCLASSIFY_MODE == 0
return fpclassify(d);
#else /* !fpclassify */
-#define FP_ZERO 0
-#define FP_NORMAL 1
-#define FP_SUBNORMAL 2
-#define FP_INFINITE 3
-#define FP_NAN 4
+ /*
+ * If we don't have fpclassify(), we also don't have the values it returns.
+ * Hence we define those here.
+ */
+# ifndef FP_NAN
+# define FP_NAN 1 /* Value is NaN */
+# define FP_INFINITE 2 /* Value is an infinity */
+# define FP_ZERO 3 /* Value is a zero */
+# define FP_NORMAL 4 /* Value is a normal float */
+# define FP_SUBNORMAL 5 /* Value has lost accuracy */
+#endif
+
+# if TCL_FPCLASSIFY_MODE == 3
+ return __builtin_fpclassify(FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d);
+# elif TCL_FPCLASSIFY_MODE == 2
+ /*
+ * We assume this hack is only needed on little-endian systems.
+ * Specifically, x86 running Windows. It's fairly easy to enable for
+ * others if they need it (because their libc/libm is broken) but we'll
+ * jump that hurdle when requred. We can solve the word ordering then.
+ */
+
+ union {
+ double d; /* Interpret as double */
+ struct {
+ unsigned int low; /* Lower 32 bits */
+ unsigned int high; /* Upper 32 bits */
+ } w; /* Interpret as unsigned integer words */
+ } doubleMeaning; /* So we can look at the representation of a
+ * double directly. Platform (i.e., processor)
+ * specific; this is for x86 (and most other
+ * little-endian processors, but those are
+ * untested). */
+ unsigned int exponent, mantissaLow, mantissaHigh;
+ /* The pieces extracted from the double. */
+ int zeroMantissa; /* Was the mantissa zero? That's special. */
+
+ /*
+ * Shifts and masks to use with the doubleMeaning variable above.
+ */
+
+# define EXPONENT_MASK 0x7ff /* 11 bits (after shifting) */
+# define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */
+# define MANTISSA_MASK 0xfffff /* 20 bits (plus 32 from other word) */
+
+ /*
+ * Extract the exponent (11 bits) and mantissa (52 bits). Note that we
+ * totally ignore the sign bit.
+ */
+
+ doubleMeaning.d = d;
+ exponent = (doubleMeaning.w.high >> EXPONENT_SHIFT) & EXPONENT_MASK;
+ mantissaLow = doubleMeaning.w.low;
+ mantissaHigh = doubleMeaning.w.high & MANTISSA_MASK;
+ zeroMantissa = (mantissaHigh == 0 && mantissaLow == 0);
+
+ /*
+ * Look for the special cases of exponent.
+ */
+
+ switch (exponent) {
+ case 0:
+ /*
+ * When the exponent is all zeros, it's a ZERO or a SUBNORMAL.
+ */
+
+ return zeroMantissa ? FP_ZERO : FP_SUBNORMAL;
+ case EXPONENT_MASK:
+ /*
+ * When the exponent is all ones, it's an INF or a NAN.
+ */
+ return zeroMantissa ? FP_INFINITE : FP_NAN;
+ default:
+ /*
+ * Everything else is a NORMAL double precision float.
+ */
+
+ return FP_NORMAL;
+ }
+# elif TCL_FPCLASSIFY_MODE == 1
switch (_fpclass(d)) {
case _FPCLASS_NZ:
case _FPCLASS_PZ:
@@ -8367,7 +8467,10 @@ ClassifyDouble(
case _FPCLASS_SNAN:
return FP_NAN;
}
-#endif /* fpclassify */
+# else /* unknown TCL_FPCLASSIFY_MODE */
+# error "unknown or unexpected TCL_FPCLASSIFY_MODE"
+# endif /* TCL_FPCLASSIFY_MODE */
+#endif /* !fpclassify */
}
static int
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 455b44c..cdc1e28 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4164,14 +4164,14 @@ Tcl_TimeRateObjCmd(
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
- Tcl_WideUInt count = 0; /* Holds repetition count */
+ TclWideMUInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = WIDE_MIN;
/* Maximal running time (in milliseconds) */
- Tcl_WideUInt maxcnt = WIDE_MAX;
+ TclWideMUInt maxcnt = WIDE_MAX;
/* Maximal count of iterations. */
- Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster
+ TclWideMUInt threshold = 1; /* Current threshold for check time (faster
* repeat count without time check) */
- Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max
+ TclWideMUInt maxIterTm = 1; /* Max time of some iteration as max
* threshold, additionally avoiding divide to
* zero (i.e., never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
@@ -4546,13 +4546,13 @@ Tcl_TimeRateObjCmd(
{
Tcl_Obj *objarr[8], **objs = objarr;
- Tcl_WideUInt usec, val;
+ TclWideMUInt usec, val;
int digits;
/*
* Absolute execution time in microseconds or in wide clicks.
*/
- usec = (Tcl_WideUInt)(middle - start);
+ usec = (TclWideMUInt)(middle - start);
#ifdef TCL_WIDE_CLICKS
/*
@@ -4581,7 +4581,7 @@ Tcl_TimeRateObjCmd(
* Estimate the time of overhead (microsecs).
*/
- Tcl_WideUInt curOverhead = overhead * count;
+ TclWideMUInt curOverhead = overhead * count;
if (usec > curOverhead) {
usec -= curOverhead;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index dec9600..a6ac797 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2024,7 +2024,7 @@ ParseLexeme(
}
}
break;
-
+
case 'g':
if ((numBytes > 1)
&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 53b8bfb..e7e5c92 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2707,7 +2707,11 @@ BuildEnsembleConfig(
if (isNew) {
Tcl_Obj *cmdObj, *cmdPrefixObj;
- cmdObj = Tcl_NewStringObj(nsCmdName, -1);
+ TclNewObj(cmdObj);
+ Tcl_AppendStringsToObj(cmdObj,
+ ensemblePtr->nsPtr->fullName,
+ (ensemblePtr->nsPtr->parentPtr ? "::" : ""),
+ nsCmdName, NULL);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 7ce5ddd..734f114 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -947,16 +947,20 @@ Tcl_Exit(
currentAppExitPtr = appExitPtr;
Tcl_MutexUnlock(&exitMutex);
+ /*
+ * Warning: this function SHOULD NOT return, as there is code that depends
+ * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
+ * returns, so critical is this dependcy.
+ *
+ * If subsystems are not (yet) initialized, proper Tcl-finalization is
+ * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2].
+ */
+
if (currentAppExitPtr) {
- /*
- * Warning: this code SHOULD NOT return, as there is code that depends
- * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
- * returns, so critical is this dependcy.
- */
currentAppExitPtr(INT2PTR(status));
- Tcl_Panic("AppExitProc returned unexpectedly");
- } else {
+
+ } else if (subsystemsInitialized) {
if (TclFullFinalizationRequested()) {
@@ -989,9 +993,10 @@ Tcl_Exit(
FinalizeThread(/* quick */ 1);
}
- TclpExit(status);
- Tcl_Panic("OS exit failed!");
}
+
+ TclpExit(status);
+ Tcl_Panic("OS exit failed!");
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 91c6a42..484efe0 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3482,31 +3482,36 @@ TEBCresume(
{
int createdNewObj = 0;
+ Tcl_Obj *valueToAssign;
if (!objResultPtr) {
- objResultPtr = valuePtr;
+ valueToAssign = valuePtr;
} else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
} else {
if (Tcl_IsShared(objResultPtr)) {
- objResultPtr = Tcl_DuplicateObj(objResultPtr);
+ valueToAssign = Tcl_DuplicateObj(objResultPtr);
createdNewObj = 1;
+ } else {
+ valueToAssign = objResultPtr;
}
- if (Tcl_ListObjReplace(interp, objResultPtr, len,0, objc,objv)
- != TCL_OK) {
+ if (Tcl_ListObjReplace(interp, valueToAssign, len, 0,
+ objc, objv) != TCL_OK) {
+ if (createdNewObj) {
+ TclDecrRefCount(valueToAssign);
+ }
goto errorInLappendListPtr;
}
}
DECACHE_STACK_INFO();
+ Tcl_IncrRefCount(valueToAssign);
objResultPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
- part2Ptr, objResultPtr, TCL_LEAVE_ERR_MSG, opnd);
+ part2Ptr, valueToAssign, TCL_LEAVE_ERR_MSG, opnd);
+ TclDecrRefCount(valueToAssign);
CACHE_STACK_INFO();
if (!objResultPtr) {
errorInLappendListPtr:
- if (createdNewObj) {
- TclDecrRefCount(objResultPtr);
- }
TRACE_ERROR(interp);
goto gotError;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 80b4493..42a9044 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3272,6 +3272,13 @@ MODULE_SCOPE void TclInitThreadStorage(void);
MODULE_SCOPE void TclFinalizeThreadDataThread(void);
MODULE_SCOPE void TclFinalizeThreadStorage(void);
+/* TclWideMUInt -- wide integer used for measurement calculations: */
+#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400))
+# define TclWideMUInt Tcl_WideUInt
+#else
+/* older MSVS may not allow conversions between unsigned __int64 and double) */
+# define TclWideMUInt Tcl_WideInt
+#endif
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index bbcb4bc..9da642e 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -84,7 +84,11 @@ typedef unsigned int mp_digit;
#define MP_DIGIT_DECLARED
#endif
#ifndef MP_WORD_DECLARED
+#ifdef _WIN32
+typedef unsigned __int64 mp_word;
+#else
typedef unsigned long long mp_word;
+#endif
#define MP_WORD_DECLARED
#endif
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 3d1941c..6a568fe 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -283,10 +283,9 @@ static struct {
* For password rotation.
*/
-static const char pwrot[16] = {
- 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
- 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
-};
+static const char pwrot[16] =
+ "\x00\x80\x40\xC0\x20\xA0\x60\xE0"
+ "\x10\x90\x50\xD0\x30\xB0\x70\xF0";
/*
* Table to compute CRC32.
diff --git a/libtommath/bn_mp_get_long_long.c b/libtommath/bn_mp_get_long_long.c
index 49a0208..333c6d1 100644
--- a/libtommath/bn_mp_get_long_long.c
+++ b/libtommath/bn_mp_get_long_long.c
@@ -26,11 +26,11 @@ Tcl_WideUInt mp_get_long_long(const mp_int *a)
i = MIN(a->used, (((CHAR_BIT * (int)sizeof(Tcl_WideUInt)) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
/* get most significant digit of result */
- res = (unsigned long long)a->dp[i];
+ res = (Tcl_WideUInt)a->dp[i];
#if DIGIT_BIT < 64
while (--i >= 0) {
- res = (res << DIGIT_BIT) | (unsigned long long)a->dp[i];
+ res = (res << DIGIT_BIT) | (Tcl_WideUInt)a->dp[i];
}
#endif
return res;
diff --git a/tests/execute.test b/tests/execute.test
index 3b62bc9..808574b 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -1066,6 +1066,45 @@ test execute-11.3 {Bug a0ece9d6d4} -setup {
trace remove execution crash enterstep {apply {args {info frame -2}}}
rename crash {}
} -result 1
+
+test execute-12.1 {failing multi-lappend to unshared} -setup {
+ unset -nocomplain x y
+} -body {
+ set x 1
+ lappend x 2 3
+ trace add variable x write {apply {args {error boo}}}
+ lappend x 4 5
+} -cleanup {
+ unset -nocomplain x y
+} -returnCodes error -result {can't set "x": boo}
+test execute-12.2 {failing multi-lappend to shared} -setup {
+ unset -nocomplain x y
+} -body {
+ set x 1
+ lappend x 2 3
+ set y $x
+ trace add variable x write {apply {args {error boo}}}
+ lappend x 4 5
+} -cleanup {
+ unset -nocomplain x y
+} -returnCodes error -result {can't set "x": boo}
+test execute-12.3 {failing multi-lappend to unshared: LVT} -body {
+ apply {{} {
+ set x 1
+ lappend x 2 3
+ trace add variable x write {apply {args {error boo}}}
+ lappend x 4 5
+ }}
+} -returnCodes error -result {can't set "x": boo}
+test execute-12.4 {failing multi-lappend to shared: LVT} -body {
+ apply {{} {
+ set x 1
+ lappend x 2 3
+ set y $x
+ trace add variable x write {apply {args {error boo}}}
+ lappend x 4 5
+ }}
+} -returnCodes error -result {can't set "x": boo}
# cleanup
if {[info commands testobj] != {}} {
diff --git a/tests/namespace.test b/tests/namespace.test
index 606139f..e90c753 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1797,7 +1797,7 @@ test namespace-42.7 {ensembles: nested} -body {
list [ns x0 z] [ns x1] [ns x2] [ns x3]
} -cleanup {
namespace delete ns
-} -result {{1 z} 1 2 3}
+} -result {{1 ::ns::x0::z} 1 2 3}
test namespace-42.8 {
ensembles: [Bug 1670091], panic due to pointer to a deallocated List
struct.
@@ -2128,7 +2128,7 @@ test namespace-47.1 {ensemble: unknown handler} {
lappend result [catch {ns c d e} msg] $msg
lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
-} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}}
+} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
test namespace-47.2 {ensemble: unknown handler} {
namespace eval ns {
namespace export {[a-z]*}
@@ -3227,7 +3227,7 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
1 {wrong # args: should be "ns z1 x a1"}\
1 {wrong # args: should be "ns z2 x a1 a2"}\
1 {wrong # args: should be "ns z2 x a1 a2"}\
- 1 {wrong # args: should be "z0"}\
+ 1 {wrong # args: should be "::ns::x::z0"}\
0 {1 v}\
1 {wrong # args: should be "ns v x z2 a2"}\
0 {2 v v2}}
@@ -3312,7 +3312,7 @@ test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
}
} {::testing::abc::def ::testing::abc::ghi}
-test namespace-56.4 {bug 16fe1b5807: names starting with ":"} {
+test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug {
namespace eval : {
namespace ensemble create
namespace export *
@@ -3323,6 +3323,19 @@ namespace eval : {
: p1
} 16fe1b5807
+
+test namespace-56.5 {Bug 8b9854c3d8} -setup {
+ namespace eval namespace-56.5 {
+ proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]}
+ namespace export *
+ namespace ensemble create
+ }
+} -body {
+ namespace-56.5 cmd
+} -cleanup {
+ namespace delete namespace-56.5
+} -result 1
+
# cleanup
catch {rename cmd1 {}}
diff --git a/tests/util.test b/tests/util.test
index a9199f4..053eb0c 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -532,247 +532,247 @@ test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring {
list [llength [testdstring get]] [string length [testdstring get]]
} {2 9}
-test util-9.0.0 {TclGetIntForIndex} {
+test util-9.0.0 {Tcl_GetIntForIndex} {
string index abcd 0
} a
-test util-9.0.1 {TclGetIntForIndex} {
+test util-9.0.1 {Tcl_GetIntForIndex} {
string index abcd 0x0
} a
-test util-9.0.2 {TclGetIntForIndex} {
+test util-9.0.2 {Tcl_GetIntForIndex} {
string index abcd -0x0
} a
-test util-9.0.3 {TclGetIntForIndex} {
+test util-9.0.3 {Tcl_GetIntForIndex} {
string index abcd { 0 }
} a
-test util-9.0.4 {TclGetIntForIndex} {
+test util-9.0.4 {Tcl_GetIntForIndex} {
string index abcd { 0x0 }
} a
-test util-9.0.5 {TclGetIntForIndex} {
+test util-9.0.5 {Tcl_GetIntForIndex} {
string index abcd { -0x0 }
} a
-test util-9.0.6 {TclGetIntForIndex} {
+test util-9.0.6 {Tcl_GetIntForIndex} {
string index abcd 01
} b
-test util-9.0.7 {TclGetIntForIndex} {
+test util-9.0.7 {Tcl_GetIntForIndex} {
string index abcd { 01 }
} b
-test util-9.0.8 {TclGetIntForIndex} {
+test util-9.0.8 {Tcl_GetIntForIndex} {
string index abcd { 0d0 }
} a
-test util-9.0.9 {TclGetIntForIndex} {
+test util-9.0.9 {Tcl_GetIntForIndex} {
string index abcd { -0d0 }
} a
-test util-9.1.0 {TclGetIntForIndex} {
+test util-9.1.0 {Tcl_GetIntForIndex} {
string index abcd 3
} d
-test util-9.1.1 {TclGetIntForIndex} {
+test util-9.1.1 {Tcl_GetIntForIndex} {
string index abcd { 3 }
} d
-test util-9.1.2 {TclGetIntForIndex} {
+test util-9.1.2 {Tcl_GetIntForIndex} {
string index abcdefghijk 0xa
} k
-test util-9.1.3 {TclGetIntForIndex} {
+test util-9.1.3 {Tcl_GetIntForIndex} {
string index abcdefghijk { 0xa }
} k
-test util-9.1.4 {TclGetIntForIndex} {
+test util-9.1.4 {Tcl_GetIntForIndex} {
string index abcdefghijk 0d10
} k
-test util-9.1.5 {TclGetIntForIndex} {
+test util-9.1.5 {Tcl_GetIntForIndex} {
string index abcdefghijk { 0d10 }
} k
-test util-9.2.0 {TclGetIntForIndex} {
+test util-9.2.0 {Tcl_GetIntForIndex} {
string index abcd end
} d
-test util-9.2.1 {TclGetIntForIndex} -body {
+test util-9.2.1 {Tcl_GetIntForIndex} -body {
string index abcd { end}
} -returnCodes error -match glob -result *
-test util-9.2.2 {TclGetIntForIndex} -body {
+test util-9.2.2 {Tcl_GetIntForIndex} -body {
string index abcd {end }
} -returnCodes error -match glob -result *
-test util-9.3 {TclGetIntForIndex} -body {
+test util-9.3 {Tcl_GetIntForIndex} -body {
# Deprecated
string index abcd en
} -returnCodes error -match glob -result *
-test util-9.4 {TclGetIntForIndex} -body {
+test util-9.4 {Tcl_GetIntForIndex} -body {
# Deprecated
string index abcd e
} -returnCodes error -match glob -result *
-test util-9.5.0 {TclGetIntForIndex} {
+test util-9.5.0 {Tcl_GetIntForIndex} {
string index abcd end-1
} c
-test util-9.5.1 {TclGetIntForIndex} {
+test util-9.5.1 {Tcl_GetIntForIndex} {
string index abcd {end-1 }
} c
-test util-9.5.2 {TclGetIntForIndex} -body {
+test util-9.5.2 {Tcl_GetIntForIndex} -body {
string index abcd { end-1}
} -returnCodes error -match glob -result *
-test util-9.6 {TclGetIntForIndex} {
+test util-9.6 {Tcl_GetIntForIndex} {
string index abcd end+-1
} c
-test util-9.7 {TclGetIntForIndex} {
+test util-9.7 {Tcl_GetIntForIndex} {
string index abcd end+1
} {}
-test util-9.8 {TclGetIntForIndex} {
+test util-9.8 {Tcl_GetIntForIndex} {
string index abcd end--1
} {}
-test util-9.9.0 {TclGetIntForIndex} {
+test util-9.9.0 {Tcl_GetIntForIndex} {
string index abcd 0+0
} a
-test util-9.9.1 {TclGetIntForIndex} {
+test util-9.9.1 {Tcl_GetIntForIndex} {
string index abcd { 0+0 }
} a
-test util-9.10 {TclGetIntForIndex} {
+test util-9.10 {Tcl_GetIntForIndex} {
string index abcd 0-0
} a
-test util-9.11 {TclGetIntForIndex} {
+test util-9.11 {Tcl_GetIntForIndex} {
string index abcd 1+0
} b
-test util-9.12 {TclGetIntForIndex} {
+test util-9.12 {Tcl_GetIntForIndex} {
string index abcd 1-0
} b
-test util-9.13 {TclGetIntForIndex} {
+test util-9.13 {Tcl_GetIntForIndex} {
string index abcd 1+1
} c
-test util-9.14 {TclGetIntForIndex} {
+test util-9.14 {Tcl_GetIntForIndex} {
string index abcd 1-1
} a
-test util-9.15 {TclGetIntForIndex} {
+test util-9.15 {Tcl_GetIntForIndex} {
string index abcd -1+2
} b
-test util-9.16 {TclGetIntForIndex} {
+test util-9.16 {Tcl_GetIntForIndex} {
string index abcd -1--2
} b
-test util-9.17 {TclGetIntForIndex} {
+test util-9.17 {Tcl_GetIntForIndex} {
string index abcd { -1+2 }
} b
-test util-9.18 {TclGetIntForIndex} {
+test util-9.18 {Tcl_GetIntForIndex} {
string index abcd { -1--2 }
} b
-test util-9.19 {TclGetIntForIndex} -body {
+test util-9.19 {Tcl_GetIntForIndex} -body {
string index a {}
} -returnCodes error -match glob -result *
-test util-9.20 {TclGetIntForIndex} -body {
+test util-9.20 {Tcl_GetIntForIndex} -body {
string index a { }
} -returnCodes error -match glob -result *
-test util-9.21 {TclGetIntForIndex} -body {
+test util-9.21 {Tcl_GetIntForIndex} -body {
string index a " \r\t\n"
} -returnCodes error -match glob -result *
-test util-9.22 {TclGetIntForIndex} -body {
+test util-9.22 {Tcl_GetIntForIndex} -body {
string index a +
} -returnCodes error -match glob -result *
-test util-9.23 {TclGetIntForIndex} -body {
+test util-9.23 {Tcl_GetIntForIndex} -body {
string index a -
} -returnCodes error -match glob -result *
-test util-9.24 {TclGetIntForIndex} -body {
+test util-9.24 {Tcl_GetIntForIndex} -body {
string index a x
} -returnCodes error -match glob -result *
-test util-9.25 {TclGetIntForIndex} -body {
+test util-9.25 {Tcl_GetIntForIndex} -body {
string index a +x
} -returnCodes error -match glob -result *
-test util-9.26 {TclGetIntForIndex} -body {
+test util-9.26 {Tcl_GetIntForIndex} -body {
string index a -x
} -returnCodes error -match glob -result *
-test util-9.27 {TclGetIntForIndex} -body {
+test util-9.27 {Tcl_GetIntForIndex} -body {
string index a 0y
} -returnCodes error -match glob -result *
-test util-9.28 {TclGetIntForIndex} -body {
+test util-9.28 {Tcl_GetIntForIndex} -body {
string index a 1*
} -returnCodes error -match glob -result *
-test util-9.29 {TclGetIntForIndex} -body {
+test util-9.29 {Tcl_GetIntForIndex} -body {
string index a 0+
} -returnCodes error -match glob -result *
-test util-9.30 {TclGetIntForIndex} -body {
+test util-9.30 {Tcl_GetIntForIndex} -body {
string index a {0+ }
} -returnCodes error -match glob -result *
-test util-9.31 {TclGetIntForIndex} -body {
+test util-9.31 {Tcl_GetIntForIndex} -body {
string index a 0x
} -returnCodes error -match glob -result *
-test util-9.31.1 {TclGetIntForIndex} -body {
+test util-9.31.1 {Tcl_GetIntForIndex} -body {
string index a 0d
} -returnCodes error -match glob -result *
-test util-9.32 {TclGetIntForIndex} -body {
+test util-9.32 {Tcl_GetIntForIndex} -body {
string index a 0x1FFFFFFFF+0
} -result {}
-test util-9.33 {TclGetIntForIndex} -body {
+test util-9.33 {Tcl_GetIntForIndex} -body {
string index a 100000000000+0
} -result {}
-test util-9.33.1 {TclGetIntForIndex} -body {
+test util-9.33.1 {Tcl_GetIntForIndex} -body {
string index a 0d100000000000+0
} -result {}
-test util-9.34 {TclGetIntForIndex} -body {
+test util-9.34 {Tcl_GetIntForIndex} -body {
string index a 1.0
} -returnCodes error -match glob -result *
-test util-9.35 {TclGetIntForIndex} -body {
+test util-9.35 {Tcl_GetIntForIndex} -body {
string index a 1e23
} -returnCodes error -match glob -result *
-test util-9.36 {TclGetIntForIndex} -body {
+test util-9.36 {Tcl_GetIntForIndex} -body {
string index a 1.5e2
} -returnCodes error -match glob -result *
-test util-9.37 {TclGetIntForIndex} -body {
+test util-9.37 {Tcl_GetIntForIndex} -body {
string index a 0+x
} -returnCodes error -match glob -result *
-test util-9.38 {TclGetIntForIndex} -body {
+test util-9.38 {Tcl_GetIntForIndex} -body {
string index a 0+0x
} -returnCodes error -match glob -result *
-test util-9.39 {TclGetIntForIndex} -body {
+test util-9.39 {Tcl_GetIntForIndex} -body {
string index a 0+0xg
} -returnCodes error -match glob -result *
-test util-9.40 {TclGetIntForIndex} -body {
+test util-9.40 {Tcl_GetIntForIndex} -body {
string index a 0+0xg
} -returnCodes error -match glob -result *
-test util-9.41 {TclGetIntForIndex} -body {
+test util-9.41 {Tcl_GetIntForIndex} -body {
string index a 0+1.0
} -returnCodes error -match glob -result *
-test util-9.42 {TclGetIntForIndex} -body {
+test util-9.42 {Tcl_GetIntForIndex} -body {
string index a 0+1e2
} -returnCodes error -match glob -result *
-test util-9.43 {TclGetIntForIndex} -body {
+test util-9.43 {Tcl_GetIntForIndex} -body {
string index a 0+1.5e1
} -returnCodes error -match glob -result *
-test util-9.44 {TclGetIntForIndex} -body {
+test util-9.44 {Tcl_GetIntForIndex} -body {
string index a 0+1000000000000
} -result {}
-test util-9.45 {TclGetIntForIndex} {
+test util-9.45 {Tcl_GetIntForIndex} {
string index abcd end+2305843009213693950
} {}
-test util-9.46 {TclGetIntForIndex} {
+test util-9.46 {Tcl_GetIntForIndex} {
string index abcd end+4294967294
} {}
# TIP 502
-test util-9.47 {TclGetIntForIndex} {
+test util-9.47 {Tcl_GetIntForIndex} {
string index abcd 0x10000000000000000
} {}
-test util-9.48 {TclGetIntForIndex} {
+test util-9.48 {Tcl_GetIntForIndex} {
string index abcd -0x10000000000000000
} {}
-test util-9.49 {TclGetIntForIndex} -body {
+test util-9.49 {Tcl_GetIntForIndex} -body {
string index abcd end*1
} -returnCodes error -match glob -result *
-test util-9.50 {TclGetIntForIndex} -body {
+test util-9.50 {Tcl_GetIntForIndex} -body {
string index abcd {end- 1}
} -returnCodes error -match glob -result *
-test util-9.51 {TclGetIntForIndex} -body {
+test util-9.51 {Tcl_GetIntForIndex} -body {
string index abcd end-end
} -returnCodes error -match glob -result *
-test util-9.52 {TclGetIntForIndex} -body {
+test util-9.52 {Tcl_GetIntForIndex} -body {
string index abcd end-x
} -returnCodes error -match glob -result *
-test util-9.53 {TclGetIntForIndex} -body {
+test util-9.53 {Tcl_GetIntForIndex} -body {
string index abcd end-0.1
} -returnCodes error -match glob -result *
-test util-9.54 {TclGetIntForIndex} {
+test util-9.54 {Tcl_GetIntForIndex} {
string index abcd end-0x10000000000000000
} {}
-test util-9.55 {TclGetIntForIndex} {
+test util-9.55 {Tcl_GetIntForIndex} {
string index abcd end+0x10000000000000000
} {}
-test util-9.56 {TclGetIntForIndex} {
+test util-9.56 {Tcl_GetIntForIndex} {
string index abcd end--0x10000000000000000
} {}
-test util-9.57 {TclGetIntForIndex} {
+test util-9.57 {Tcl_GetIntForIndex} {
string index abcd end+-0x10000000000000000
} {}
-test util-9.58 {TclGetIntForIndex} {
+test util-9.58 {Tcl_GetIntForIndex} {
string index abcd end--0x8000000000000000
} {}
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 08f3d28..517360b 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -63,7 +63,7 @@ proc findversion {top name useversion} {
set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
set v [getversion $tclh $upper]
if {[llength $v]} {
- lassign $v major minor
+ lassign $v major minor
# to do
# use glob matching instead of string matching or add
# brace handling to [string matcch]
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index a71f506..5c6e02d 100644
--- a/win/tclWinPanic.c
+++ b/win/tclWinPanic.c
@@ -58,7 +58,7 @@ Tcl_ConsolePanic(
} else if (_isatty(2)) {
WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
} else {
- buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+ buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
WriteFile(handle, buf, strlen(buf), &dummy, 0);
WriteFile(handle, "\n", 1, &dummy, 0);
FlushFileBuffers(handle);
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 8606511..943f1ca 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -471,10 +471,12 @@ typedef DWORD_PTR * PDWORD_PTR;
* including the *printf family and others. Tell it to shut up.
* (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
*/
-#if defined(_MSC_VER) && (_MSC_VER >= 1400)
+#if defined(_MSC_VER)
# pragma warning(disable:4244)
-# pragma warning(disable:4267)
-# pragma warning(disable:4996)
+# if _MSC_VER >= 1400
+# pragma warning(disable:4267)
+# pragma warning(disable:4996)
+# endif
#endif
/*