summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-05-19 13:40:54 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-05-19 13:40:54 (GMT)
commit6a040914a92f3123df4f68d43fa45c58558afde4 (patch)
tree7d478ececccea899bf7cb2c5d020fa462494ee5b
parent5822159301f9c80ebea99d9d92a0dc4bd908daaf (diff)
parentaf999a3a2c4770f8654059f5c5b50d766cc88c7f (diff)
downloadtcl-6a040914a92f3123df4f68d43fa45c58558afde4.zip
tcl-6a040914a92f3123df4f68d43fa45c58558afde4.tar.gz
tcl-6a040914a92f3123df4f68d43fa45c58558afde4.tar.bz2
Merge 8.7
-rw-r--r--.github/workflows/linux-build.yml2
-rw-r--r--.github/workflows/win-build.yml4
-rw-r--r--.travis.yml8
-rwxr-xr-xcompat/zlib/configure3
-rw-r--r--compat/zlib/contrib/infback9/inftree9.c2
-rw-r--r--compat/zlib/contrib/minizip/iowin32.c5
-rw-r--r--compat/zlib/crc32.c8
-rw-r--r--compat/zlib/deflate.h4
-rw-r--r--compat/zlib/inftrees.c2
-rw-r--r--compat/zlib/trees.c6
-rwxr-xr-xcompat/zlib/win32/zlib1.dllbin122880 -> 122880 bytes
-rwxr-xr-xcompat/zlib/win64-arm/zlib1.dllbin95232 -> 95232 bytes
-rwxr-xr-xcompat/zlib/win64/zlib1.dllbin102400 -> 102400 bytes
-rw-r--r--doc/http.n175
-rw-r--r--generic/tcl.decls37
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclAssembly.c2
-rw-r--r--generic/tclBasic.c14
-rw-r--r--generic/tclBinary.c8
-rw-r--r--generic/tclClock.c8
-rw-r--r--generic/tclCmdAH.c6
-rw-r--r--generic/tclCmdIL.c38
-rw-r--r--generic/tclCmdMZ.c146
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclCompCmdsSZ.c14
-rw-r--r--generic/tclCompExpr.c4
-rw-r--r--generic/tclDate.c1
-rw-r--r--generic/tclDecls.h72
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclDisassemble.c2
-rw-r--r--generic/tclEncoding.c16
-rw-r--r--generic/tclEnsemble.c38
-rw-r--r--generic/tclEvent.c2
-rw-r--r--generic/tclExecute.c82
-rw-r--r--generic/tclFCmd.c2
-rw-r--r--generic/tclFileName.c18
-rw-r--r--generic/tclHash.c64
-rw-r--r--generic/tclIO.c6
-rw-r--r--generic/tclIOGT.c2
-rw-r--r--generic/tclIORChan.c10
-rw-r--r--generic/tclIORTrans.c6
-rw-r--r--generic/tclIOUtil.c12
-rw-r--r--generic/tclIndexObj.c10
-rw-r--r--generic/tclInt.h95
-rw-r--r--generic/tclInterp.c6
-rw-r--r--generic/tclLink.c2
-rw-r--r--generic/tclListObj.c12
-rw-r--r--generic/tclNamesp.c8
-rw-r--r--generic/tclOODefineCmds.c16
-rw-r--r--generic/tclOOMethod.c10
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclPathObj.c6
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclProc.c10
-rw-r--r--generic/tclProcess.c4
-rw-r--r--generic/tclRegexp.c6
-rw-r--r--generic/tclResult.c10
-rw-r--r--generic/tclStrToD.c2
-rw-r--r--generic/tclStringObj.c719
-rw-r--r--generic/tclStringRep.h11
-rw-r--r--generic/tclStubInit.c36
-rw-r--r--generic/tclTest.c9
-rw-r--r--generic/tclTestObj.c31
-rw-r--r--generic/tclTrace.c10
-rw-r--r--generic/tclUtf.c342
-rw-r--r--generic/tclUtil.c8
-rw-r--r--generic/tclVar.c12
-rw-r--r--generic/tclZipfs.c2
-rw-r--r--generic/tclZlib.c8
-rw-r--r--library/http/http.tcl82
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/manifest.txt2
-rw-r--r--libtommath/bn_mp_mul.c2
-rw-r--r--libtommath/tommath.h15
-rw-r--r--tests/http.test28
-rw-r--r--tests/obj.test4
-rw-r--r--tests/string.test2
-rw-r--r--tests/stringObj.test43
-rw-r--r--tests/utf.test2
-rw-r--r--unix/Makefile.in4
-rw-r--r--win/Makefile.in4
-rwxr-xr-xwin/configure2
-rw-r--r--win/makefile.vc4
-rw-r--r--win/rules.vc15
-rw-r--r--win/tcl.m42
-rw-r--r--win/tclWinTest.c12
86 files changed, 1712 insertions, 765 deletions
diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml
index 1549b5f..c365faa 100644
--- a/.github/workflows/linux-build.yml
+++ b/.github/workflows/linux-build.yml
@@ -7,7 +7,7 @@ jobs:
matrix:
cfgopt:
- ""
- - "CFLAGS=-DTCL_UTF_MAX=4"
+ - "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml
index 52fa62b..e3c991e 100644
--- a/.github/workflows/win-build.yml
+++ b/.github/workflows/win-build.yml
@@ -13,7 +13,7 @@ jobs:
matrix:
cfgopt:
- ""
- - "OPTS=utfmax"
+ - "OPTS=utf16"
- "CHECKS=nodep"
- "OPTS=static"
- "OPTS=symbols"
@@ -52,7 +52,7 @@ jobs:
matrix:
cfgopt:
- ""
- - "CFLAGS=-DTCL_UTF_MAX=4"
+ - "CFLAGS=-DTCL_UTF_MAX=3"
- "CFLAGS=-DTCL_NO_DEPRECATED=1"
- "--disable-shared"
- "--enable-symbols"
diff --git a/.travis.yml b/.travis.yml
index ed6097c..02fd9a3 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -222,8 +222,8 @@ jobs:
before_install: *vcpreinst
install: []
script:
- - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest
- - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test
+ - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utf16' '-f' makefile.vc all tcltest
+ - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utf16' '-f' makefile.vc test
- name: "Windows/MSVC/Shared: NO_DEPRECATED"
os: windows
compiler: cl
@@ -277,8 +277,8 @@ jobs:
before_install: *vcpreinst
install: []
script:
- - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest
- - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test
+ - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utf16' '-f' makefile.vc all tcltest
+ - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utf16' '-f' makefile.vc test
- name: "Windows/MSVC-x86/Shared: NO_DEPRECATED"
os: windows
compiler: cl
diff --git a/compat/zlib/configure b/compat/zlib/configure
index 52ff4a0..3fa3e86 100755
--- a/compat/zlib/configure
+++ b/compat/zlib/configure
@@ -174,7 +174,10 @@ if test -z "$CC"; then
else
cc=${CROSS_PREFIX}cc
fi
+else
+ cc=${CC}
fi
+
cflags=${CFLAGS-"-O3"}
# to force the asm version use: CFLAGS="-O3 -DASMV" ./configure
case "$cc" in
diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c
index 0550606..2175bde 100644
--- a/compat/zlib/contrib/infback9/inftree9.c
+++ b/compat/zlib/contrib/infback9/inftree9.c
@@ -64,7 +64,7 @@ unsigned short FAR *work;
static const unsigned short lext[31] = { /* Length codes 257..285 extra */
128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129,
130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132,
- 133, 133, 133, 133, 144, 199, 202};
+ 133, 133, 133, 133, 144, 76, 202};
static const unsigned short dbase[32] = { /* Distance codes 0..31 base */
1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49,
65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073,
diff --git a/compat/zlib/contrib/minizip/iowin32.c b/compat/zlib/contrib/minizip/iowin32.c
index 274f39e..7df5251 100644
--- a/compat/zlib/contrib/minizip/iowin32.c
+++ b/compat/zlib/contrib/minizip/iowin32.c
@@ -28,6 +28,11 @@
// see Include/shared/winapifamily.h in the Windows Kit
#if defined(WINAPI_FAMILY_PARTITION) && (!(defined(IOWIN32_USING_WINRT_API)))
+
+#if !defined(WINAPI_FAMILY_ONE_PARTITION)
+#define WINAPI_FAMILY_ONE_PARTITION(PartitionSet, Partition) ((WINAPI_FAMILY & PartitionSet) == Partition)
+#endif
+
#if WINAPI_FAMILY_ONE_PARTITION(WINAPI_FAMILY, WINAPI_PARTITION_APP)
#define IOWIN32_USING_WINRT_API 1
#endif
diff --git a/compat/zlib/crc32.c b/compat/zlib/crc32.c
index a1bdce5..451887b 100644
--- a/compat/zlib/crc32.c
+++ b/compat/zlib/crc32.c
@@ -630,7 +630,7 @@ unsigned long ZEXPORT crc32_z(crc, buf, len)
#endif /* DYNAMIC_CRC_TABLE */
/* Pre-condition the CRC */
- crc ^= 0xffffffff;
+ crc = (~crc) & 0xffffffff;
/* Compute the CRC up to a word boundary. */
while (len && ((z_size_t)buf & 7) != 0) {
@@ -749,7 +749,7 @@ unsigned long ZEXPORT crc32_z(crc, buf, len)
#endif /* DYNAMIC_CRC_TABLE */
/* Pre-condition the CRC */
- crc ^= 0xffffffff;
+ crc = (~crc) & 0xffffffff;
#ifdef W
@@ -1077,7 +1077,7 @@ uLong ZEXPORT crc32_combine64(crc1, crc2, len2)
#ifdef DYNAMIC_CRC_TABLE
once(&made, make_crc_table);
#endif /* DYNAMIC_CRC_TABLE */
- return multmodp(x2nmodp(len2, 3), crc1) ^ crc2;
+ return multmodp(x2nmodp(len2, 3), crc1) ^ (crc2 & 0xffffffff);
}
/* ========================================================================= */
@@ -1112,5 +1112,5 @@ uLong crc32_combine_op(crc1, crc2, op)
uLong crc2;
uLong op;
{
- return multmodp(op, crc1) ^ crc2;
+ return multmodp(op, crc1) ^ (crc2 & 0xffffffff);
}
diff --git a/compat/zlib/deflate.h b/compat/zlib/deflate.h
index 17c2261..1a06cd5 100644
--- a/compat/zlib/deflate.h
+++ b/compat/zlib/deflate.h
@@ -329,8 +329,8 @@ void ZLIB_INTERNAL _tr_stored_block OF((deflate_state *s, charf *buf,
# define _tr_tally_dist(s, distance, length, flush) \
{ uch len = (uch)(length); \
ush dist = (ush)(distance); \
- s->sym_buf[s->sym_next++] = dist; \
- s->sym_buf[s->sym_next++] = dist >> 8; \
+ s->sym_buf[s->sym_next++] = (uch)dist; \
+ s->sym_buf[s->sym_next++] = (uch)(dist >> 8); \
s->sym_buf[s->sym_next++] = len; \
dist--; \
s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \
diff --git a/compat/zlib/inftrees.c b/compat/zlib/inftrees.c
index 09462a7..a2f386c 100644
--- a/compat/zlib/inftrees.c
+++ b/compat/zlib/inftrees.c
@@ -62,7 +62,7 @@ unsigned short FAR *work;
35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0};
static const unsigned short lext[31] = { /* Length codes 257..285 extra */
16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18,
- 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 199, 202};
+ 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 76, 202};
static const unsigned short dbase[32] = { /* Distance codes 0..29 base */
1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
diff --git a/compat/zlib/trees.c b/compat/zlib/trees.c
index f73fd99..8b438cc 100644
--- a/compat/zlib/trees.c
+++ b/compat/zlib/trees.c
@@ -1017,9 +1017,9 @@ int ZLIB_INTERNAL _tr_tally (s, dist, lc)
unsigned dist; /* distance of matched string */
unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */
{
- s->sym_buf[s->sym_next++] = dist;
- s->sym_buf[s->sym_next++] = dist >> 8;
- s->sym_buf[s->sym_next++] = lc;
+ s->sym_buf[s->sym_next++] = (uch)dist;
+ s->sym_buf[s->sym_next++] = (uch)(dist >> 8);
+ s->sym_buf[s->sym_next++] = (uch)lc;
if (dist == 0) {
/* lc is the unmatched char */
s->dyn_ltree[lc].Freq++;
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 6c45f4d..e87de8c 100755
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win64-arm/zlib1.dll b/compat/zlib/win64-arm/zlib1.dll
index 161b60f..9025467 100755
--- a/compat/zlib/win64-arm/zlib1.dll
+++ b/compat/zlib/win64-arm/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
index 62182ba..c822c70 100755
--- a/compat/zlib/win64/zlib1.dll
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
diff --git a/doc/http.n b/doc/http.n
index 0ba6be2..4781a1b 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -49,6 +49,14 @@ http \- Client-side implementation of the HTTP/1.1 protocol
\fB::http::registerError \fIport\fR ?\fImessage\fR?
.sp
\fB::http::unregister \fIproto\fR
+.SH "EXPORTED COMMANDS"
+.PP
+Namespace \fBhttp\fR exports the commands \fBconfig\fR, \fBformatQuery\fR,
+\fBgeturl\fR, \fBquoteString\fR, \fBregister\fR, \fBregisterError\fR,
+\fBreset\fR, \fBunregister\fR, and \fBwait\fR.
+.PP
+It does not export the commands \fBcleanup\fR, \fBcode\fR, \fBdata\fR,
+\fBerror\fR, \fBmeta\fR, \fBncode\fR, \fBsize\fR, or \fBstatus\fR.
.BE
.SH DESCRIPTION
.PP
@@ -79,8 +87,9 @@ must be active. In Tk applications this is always true. For pure-Tcl
applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.
.PP
-\fBNote:\fR The event queue is even used without the \fB-command\fR option.
-As a side effect, arbitrary commands may be processed while \fBhttp::geturl\fR is running.
+\fBNote:\fR The event queue is even used without the \fB\-command\fR option.
+As a side effect, arbitrary commands may be processed while \fBhttp::geturl\fR
+is running.
.SH COMMANDS
.TP
\fB::http::config\fR ?\fIoptions\fR?
@@ -120,9 +129,9 @@ is 1.
\fB\-postfresh\fR \fIboolean\fR
.
Specifies whether requests that use the \fBPOST\fR method will always use a
-fresh socket, overriding the \fB-keepalive\fR option of
-command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details.
-The default is 0.
+fresh socket, overriding the \fB\-keepalive\fR option of
+command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for
+details. The default is 0.
.TP
\fB\-proxyhost\fR \fIhostname\fR
.
@@ -144,6 +153,13 @@ the proxy server and proxy port. Otherwise the filter should return
an empty list. The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
+.RS
+.PP
+The \fB::http::geturl\fR command runs the \fB\-proxyfilter\fR callback inside
+a \fBcatch\fR command. Therefore an error in the callback command does
+not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for
+details.
+.RE
.TP
\fB\-repost\fR \fIboolean\fR
.
@@ -161,12 +177,7 @@ default is 0.
.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
-The default is \fButf-8\fR, as specified by RFC
-2718. Prior to http 2.5 this was unspecified, and that behavior can be
-returned by specifying the empty string (\fB{}\fR), although
-\fIiso8859-1\fR is recommended to restore similar behavior but without the
-\fB::http::formatQuery\fR or \fB::http::quoteString\fR
-throwing an error processing non-latin-1 characters.
+The default is \fButf-8\fR, as specified by RFC 2718.
.TP
\fB\-useragent\fR \fIstring\fR
.
@@ -182,9 +193,9 @@ numbers of \fBhttp\fR and \fBTcl\fR.
.
If the value is boolean \fBtrue\fR, then by default requests will send a header
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
-If the value is boolean \fBfalse\fR, then by default this header will not be sent.
-In either case the default can be overridden for an individual request by
-supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
+If the value is boolean \fBfalse\fR, then by default this header will not be
+sent. In either case the default can be overridden for an individual request by
+supplying a custom \fBAccept-Encoding\fR header in the \fB\-headers\fR option
of \fBhttp::geturl\fR. The default is 1.
.RE
.TP
@@ -237,6 +248,11 @@ proc httpCallback {token} {
# Access state as a Tcl array
}
.CE
+.PP
+The \fB::http::geturl\fR command runs the \fB\-command\fR callback inside
+a \fBcatch\fR command. Therefore an error in the callback command does
+not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for
+details.
.RE
.TP
\fB\-handler\fR \fIcallback\fR
@@ -263,9 +279,21 @@ proc httpHandlerCallback {socket token} {
}
.CE
.PP
-The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding. If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
+The \fBhttp::geturl\fR code for the \fB\-handler\fR option is not compatible
+with either compression or chunked transfer-encoding. If \fB\-handler\fR is
+specified, then to work around these issues \fBhttp::geturl\fR will reduce the
+HTTP protocol to 1.0, and override the \fB\-zip\fR option (i.e. it will not
+send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
.PP
-If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel. The name of the channel is available to the handler as element \fB-channel\fR of the token array.
+If options \fB\-handler\fR and \fB\-channel\fR are used together, the handler
+is responsible for copying the data from the HTTP socket to the specified
+channel. The name of the channel is available to the handler as element
+\fB\-channel\fR of the token array.
+.PP
+The \fB::http::geturl\fR command runs the \fB\-handler\fR callback inside
+a \fBcatch\fR command. Therefore an error in the callback command does
+not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for
+details.
.RE
.TP
\fB\-headers\fR \fIkeyvaluelist\fR
@@ -293,8 +321,16 @@ multiple requests. Default is 0.
\fB\-method\fR \fItype\fR
.
Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
-auto-select GET, POST or HEAD based on other options, but this option
-enables choices like PUT and DELETE for webdav support.
+auto-select GET, POST or HEAD based on other options, but this option overrides
+that selection and enables choices like PUT and DELETE for WebDAV support.
+.RS
+.PP
+It is the caller's responsibility to ensure that the headers and request body
+(if any) conform to the requirements of the request method. For example, if
+using \fB\-method\fR \fIPOST\fR to send a POST with an empty request body, the
+caller must also supply the option
+.QW "\-headers {Content-Length 0}" .
+.RE
.TP
\fB\-myaddr\fR \fIaddress\fR
.
@@ -327,12 +363,21 @@ otherwise complain about HTTP/1.1.
.TP
\fB\-query\fR \fIquery\fR
.
-This flag causes \fB::http::geturl\fR to do a POST request that passes the
-\fIquery\fR as payload verbatim to the server.
-The content format (and encoding) of \fIquery\fR is announced by the header
-field \fBcontent-type\fR set by the option \fB-type\fR.
-\fIquery\fR is an x-url-encoding formatted query, if used for html forms.
-The \fB::http::formatQuery\fR procedure can be used to do the formatting.
+This flag (if the value is non-empty) causes \fB::http::geturl\fR to do a
+POST request that passes the string
+\fIquery\fR verbatim to the server as the request payload.
+The content format (and encoding) of \fIquery\fR is announced by the request
+header \fBContent-Type\fR which is set by the option \fB\-type\fR. Any value
+of \fB\-type\fR is permitted, and it is the responsibility of the caller to
+supply \fIquery\fR in the correct format.
+.RS
+.PP
+If \fB\-type\fR is not specified, it defaults to
+\fIapplication/x-www-form-urlencoded\fR, which requires \fIquery\fR to be an
+x-url-encoding formatted query-string (this \fB\-type\fR and query format are
+used in a POST submitted from an html form). The \fB::http::formatQuery\fR
+procedure can be used to do the formatting.
+.RE
.TP
\fB\-queryblocksize\fR \fIsize\fR
.
@@ -531,6 +576,14 @@ to know the result of the asynchronous HTTP request, it can call
\fB::http::wait\fR and then check status and error, just as the
callback does.
.PP
+The \fB::http::geturl\fR command runs the \fB\-command\fR, \fB\-handler\fR,
+and \fB\-proxyfilter\fR callbacks inside a \fBcatch\fR command. Therefore
+an error in the callback command does not call the \fBbgerror\fR handler.
+When debugging one of these
+callbacks, it may be convenient to report errors by using a
+\fBcatch\fR command within the callback command itself, e.g. to write
+an error message to stdout.
+.PP
In any case, you must still call
\fB::http::cleanup\fR to delete the state array when you are done.
.PP
@@ -601,7 +654,8 @@ if the HTTP response is text.
\fBbody\fR
.
The contents of the URL. This will be empty if the \fB\-channel\fR
-option has been specified. This value is returned by the \fB::http::data\fR command.
+option has been specified. This value is returned by the \fB::http::data\fR
+command.
.TP
\fBcharset\fR
.
@@ -713,9 +767,9 @@ whether the server was modified by the failed POST request, before
sending the same request again.
.PP
A HTTP request will use a persistent socket if the call to
-\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
+\fBhttp::geturl\fR has the option \fB\-keepalive true\fR. It will use
pipelining where permitted if the \fBhttp::config\fR option
-\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
+\fB\-pipeline\fR is boolean \fBtrue\fR (its default value).
.PP
The http package maintains no more than one persistent connection to each
server (i.e. each value of
@@ -737,8 +791,8 @@ In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
requests that use the POST method. If a POST uses a persistent
connection and is not the first request on that connection,
\fBhttp::geturl\fR waits until it has received the response for the previous
-request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
-uses a new connection for each POST.
+request; or (if \fBhttp::config\fR option \fB\-postfresh\fR is boolean
+\fBtrue\fR) it uses a new connection for each POST.
.PP
If the server is processing a number of pipelined requests, and sends a
response header
@@ -758,7 +812,7 @@ GET requests, \fBhttp::geturl\fR opens another connection and retransmits
the failed request. However, if the request was a POST, RFC 7230 forbids
automatic retry by default, suggesting either user confirmation, or
confirmation by user-agent software that has semantic understanding of
-the application. The \fBhttp::config\fR option \fB-repost\fR allows for
+the application. The \fBhttp::config\fR option \fB\-repost\fR allows for
either possibility.
.PP
Asynchronous close events can occur only in a short interval of time. The
@@ -766,35 +820,36 @@ Asynchronous close events can occur only in a short interval of time. The
server. Upon detection, the connection is also closed at the client end,
and subsequent requests will use a fresh connection.
.PP
-If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
+If the \fBhttp::geturl\fR command is called with option \fB\-keepalive true\fR,
then it will both try to use an existing persistent connection
(if one is available), and it will send the server a
.QW "\fBConnection: keep-alive\fR"
request header asking to keep the connection open for future requests.
.PP
-The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
-\fB-repost\fR relate to persistent connections.
+The \fBhttp::config\fR options \fB\-pipeline\fR, \fB\-postfresh\fR, and
+\fB\-repost\fR relate to persistent connections.
.PP
-Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
-made
-over a persistent connection. POST requests will not be pipelined - if the
+Option \fB\-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD
+requests made over a persistent connection. POST requests will not be
+pipelined - if the
POST is not the first transaction on the connection, its request will not
be sent until the previous response has finished. GET and HEAD requests
made after a POST will not be sent until the POST response has been
delivered, and will not be sent if the POST fails.
.PP
-Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
-\fB-keepalive\fR, and always open a fresh connection for a POST request.
+Option \fB\-postfresh\fR, if boolean \fBtrue\fR, will override the
+\fBhttp::geturl\fR option \fB\-keepalive\fR, and always open a fresh connection
+for a POST request.
.PP
-Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
+Option \fB\-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
that fails because it uses a persistent connection that the server has
half-closed (an
.QW "asynchronous close event" ).
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
-\fIThe -repost option should be used only if the application understands
+\fIThe \-repost option should be used only if the application understands
that the retry is appropriate\fR - specifically, the application must know
-that if the failed POST successfully modified the state of the server, a repeat POST
-would have no adverse effect.
+that if the failed POST successfully modified the state of the server, a repeat
+POST would have no adverse effect.
.VS TIP406
.SH "COOKIE JAR PROTOCOL"
.PP
@@ -897,6 +952,40 @@ request.
Other keys may always be ignored; they have no meaning in this protocol.
.RE
.VE TIP406
+.SH "PROTOCOL UPGRADES"
+.PP
+The HTTP/1.1 \fBConnection\fR and \fBUpgrade\fR client headers inform the server
+that the client wishes to change the protocol used over the existing connection
+(RFC 7230). This mechanism can be used to request a WebSocket (RFC 6455), a
+higher version of the HTTP protocol (HTTP 2), or TLS encryption. If the
+server accepts the upgrade request, its response code will be 101.
+.PP
+To request a protocol upgrade when calling \fBhttp::geturl\fR, the \fB\-headers\fR
+option must supply appropriate values for \fBConnection\fR and \fBUpgrade\fR, and
+the \fB\-command\fR option must supply a command that implements the requested
+protocol and can also handle the server response if the server refuses the
+protocol upgrade. For upgrade requests \fBhttp::geturl\fR ignores the value of
+option \fB\-keepalive\fR, and always uses the value \fB0\fR so that the upgrade
+request is not made over a connection that is intended for multiple HTTP requests.
+.PP
+The Tcllib library \fBwebsocket\fR implements WebSockets, and makes the necessary
+calls to commands in the \fBhttp\fR package.
+.PP
+There is currently no native Tcl client library for HTTP/2.
+.PP
+The \fBUpgrade\fR mechanism is not used to request TLS in web browsers, because
+\fBhttp\fR and \fBhttps\fR are served over different ports. It is used by
+protocols such as Internet Printing Protocol (IPP) that are built on top of
+\fBhttp(s)\fR and use the same TCP port number for both secure and insecure
+traffic.
+.PP
+In browsers, opportunistic encryption is instead implemented by the
+\fBUpgrade-Insecure-Requests\fR client header. If a secure service is available,
+the server response code is a 307 redirect, and the response header
+\fBLocation\fR specifies the target URL. The browser must call \fBhttp::geturl\fR
+again in order to fetch this URL.
+See https://w3c.github.io/webappsec-upgrade-insecure-requests/
+.PP
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
@@ -932,7 +1021,7 @@ proc httpcopy { url file {chunk 4096} } {
return $token
}
proc httpCopyProgress {args} {
- puts -nonewline stderr .
+ puts \-nonewline stderr .
flush stderr
}
.CE
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 082bee3..350f0e1 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1248,7 +1248,7 @@ declare 352 {
int Tcl_Char16Len(const unsigned short *uniStr)
}
declare 353 {deprecated {Use Tcl_UtfNcmp}} {
- int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
+ int Tcl_UniCharNcmp(const unsigned short *ucs, const unsigned short *uct,
unsigned long numChars)
}
declare 354 {
@@ -1338,10 +1338,10 @@ declare 377 {
void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
- Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars)
+ Tcl_Obj *Tcl_NewUnicodeObj(const unsigned short *unicode, int numChars)
}
declare 379 {
- void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
+ void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const unsigned short *unicode,
int numChars)
}
declare 380 {
@@ -1351,13 +1351,13 @@ declare 381 {
int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
declare 382 {deprecated {No longer in use, changed to macro}} {
- Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
+ unsigned short *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 {
Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
-declare 384 {deprecated {Use Tcl_AppendStringsToObj}} {
- void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
+declare 384 {
+ void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const unsigned short *unicode,
int length)
}
declare 385 {
@@ -1483,12 +1483,12 @@ declare 418 {
int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {deprecated {Use Tcl_UtfNcasecmp}} {
- int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
+ int Tcl_UniCharNcasecmp(const unsigned short *ucs, const unsigned short *uct,
unsigned long numChars)
}
declare 420 {deprecated {Use Tcl_StringCaseMatch}} {
- int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
- const Tcl_UniChar *uniPattern, int nocase)
+ int Tcl_UniCharCaseMatch(const unsigned short *uniStr,
+ const unsigned short *uniPattern, int nocase)
}
declare 421 {
Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
@@ -1541,7 +1541,7 @@ declare 433 {
# introduced in 8.4a3
declare 434 {
- Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+ unsigned short *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
# TIP#15 (math function introspection) dkf
@@ -2417,7 +2417,7 @@ declare 651 {
char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
- Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
+ unsigned short *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
@@ -2454,6 +2454,21 @@ declare 660 {
declare 668 {
int Tcl_UniCharLen(const int *uniStr)
}
+declare 669 {
+ int TclNumUtfChars(const char *src, int length)
+}
+declare 670 {
+ int TclGetCharLength(Tcl_Obj *objPtr)
+}
+declare 671 {
+ const char *TclUtfAtIndex(const char *src, int index)
+}
+declare 672 {
+ Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, int first, int last)
+}
+declare 673 {
+ int TclGetUniChar(Tcl_Obj *objPtr, int index)
+}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
diff --git a/generic/tcl.h b/generic/tcl.h
index 63adb86..e6ffd57 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2143,7 +2143,11 @@ typedef struct Tcl_EncodingType {
*/
#ifndef TCL_UTF_MAX
-#define TCL_UTF_MAX 3
+# ifdef BUILD_tcl
+# define TCL_UTF_MAX 4
+# else
+# define TCL_UTF_MAX 3
+# endif
#endif
/*
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 5825dcb..5a4e30d 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1985,7 +1985,7 @@ CreateMirrorJumpTable(
* table. */
int i;
- if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
if (objc % 2 != 0) {
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 74cb683..f87e1e1 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5179,7 +5179,7 @@ TEOV_NotFound(
* itself.
*/
- TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
+ TclListObjGetElementsM(NULL, currNsPtr->unknownHandlerPtr,
&handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
@@ -5736,7 +5736,7 @@ TclEvalEx(
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
int numElements;
- code = TclListObjLength(interp, objv[objectsUsed],
+ code = TclListObjLengthM(interp, objv[objectsUsed],
&numElements);
if (code == TCL_ERROR) {
/*
@@ -5788,7 +5788,7 @@ TclEvalEx(
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
- TclListObjGetElements(NULL, temp, &numElements,
+ TclListObjGetElementsM(NULL, temp, &numElements,
&elements);
objectsUsed += numElements;
while (numElements--) {
@@ -6628,7 +6628,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
objPtr, NULL);
- TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ TclListObjGetElementsM(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
}
@@ -9397,7 +9397,7 @@ TclNRTailcallEval(
int objc;
Tcl_Obj **objv;
- TclListObjGetElements(interp, listPtr, &objc, &objv);
+ TclListObjGetElementsM(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
if (result == TCL_OK) {
@@ -9825,7 +9825,7 @@ TclNREvalList(
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
- TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ TclListObjGetElementsM(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, 0, NULL);
}
@@ -10111,7 +10111,7 @@ InjectHandler(
TclMarkTailcall(interp);
TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr,
INT2PTR(nargs), isProbe);
- TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ TclListObjGetElementsM(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, 0, NULL);
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 4717b05..5678a66 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -434,7 +434,7 @@ TclGetBytesFromObj(
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
baPtr = GET_BYTEARRAY(irPtr);
- nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
+ nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
TclUtfToUCS4(nonbyte, &ucs4);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -473,7 +473,7 @@ Tcl_GetBytesFromObj(
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
baPtr = GET_BYTEARRAY(irPtr);
- nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
+ nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
TclUtfToUCS4(nonbyte, &ucs4);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -1129,7 +1129,7 @@ BinaryFormatCmd(
* The macro evals its args more than once: avoid arg++
*/
- if (TclListObjGetElements(interp, objv[arg], &listc,
+ if (TclListObjGetElementsM(interp, objv[arg], &listc,
&listv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1411,7 +1411,7 @@ BinaryFormatCmd(
listc = 1;
count = 1;
} else {
- TclListObjGetElements(interp, objv[arg], &listc, &listv);
+ TclListObjGetElementsM(interp, objv[arg], &listc, &listv);
if (count == BINARY_ALL) {
count = listc;
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 4473f74..0669ffe 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -754,7 +754,7 @@ ConvertLocalToUTC(
* Unpack the tz data.
*/
- if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
@@ -819,7 +819,7 @@ ConvertLocalToUTCUsingTable(
while (!found) {
row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
if ((row == NULL)
- || TclListObjGetElements(interp, row, &cellc,
+ || TclListObjGetElementsM(interp, row, &cellc,
&cellv) != TCL_OK
|| TclGetIntFromObj(interp, cellv[1],
&fields->tzOffset) != TCL_OK) {
@@ -957,7 +957,7 @@ ConvertUTCToLocal(
* Unpack the tz data.
*/
- if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1009,7 +1009,7 @@ ConvertUTCToLocalUsingTable(
row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
if (row == NULL ||
- TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
+ TclListObjGetElementsM(interp, row, &cellc, &cellv) != TCL_OK ||
TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 401b14a..e4303e6 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -188,7 +188,7 @@ Tcl_CaseObjCmd(
if (caseObjc == 1) {
Tcl_Obj **newObjv;
- TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+ TclListObjGetElementsM(interp, caseObjv[0], &caseObjc, &newObjv);
caseObjv = newObjv;
}
@@ -2742,7 +2742,7 @@ EachloopCmd(
result = TCL_ERROR;
goto done;
}
- TclListObjGetElements(NULL, statePtr->vCopyList[i],
+ TclListObjGetElementsM(NULL, statePtr->vCopyList[i],
&statePtr->varcList[i], &statePtr->varvList[i]);
if (statePtr->varcList[i] < 1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2760,7 +2760,7 @@ EachloopCmd(
result = TCL_ERROR;
goto done;
}
- TclListObjGetElements(NULL, statePtr->aCopyList[i],
+ TclListObjGetElementsM(NULL, statePtr->aCopyList[i],
&statePtr->argcList[i], &statePtr->argvList[i]);
j = statePtr->argcList[i] / statePtr->varcList[i];
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 986dd49..f32fd98 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2194,7 +2194,7 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
- if (TclListObjGetElements(interp, objv[1], &listLen,
+ if (TclListObjGetElementsM(interp, objv[1], &listLen,
&elemPtrs) != TCL_OK) {
return TCL_ERROR;
}
@@ -2281,7 +2281,7 @@ Tcl_LassignObjCmd(
return TCL_ERROR;
}
- TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
+ TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv);
objc -= 2;
objv += 2;
@@ -2406,7 +2406,7 @@ Tcl_LinsertObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &len);
+ result = TclListObjLengthM(interp, objv[1], &len);
if (result != TCL_OK) {
return result;
}
@@ -2524,7 +2524,7 @@ Tcl_LlengthObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2577,7 +2577,7 @@ Tcl_LpopObjCmd(
return TCL_ERROR;
}
- result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+ result = TclListObjGetElementsM(interp, listPtr, &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -2671,7 +2671,7 @@ Tcl_LrangeObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2745,7 +2745,7 @@ Tcl_LremoveObjCmd(
}
listObj = objv[1];
- if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) {
return TCL_ERROR;
}
@@ -2969,7 +2969,7 @@ Tcl_LreplaceObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -3067,7 +3067,7 @@ Tcl_LreverseObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "list");
return TCL_ERROR;
}
- if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) {
return TCL_ERROR;
}
@@ -3338,7 +3338,7 @@ Tcl_LsearchObjCmd(
*/
i++;
- if (TclListObjGetElements(interp, objv[i],
+ if (TclListObjGetElementsM(interp, objv[i],
&sortInfo.indexc, &indices) != TCL_OK) {
result = TCL_ERROR;
goto done;
@@ -3444,7 +3444,7 @@ Tcl_LsearchObjCmd(
* pointer to its array of element pointers.
*/
- result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
+ result = TclListObjGetElementsM(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
goto done;
}
@@ -3549,7 +3549,7 @@ Tcl_LsearchObjCmd(
* 1844789]
*/
- TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+ TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
break;
case REAL:
result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
@@ -3562,7 +3562,7 @@ Tcl_LsearchObjCmd(
* 1844789]
*/
- TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+ TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
break;
}
} else {
@@ -4073,7 +4073,7 @@ Tcl_LsortObjCmd(
sortInfo.resultCode = TCL_ERROR;
goto done;
}
- if (TclListObjGetElements(interp, objv[i+1], &sortindex,
+ if (TclListObjGetElementsM(interp, objv[i+1], &sortindex,
&indexv) != TCL_OK) {
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -4165,7 +4165,7 @@ Tcl_LsortObjCmd(
if (indexPtr) {
Tcl_Obj **indexv;
- TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
+ TclListObjGetElementsM(interp, indexPtr, &sortInfo.indexc, &indexv);
switch (sortInfo.indexc) {
case 0:
sortInfo.indexv = NULL;
@@ -4225,7 +4225,7 @@ Tcl_LsortObjCmd(
sortInfo.compareCmdPtr = newCommandPtr;
}
- sortInfo.resultCode = TclListObjGetElements(interp, listObj,
+ sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
&length, &listObjPtrs);
if (sortInfo.resultCode != TCL_OK || length <= 0) {
goto done;
@@ -4642,10 +4642,10 @@ SortCompare(
* Replace them and evaluate the result.
*/
- TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+ TclListObjLengthM(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
2, 2, paramObjv);
- TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+ TclListObjGetElementsM(infoPtr->interp, infoPtr->compareCmdPtr,
&objc, &objv);
infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
@@ -4855,7 +4855,7 @@ SelectObjFromSublist(
int listLen, index;
Tcl_Obj *currentObj;
- if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
+ if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f394035..a9d1f11 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -256,7 +256,7 @@ Tcl_RegexpObjCmd(
*/
objPtr = objv[1];
- stringLength = Tcl_GetCharLength(objPtr);
+ stringLength = TclGetCharLength(objPtr);
if (startIndex) {
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
@@ -310,7 +310,7 @@ Tcl_RegexpObjCmd(
eflags = 0;
} else if (offset > stringLength) {
eflags = TCL_REG_NOTBOL;
- } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
+ } else if (TclGetUniChar(objPtr, offset-1) == '\n') {
eflags = 0;
} else {
eflags = TCL_REG_NOTBOL;
@@ -395,7 +395,7 @@ Tcl_RegexpObjCmd(
newPtr = Tcl_NewListObj(2, objs);
} else {
if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
- newPtr = Tcl_GetRange(objPtr,
+ newPtr = TclGetRange(objPtr,
offset + info.matches[i].start,
offset + info.matches[i].end - 1);
} else {
@@ -581,7 +581,7 @@ Tcl_RegsubObjCmd(
objv += idx;
if (startIndex) {
- int stringLength = Tcl_GetCharLength(objv[1]);
+ int stringLength = TclGetCharLength(objv[1]);
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
@@ -604,11 +604,11 @@ Tcl_RegsubObjCmd(
numMatches = 0;
nocase = (cflags & TCL_REG_NOCASE);
- strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
+ strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;
- wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
- wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
- wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
+ wsrc = TclGetUnicodeFromObj_(objv[0], &slen);
+ wstring = TclGetUnicodeFromObj_(objv[1], &wlen);
+ wsubspec = TclGetUnicodeFromObj_(objv[2], &wsublen);
wend = wstring + wlen - (slen ? slen - 1 : 0);
result = TCL_OK;
@@ -619,11 +619,11 @@ Tcl_RegsubObjCmd(
*/
if (wstring < wend) {
- resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ resultPtr = TclNewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
for (; wstring < wend; wstring++) {
- Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
- Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
+ TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ TclAppendUnicodeToObj(resultPtr, wstring, 1);
numMatches++;
}
wlen = 0;
@@ -636,18 +636,18 @@ Tcl_RegsubObjCmd(
(slen==1 || (strCmpFn(wstring, wsrc,
(unsigned long) slen) == 0))) {
if (numMatches == 0) {
- resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ resultPtr = TclNewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
}
if (p != wstring) {
- Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
+ TclAppendUnicodeToObj(resultPtr, p, wstring - p);
p = wstring + slen;
} else {
p += slen;
}
wstring = p - 1;
- Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
numMatches++;
}
}
@@ -674,7 +674,7 @@ Tcl_RegsubObjCmd(
* object. (If they aren't, that's cheap to do.)
*/
- if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[2], &numParts) != TCL_OK) {
return TCL_ERROR;
}
if (numParts < 1) {
@@ -699,14 +699,14 @@ Tcl_RegsubObjCmd(
} else {
objPtr = objv[1];
}
- wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
+ wstring = TclGetUnicodeFromObj_(objPtr, &wlen);
if (objv[2] == objv[0]) {
subPtr = Tcl_DuplicateObj(objv[2]);
} else {
subPtr = objv[2];
}
if (!command) {
- wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
+ wsubspec = TclGetUnicodeFromObj_(subPtr, &wsublen);
}
result = TCL_OK;
@@ -742,7 +742,7 @@ Tcl_RegsubObjCmd(
break;
}
if (numMatches == 0) {
- resultPtr = Tcl_NewUnicodeObj(wstring, 0);
+ resultPtr = TclNewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
if (offset > 0) {
/*
@@ -750,7 +750,7 @@ Tcl_RegsubObjCmd(
* specified.
*/
- Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
+ TclAppendUnicodeToObj(resultPtr, wstring, offset);
}
}
numMatches++;
@@ -763,7 +763,7 @@ Tcl_RegsubObjCmd(
Tcl_RegExpGetInfo(regExpr, &info);
start = info.matches[0].start;
end = info.matches[0].end;
- Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
+ TclAppendUnicodeToObj(resultPtr, wstring + offset, start);
/*
* In command-prefix mode, the substitutions are added as quoted
@@ -776,7 +776,7 @@ Tcl_RegsubObjCmd(
Tcl_Obj **args = NULL, **parts;
int numArgs;
- TclListObjGetElements(interp, subPtr, &numParts, &parts);
+ TclListObjGetElementsM(interp, subPtr, &numParts, &parts);
numArgs = numParts + info.nsubs + 1;
args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
@@ -785,7 +785,7 @@ Tcl_RegsubObjCmd(
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
if ((subStart >= 0) && (subEnd >= 0)) {
- args[idx + numParts] = Tcl_NewUnicodeObj(
+ args[idx + numParts] = TclNewUnicodeObj(
wstring + offset + subStart, subEnd - subStart);
} else {
TclNewObj(args[idx + numParts]);
@@ -826,7 +826,7 @@ Tcl_RegsubObjCmd(
* the user code.
*/
- wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
+ wstring = TclGetUnicodeFromObj_(objPtr, &wlen);
offset += end;
if (end == 0 || start == end) {
@@ -838,7 +838,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
}
@@ -867,7 +867,7 @@ Tcl_RegsubObjCmd(
idx = ch - '0';
} else if ((ch == '\\') || (ch == '&')) {
*wsrc = ch;
- Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ TclAppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar + 1);
*wsrc = '\\';
wfirstChar = wsrc + 2;
@@ -881,7 +881,7 @@ Tcl_RegsubObjCmd(
}
if (wfirstChar != wsrc) {
- Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ TclAppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar);
}
@@ -889,7 +889,7 @@ Tcl_RegsubObjCmd(
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
if ((subStart >= 0) && (subEnd >= 0)) {
- Tcl_AppendUnicodeToObj(resultPtr,
+ TclAppendUnicodeToObj(resultPtr,
wstring + offset + subStart, subEnd - subStart);
}
}
@@ -901,7 +901,7 @@ Tcl_RegsubObjCmd(
}
if (wfirstChar != wsrc) {
- Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
+ TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
}
if (end == 0) {
@@ -911,7 +911,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
} else {
@@ -923,7 +923,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
}
@@ -948,7 +948,7 @@ Tcl_RegsubObjCmd(
resultPtr = objv[1];
Tcl_IncrRefCount(resultPtr);
} else if (offset < wlen) {
- Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
+ TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
if (objc == 4) {
if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
@@ -1316,7 +1316,7 @@ StringFirstCmd(
}
if (objc == 4) {
- int size = Tcl_GetCharLength(objv[2]);
+ int size = TclGetCharLength(objv[2]);
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
return TCL_ERROR;
@@ -1360,7 +1360,7 @@ StringLastCmd(
}
if (objc == 4) {
- int size = Tcl_GetCharLength(objv[2]);
+ int size = TclGetCharLength(objv[2]);
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
return TCL_ERROR;
@@ -1406,13 +1406,13 @@ StringIndexCmd(
* Get the char length to calculate what 'end' means.
*/
- length = Tcl_GetCharLength(objv[1]);
+ length = TclGetCharLength(objv[1]);
if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
if ((index >= 0) && (index < length)) {
- int ch = Tcl_GetUniChar(objv[1], index);
+ int ch = TclGetUniChar(objv[1], index);
if (ch == -1) {
return TCL_OK;
@@ -1474,7 +1474,7 @@ StringInsertCmd(
return TCL_ERROR;
}
- length = Tcl_GetCharLength(objv[1]);
+ length = TclGetCharLength(objv[1]);
if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -1669,7 +1669,7 @@ StringIsCmd(
p++;
}
TclNewStringObj(tmpStr, string1, p-string1);
- failat = Tcl_GetCharLength(tmpStr);
+ failat = TclGetCharLength(tmpStr);
TclDecrRefCount(tmpStr);
break;
}
@@ -1811,7 +1811,7 @@ StringIsCmd(
* well-formed lists.
*/
- if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) {
+ if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length2)) {
break;
}
@@ -1849,7 +1849,7 @@ StringIsCmd(
p++;
}
TclNewStringObj(tmpStr, string1, p-string1);
- failat = Tcl_GetCharLength(tmpStr);
+ failat = TclGetCharLength(tmpStr);
TclDecrRefCount(tmpStr);
break;
}
@@ -2025,7 +2025,7 @@ StringMapCmd(
}
Tcl_DictObjDone(&search);
} else {
- if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
+ if (TclListObjGetElementsM(interp, objv[objc-2], &mapElemc,
&mapElemv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2060,7 +2060,7 @@ StringMapCmd(
} else {
sourceObj = objv[objc-1];
}
- ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
+ ustring1 = TclGetUnicodeFromObj_(sourceObj, &length1);
if (length1 == 0) {
/*
* Empty input string, just stop now.
@@ -2070,13 +2070,13 @@ StringMapCmd(
}
end = ustring1 + length1;
- strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+ strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp);
/*
* Force result to be Unicode
*/
- resultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+ resultPtr = TclNewUnicodeObj(ustring1, 0);
if (mapElemc == 2) {
/*
@@ -2089,7 +2089,7 @@ StringMapCmd(
int mapLen, u2lc;
Tcl_UniChar *mapString;
- ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
+ ustring2 = TclGetUnicodeFromObj_(mapElemv[0], &length2);
p = ustring1;
if ((length2 > length1) || (length2 == 0)) {
/*
@@ -2098,7 +2098,7 @@ StringMapCmd(
ustring1 = end;
} else {
- mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
+ mapString = TclGetUnicodeFromObj_(mapElemv[1], &mapLen);
u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
for (; ustring1 < end; ustring1++) {
if (((*ustring1 == *ustring2) ||
@@ -2106,14 +2106,14 @@ StringMapCmd(
(length2==1 || strCmpFn(ustring1, ustring2,
(unsigned long) length2) == 0)) {
if (p != ustring1) {
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+ TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
- Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
+ TclAppendUnicodeToObj(resultPtr, mapString, mapLen);
}
}
}
@@ -2134,7 +2134,7 @@ StringMapCmd(
u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
}
for (index = 0; index < mapElemc; index++) {
- mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
+ mapStrings[index] = TclGetUnicodeFromObj_(mapElemv[index],
mapLens+index);
if (nocase && ((index % 2) == 0)) {
u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
@@ -2158,7 +2158,7 @@ StringMapCmd(
* Put the skipped chars onto the result first.
*/
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
+ TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
@@ -2174,7 +2174,7 @@ StringMapCmd(
* Append the map value to the unicode string.
*/
- Tcl_AppendUnicodeToObj(resultPtr,
+ TclAppendUnicodeToObj(resultPtr,
mapStrings[index+1], mapLens[index+1]);
break;
}
@@ -2191,7 +2191,7 @@ StringMapCmd(
* Put the rest of the unmapped chars onto result.
*/
- Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
+ TclAppendUnicodeToObj(resultPtr, p, ustring1 - p);
}
Tcl_SetObjResult(interp, resultPtr);
done:
@@ -2293,7 +2293,7 @@ StringRangeCmd(
* 'end' refers to the last character, not one past it.
*/
- length = Tcl_GetCharLength(objv[1]) - 1;
+ length = TclGetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
@@ -2301,7 +2301,7 @@ StringRangeCmd(
}
if (last >= 0) {
- Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
+ Tcl_SetObjResult(interp, TclGetRange(objv[1], first, last));
}
return TCL_OK;
}
@@ -2394,7 +2394,7 @@ StringRplcCmd(
return TCL_ERROR;
}
- length = Tcl_GetCharLength(objv[1]);
+ length = TclGetCharLength(objv[1]);
end = length - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
@@ -2506,7 +2506,7 @@ StringStartCmd(
return TCL_ERROR;
}
- string = Tcl_GetUnicodeFromObj(objv[1], &length);
+ string = TclGetUnicodeFromObj_(objv[1], &length);
if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -2576,7 +2576,7 @@ StringEndCmd(
return TCL_ERROR;
}
- string = Tcl_GetUnicodeFromObj(objv[1], &length);
+ string = TclGetUnicodeFromObj_(objv[1], &length);
if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -2880,7 +2880,7 @@ StringLenCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1])));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclGetCharLength(objv[1])));
return TCL_OK;
}
@@ -2954,8 +2954,8 @@ StringLowerCmd(
}
string1 = TclGetStringFromObj(objv[1], &length1);
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, last - first + 1);
+ start = TclUtfAtIndex(string1, first);
+ end = TclUtfAtIndex(start, last - first + 1);
resultPtr = Tcl_NewStringObj(string1, end - string1);
string2 = TclGetString(resultPtr) + (start - string1);
@@ -3039,8 +3039,8 @@ StringUpperCmd(
}
string1 = TclGetStringFromObj(objv[1], &length1);
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, last - first + 1);
+ start = TclUtfAtIndex(string1, first);
+ end = TclUtfAtIndex(start, last - first + 1);
resultPtr = Tcl_NewStringObj(string1, end - string1);
string2 = TclGetString(resultPtr) + (start - string1);
@@ -3124,8 +3124,8 @@ StringTitleCmd(
}
string1 = TclGetStringFromObj(objv[1], &length1);
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, last - first + 1);
+ start = TclUtfAtIndex(string1, first);
+ end = TclUtfAtIndex(start, last - first + 1);
resultPtr = Tcl_NewStringObj(string1, end - string1);
string2 = TclGetString(resultPtr) + (start - string1);
@@ -3610,7 +3610,7 @@ TclNRSwitchObjCmd(
Tcl_Obj **listv;
blist = objv[0];
- if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[0], &objc, &listv) != TCL_OK) {
return TCL_ERROR;
}
@@ -3790,7 +3790,7 @@ TclNRSwitchObjCmd(
if (matchVarObj != NULL) {
Tcl_Obj *substringObj;
- substringObj = Tcl_GetRange(stringObj,
+ substringObj = TclGetRange(stringObj,
info.matches[j].start, info.matches[j].end-1);
/*
@@ -3995,7 +3995,7 @@ Tcl_ThrowObjCmd(
* The type must be a list of at least length 1.
*/
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -4783,7 +4783,7 @@ TclNRTryObjCmd(
return TCL_ERROR;
}
code = 1;
- if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
+ if (TclListObjLengthM(NULL, objv[i+1], &dummy) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad prefix '%s': must be a list",
Tcl_GetString(objv[i+1])));
@@ -4795,7 +4795,7 @@ TclNRTryObjCmd(
info[2] = objv[i+1];
commonHandler:
- if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[i+2], &dummy) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4945,12 +4945,12 @@ TryPostBody(
int found = 0;
Tcl_Obj **handlers, **info;
- TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
+ TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers);
for (i=0 ; i<numHandlers ; i++) {
Tcl_Obj *handlerBodyObj;
int numElems = 0;
- TclListObjGetElements(NULL, handlers[i], &numElems, &info);
+ TclListObjGetElementsM(NULL, handlers[i], &numElems, &info);
if (!found) {
Tcl_GetIntFromObj(NULL, info[1], &code);
if (code != result) {
@@ -4971,8 +4971,8 @@ TryPostBody(
TclNewLiteralStringObj(errorCodeName, "-errorcode");
Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
Tcl_DecrRefCount(errorCodeName);
- TclListObjGetElements(NULL, info[2], &len1, &bits1);
- if (TclListObjGetElements(NULL, errcode, &len2,
+ TclListObjGetElementsM(NULL, info[2], &len1, &bits1);
+ if (TclListObjGetElementsM(NULL, errcode, &len2,
&bits2) != TCL_OK) {
continue;
}
@@ -5012,7 +5012,7 @@ TryPostBody(
Tcl_ResetResult(interp);
result = TCL_ERROR;
- TclListObjLength(NULL, info[3], &numElems);
+ TclListObjLengthM(NULL, info[3], &numElems);
if (numElems> 0) {
Tcl_Obj *varName;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index a45c059..2d78ab6 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -301,7 +301,7 @@ TclCompileArraySetCmd(
TclNewObj(literalObj);
isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
isDataValid = (isDataLiteral
- && TclListObjLength(NULL, literalObj, &len) == TCL_OK);
+ && TclListObjLengthM(NULL, literalObj, &len) == TCL_OK);
isDataEven = (isDataValid && (len & 1) == 0);
/*
@@ -892,7 +892,7 @@ TclCompileConcatCmd(
const char *bytes;
int len;
- TclListObjGetElements(NULL, listObj, &len, &objs);
+ TclListObjGetElementsM(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
bytes = TclGetStringFromObj(objPtr, &len);
@@ -2750,7 +2750,7 @@ CompileEachloopCmd(
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
- TCL_OK != TclListObjLength(NULL, varListObj, &numVars) ||
+ TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) ||
numVars == 0) {
code = TCL_ERROR;
goto done;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index cd3bd37..29e48eb 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -890,7 +890,7 @@ TclCompileStringLenCmd(
*/
char buf[TCL_INTEGER_SPACE];
- int len = Tcl_GetCharLength(objPtr);
+ int len = TclGetCharLength(objPtr);
len = sprintf(buf, "%d", len);
PushLiteral(envPtr, buf, len);
@@ -938,7 +938,7 @@ TclCompileStringMapCmd(
if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
- } else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
+ } else if (TclListObjGetElementsM(NULL, mapObj, &len, &objv) != TCL_OK) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (len != 2) {
@@ -2731,7 +2731,7 @@ TclCompileThrowCmd(
CompileWord(envPtr, msgToken, interp, 2);
codeIsList = codeKnown && (TCL_OK ==
- TclListObjLength(interp, objPtr, &len));
+ TclListObjLengthM(interp, objPtr, &len));
codeIsValid = codeIsList && (len != 0);
if (codeIsValid) {
@@ -2864,7 +2864,7 @@ TclCompileTryCmd(
TclNewObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
- || TclListObjLength(NULL, tmpObj, &objc) != TCL_OK
+ || TclListObjLengthM(NULL, tmpObj, &objc) != TCL_OK
|| (objc == 0)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
@@ -2907,7 +2907,7 @@ TclCompileTryCmd(
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
- if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
+ if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK
|| (objc > 2)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
@@ -3121,7 +3121,7 @@ IssueTryClausesInstructions(
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
const char *p;
- TclListObjLength(NULL, matchClauses[i], &len);
+ TclListObjLengthM(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
@@ -3332,7 +3332,7 @@ IssueTryClausesFinallyInstructions(
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
- TclListObjLength(NULL, matchClauses[i], &len);
+ TclListObjLengthM(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 23d8711..06b4b05 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2223,8 +2223,8 @@ TclCompileExpr(
TclAdvanceLines(&envPtr->line, script,
script + TclParseAllWhiteSpace(script, numBytes));
- TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
- TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
+ TclListObjGetElementsM(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
+ TclListObjGetElementsM(NULL, funcList, &objc, &funcObjv);
CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
parsePtr->tokenPtr, envPtr, optimize);
} else {
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 7688f2c..adc7fb9 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -352,7 +352,6 @@ typedef short yytype_int16;
# elif defined size_t
# define YYSIZE_T size_t
# elif ! defined YYSIZE_T
-# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
# define YYSIZE_T size_t
# else
# define YYSIZE_T unsigned
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index a90b591..4c8e13b 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -12,6 +12,8 @@
#ifndef _TCLDECLS
#define _TCLDECLS
+#include <stddef.h> /* for size_t */
+
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -1065,8 +1067,8 @@ EXTERN int Tcl_UniCharIsWordChar(int ch);
EXTERN int Tcl_Char16Len(const unsigned short *uniStr);
/* 353 */
TCL_DEPRECATED("Use Tcl_UtfNcmp")
-int Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
- const Tcl_UniChar *uct,
+int Tcl_UniCharNcmp(const unsigned short *ucs,
+ const unsigned short *uct,
unsigned long numChars);
/* 354 */
EXTERN char * Tcl_Char16ToUtfDString(const unsigned short *uniStr,
@@ -1141,24 +1143,23 @@ EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp,
EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp,
Tcl_RegExpInfo *infoPtr);
/* 378 */
-EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
+EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const unsigned short *unicode,
int numChars);
/* 379 */
EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
- const Tcl_UniChar *unicode, int numChars);
+ const unsigned short *unicode, int numChars);
/* 380 */
EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
TCL_DEPRECATED("No longer in use, changed to macro")
-Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
+unsigned short * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
-TCL_DEPRECATED("Use Tcl_AppendStringsToObj")
-void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
- const Tcl_UniChar *unicode, int length);
+EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
+ const unsigned short *unicode, int length);
/* 385 */
EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
@@ -1255,13 +1256,13 @@ EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel);
EXTERN int Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCL_DEPRECATED("Use Tcl_UtfNcasecmp")
-int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
- const Tcl_UniChar *uct,
+int Tcl_UniCharNcasecmp(const unsigned short *ucs,
+ const unsigned short *uct,
unsigned long numChars);
/* 420 */
TCL_DEPRECATED("Use Tcl_StringCaseMatch")
-int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
- const Tcl_UniChar *uniPattern, int nocase);
+int Tcl_UniCharCaseMatch(const unsigned short *uniStr,
+ const unsigned short *uniPattern, int nocase);
/* 421 */
EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
const void *key);
@@ -1303,7 +1304,7 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
-EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
+EXTERN unsigned short * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
@@ -1929,7 +1930,7 @@ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp,
EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
/* 652 */
-EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr,
+EXTERN unsigned short * TclGetUnicodeFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
/* 653 */
EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr,
@@ -1962,6 +1963,16 @@ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async,
/* Slot 667 is reserved */
/* 668 */
EXTERN int Tcl_UniCharLen(const int *uniStr);
+/* 669 */
+EXTERN int TclNumUtfChars(const char *src, int length);
+/* 670 */
+EXTERN int TclGetCharLength(Tcl_Obj *objPtr);
+/* 671 */
+EXTERN const char * TclUtfAtIndex(const char *src, int index);
+/* 672 */
+EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, int first, int last);
+/* 673 */
+EXTERN int TclGetUniChar(Tcl_Obj *objPtr, int index);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2350,7 +2361,7 @@ typedef struct TclStubs {
int (*tcl_UniCharIsUpper) (int ch); /* 350 */
int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
int (*tcl_Char16Len) (const unsigned short *uniStr); /* 352 */
- TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
+ TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 353 */
char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
@@ -2375,13 +2386,13 @@ typedef struct TclStubs {
int (*tcl_UniCharIsPunct) (int ch); /* 375 */
int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
- Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
- void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
+ Tcl_Obj * (*tcl_NewUnicodeObj) (const unsigned short *unicode, int numChars); /* 378 */
+ void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const unsigned short *unicode, int numChars); /* 379 */
int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
- TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") unsigned short * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
- TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
+ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const unsigned short *unicode, int length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
@@ -2416,8 +2427,8 @@ typedef struct TclStubs {
void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
- TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
- TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
+ TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 419 */
+ TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const unsigned short *uniStr, const unsigned short *uniPattern, int nocase); /* 420 */
Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
@@ -2431,7 +2442,7 @@ typedef struct TclStubs {
char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
- Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
+ unsigned short * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
@@ -2649,7 +2660,7 @@ typedef struct TclStubs {
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
- Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
+ unsigned short * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
const char * (*tcl_UtfNext) (const char *src); /* 655 */
@@ -2666,6 +2677,11 @@ typedef struct TclStubs {
void (*reserved666)(void);
void (*reserved667)(void);
int (*tcl_UniCharLen) (const int *uniStr); /* 668 */
+ int (*tclNumUtfChars) (const char *src, int length); /* 669 */
+ int (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */
+ const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */
+ Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */
+ int (*tclGetUniChar) (Tcl_Obj *objPtr, int index); /* 673 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -4027,6 +4043,16 @@ extern const TclStubs *tclStubsPtr;
/* Slot 667 is reserved */
#define Tcl_UniCharLen \
(tclStubsPtr->tcl_UniCharLen) /* 668 */
+#define TclNumUtfChars \
+ (tclStubsPtr->tclNumUtfChars) /* 669 */
+#define TclGetCharLength \
+ (tclStubsPtr->tclGetCharLength) /* 670 */
+#define TclUtfAtIndex \
+ (tclStubsPtr->tclUtfAtIndex) /* 671 */
+#define TclGetRange \
+ (tclStubsPtr->tclGetRange) /* 672 */
+#define TclGetUniChar \
+ (tclStubsPtr->tclGetUniChar) /* 673 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index b93b141..019c69b 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -616,7 +616,7 @@ SetDictFromAny(
Tcl_Obj **objv;
/* Cannot fail, we already know the Tcl_ObjType is "list". */
- TclListObjGetElements(NULL, objPtr, &objc, &objv);
+ TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
if (objc & 1) {
goto missingValue;
}
@@ -2480,7 +2480,7 @@ DictForNRCmd(
* Parse arguments.
*/
- if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
@@ -2499,7 +2499,7 @@ DictForNRCmd(
TclStackFree(interp, searchPtr);
return TCL_OK;
}
- TclListObjGetElements(NULL, objv[1], &varc, &varv);
+ TclListObjGetElementsM(NULL, objv[1], &varc, &varv);
keyVarObj = varv[0];
valueVarObj = varv[1];
scriptObj = objv[3];
@@ -2674,7 +2674,7 @@ DictMapNRCmd(
* Parse arguments.
*/
- if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
@@ -2700,7 +2700,7 @@ DictMapNRCmd(
return TCL_OK;
}
TclNewObj(storagePtr->accumulatorObj);
- TclListObjGetElements(NULL, objv[1], &varc, &varv);
+ TclListObjGetElementsM(NULL, objv[1], &varc, &varv);
storagePtr->keyVarObj = varv[0];
storagePtr->valueVarObj = varv[1];
storagePtr->scriptObj = objv[3];
@@ -3113,7 +3113,7 @@ DictFilterCmd(
* copying from the "dict for" implementation has occurred!
*/
- if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[3], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
@@ -3374,7 +3374,7 @@ FinalizeDictUpdate(
* an instruction to remove the key.
*/
- TclListObjGetElements(NULL, argsObj, &objc, &objv);
+ TclListObjGetElementsM(NULL, argsObj, &objc, &objv);
for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
@@ -3498,7 +3498,7 @@ FinalizeDictWith(
state = Tcl_SaveInterpState(interp, result);
if (pathPtr != NULL) {
- TclListObjGetElements(NULL, pathPtr, &pathc, &pathv);
+ TclListObjGetElementsM(NULL, pathPtr, &pathc, &pathv);
} else {
pathc = 0;
pathv = NULL;
@@ -3704,7 +3704,7 @@ TclDictWithFinish(
* Now process our updates on the leaf dictionary.
*/
- TclListObjGetElements(NULL, keysPtr, &keyc, &keyv);
+ TclListObjGetElementsM(NULL, keysPtr, &keyc, &keyv);
for (i=0 ; i<keyc ; i++) {
valPtr = Tcl_ObjGetVar2(interp, keyv[i], NULL, 0);
if (valPtr == NULL) {
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 6f45be1..11c5fd3 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -764,7 +764,7 @@ TclGetInnerContext(
* Reset while keeping the list internalrep as much as possible.
*/
- TclListObjLength(interp, result, &len);
+ TclListObjLengthM(interp, result, &len);
Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
}
Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index fd0386c..0ce75b4 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -370,7 +370,7 @@ Tcl_SetEncodingSearchPath(
{
int dummy;
- if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) {
+ if (TCL_ERROR == TclListObjLengthM(NULL, searchPath, &dummy)) {
return TCL_ERROR;
}
TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
@@ -417,7 +417,7 @@ TclSetLibraryPath(
{
int dummy;
- if (TCL_ERROR == TclListObjLength(NULL, path, &dummy)) {
+ if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) {
return;
}
TclSetProcessGlobalValue(&libraryPath, path, NULL);
@@ -456,7 +456,7 @@ FillEncodingFileMap(void)
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
- TclListObjLength(NULL, searchPath, &numDirs);
+ TclListObjLengthM(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
Tcl_IncrRefCount(map);
@@ -480,7 +480,7 @@ FillEncodingFileMap(void)
Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc",
&readableFiles);
- TclListObjGetElements(NULL, matchFileList, &numFiles, &filev);
+ TclListObjGetElementsM(NULL, matchFileList, &numFiles, &filev);
for (j=0; j<numFiles; j++) {
Tcl_Obj *encodingName, *fileObj;
@@ -726,7 +726,7 @@ Tcl_GetDefaultEncodingDir(void)
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
- TclListObjLength(NULL, searchPath, &numDirs);
+ TclListObjLengthM(NULL, searchPath, &numDirs);
if (numDirs == 0) {
return NULL;
}
@@ -1338,7 +1338,7 @@ Tcl_ExternalToUtf(
if (*dstCharsPtr <= maxChars) {
break;
}
- dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
+ dstLen = TclUtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
*statePtr = savedState;
} while (1);
if (!noTerminate) {
@@ -1620,7 +1620,7 @@ OpenEncodingFileChannel(
Tcl_Channel chan = NULL;
int i, numDirs;
- TclListObjGetElements(NULL, searchPath, &numDirs, &dir);
+ TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir);
Tcl_IncrRefCount(nameObj);
Tcl_AppendToObj(fileNameObj, ".enc", -1);
Tcl_IncrRefCount(fileNameObj);
@@ -4011,7 +4011,7 @@ InitializeEncodingSearchPath(
Tcl_IncrRefCount(searchPathObj);
libPathObj = TclGetLibraryPath();
Tcl_IncrRefCount(libPathObj);
- TclListObjLength(NULL, libPathObj, &numDirs);
+ TclListObjLengthM(NULL, libPathObj, &numDirs);
for (i = 0; i < numDirs; i++) {
Tcl_Obj *directoryObj, *pathObj;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 9ee4982..6c82c6a 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -232,7 +232,7 @@ TclNamespaceEnsembleCmd(
cxtPtr = nsPtr;
continue;
case CRT_SUBCMDS:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
@@ -241,7 +241,7 @@ TclNamespaceEnsembleCmd(
subcmdObj = (len > 0 ? objv[1] : NULL);
continue;
case CRT_PARAM:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
@@ -271,7 +271,7 @@ TclNamespaceEnsembleCmd(
Tcl_Obj **listv;
const char *cmd;
- if (TclListObjGetElements(interp, listObj, &len,
+ if (TclListObjGetElementsM(interp, listObj, &len,
&listv) != TCL_OK) {
Tcl_DictObjDone(&search);
if (patchedDict) {
@@ -336,7 +336,7 @@ TclNamespaceEnsembleCmd(
}
continue;
case CRT_UNKNOWN:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
@@ -531,13 +531,13 @@ TclNamespaceEnsembleCmd(
}
switch ((enum EnsConfigOpts) index) {
case CONF_SUBCMDS:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
goto freeMapAndError;
}
subcmdObj = (len > 0 ? objv[1] : NULL);
continue;
case CONF_PARAM:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
goto freeMapAndError;
}
paramObj = (len > 0 ? objv[1] : NULL);
@@ -559,7 +559,7 @@ TclNamespaceEnsembleCmd(
continue;
}
do {
- if (TclListObjGetElements(interp, listObj, &len,
+ if (TclListObjGetElementsM(interp, listObj, &len,
&listv) != TCL_OK) {
Tcl_DictObjDone(&search);
if (patchedDict) {
@@ -621,7 +621,7 @@ TclNamespaceEnsembleCmd(
}
continue;
case CONF_UNKNOWN:
- if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) {
goto freeMapAndError;
}
unknownObj = (len > 0 ? objv[1] : NULL);
@@ -790,7 +790,7 @@ Tcl_SetEnsembleSubcommandList(
if (subcmdList != NULL) {
int length;
- if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) {
return TCL_ERROR;
}
if (length < 1) {
@@ -866,7 +866,7 @@ Tcl_SetEnsembleParameterList(
if (paramList == NULL) {
length = 0;
} else {
- if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, paramList, &length) != TCL_OK) {
return TCL_ERROR;
}
if (length < 1) {
@@ -1041,7 +1041,7 @@ Tcl_SetEnsembleUnknownHandler(
if (unknownList != NULL) {
int length;
- if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) {
return TCL_ERROR;
}
if (length < 1) {
@@ -1890,7 +1890,7 @@ NsEnsembleImplementationCmdNR(
Tcl_Obj **copyObjv;
int copyObjc, prefixObjc;
- TclListObjLength(NULL, prefixObj, &prefixObjc);
+ TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
@@ -1924,7 +1924,7 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
- TclListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+ TclListObjGetElementsM(NULL, copyPtr, &copyObjc, &copyObjv);
((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
@@ -2299,7 +2299,7 @@ EnsembleUnknownCallback(
for (i=1 ; i<objc ; i++) {
Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
}
- TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
+ TclListObjGetElementsM(NULL, unknownCmd, &paramc, &paramv);
Tcl_IncrRefCount(unknownCmd);
/*
@@ -2342,7 +2342,7 @@ EnsembleUnknownCallback(
* replacement.
*/
- if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) {
+ if (TclListObjLengthM(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) {
TclDecrRefCount(*prefixObjPtr);
Tcl_AddErrorInfo(interp, "\n while parsing result of "
"ensemble unknown subcommand handler");
@@ -2605,7 +2605,7 @@ BuildEnsembleConfig(
* Must determine the target for each.
*/
- TclListObjGetElements(NULL, subList, &subc, &subv);
+ TclListObjGetElementsM(NULL, subList, &subc, &subv);
if (subList == mapDict) {
/*
* Strange case where explicit list of subcommands is same value
@@ -3006,7 +3006,7 @@ TclCompileEnsemble(
const char *str;
Tcl_Obj *matchObj = NULL;
- if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) {
goto failed;
}
for (i=0 ; i<len ; i++) {
@@ -3126,7 +3126,7 @@ TclCompileEnsemble(
doneMapLookup:
Tcl_ListObjAppendElement(NULL, replaced, replacement);
- if (TclListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
goto failed;
} else if (len != 1) {
/*
@@ -3408,7 +3408,7 @@ CompileToInvokedCommand(
* difference. Hence the call to TclContinuationsEnterDerived...
*/
- TclListObjGetElements(NULL, replacements, &numWords, &words);
+ TclListObjGetElementsM(NULL, replacements, &numWords, &words);
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
i++, tokPtr = TokenAfter(tokPtr)) {
if (i > 0 && i < numWords+1) {
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 71ca814..c8fe92e 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -230,7 +230,7 @@ HandleBgErrors(
errPtr = assocPtr->firstBgPtr;
- TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+ TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv);
tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
tempObjv[prefixObjc] = errPtr->errorMsg;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0ec2404..027b8f3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2729,7 +2729,7 @@ TEBCresume(
objPtr = OBJ_AT_TOS;
TRACE(("\"%.30s\" => ", O2S(objPtr)));
- if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objPtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -3024,7 +3024,7 @@ TEBCresume(
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- TclListObjGetElements(NULL, objPtr, &objc, &objv);
+ TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
@@ -3435,7 +3435,7 @@ TEBCresume(
varPtr = varPtr->value.linkPtr;
}
TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -3461,7 +3461,7 @@ TEBCresume(
}
TRACE(("%u \"%.30s\" \"%.30s\" => ",
opnd, O2S(part2Ptr), O2S(valuePtr)));
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -3503,7 +3503,7 @@ TEBCresume(
lappendListDirect:
objResultPtr = varPtr->value.objPtr;
- if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) {
+ if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -3524,7 +3524,7 @@ TEBCresume(
lappendList:
opnd = -1;
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -3562,7 +3562,7 @@ TEBCresume(
if (!objResultPtr) {
valueToAssign = valuePtr;
- } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) {
+ } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
} else {
@@ -4846,7 +4846,7 @@ TEBCresume(
case INST_LIST_LENGTH:
TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
- if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -4863,7 +4863,7 @@ TEBCresume(
* Extract the desired list element.
*/
- if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
+ if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
&& !TclHasInternalRep(value2Ptr, &tclListType)) {
int code;
@@ -4908,7 +4908,7 @@ TEBCresume(
* in the process.
*/
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -5047,7 +5047,7 @@ TEBCresume(
* in the process.
*/
- if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
+ if (TclListObjLengthM(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -5112,7 +5112,7 @@ TEBCresume(
s1 = TclGetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
- if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -5244,7 +5244,7 @@ TEBCresume(
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
- length = Tcl_GetCharLength(valuePtr);
+ length = TclGetCharLength(valuePtr);
TclNewIntObj(objResultPtr, length);
TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
@@ -5310,7 +5310,7 @@ TEBCresume(
* Get char length to calulate what 'end' means.
*/
- length = Tcl_GetCharLength(valuePtr);
+ length = TclGetCharLength(valuePtr);
DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
@@ -5329,7 +5329,7 @@ TEBCresume(
valuePtr->bytes+index, 1);
} else {
char buf[4] = "";
- int ch = Tcl_GetUniChar(valuePtr, index);
+ int ch = TclGetUniChar(valuePtr, index);
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
@@ -5353,7 +5353,7 @@ TEBCresume(
case INST_STR_RANGE:
TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
- length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+ length = TclGetCharLength(OBJ_AT_DEPTH(2)) - 1;
DECACHE_STACK_INFO();
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
@@ -5373,7 +5373,7 @@ TEBCresume(
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
- objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
+ objResultPtr = TclGetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
}
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(1, 3, 1);
@@ -5382,7 +5382,7 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
- length = Tcl_GetCharLength(valuePtr);
+ length = TclGetCharLength(valuePtr);
TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
/* Every range of an empty value is an empty value */
@@ -5414,7 +5414,7 @@ TEBCresume(
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
- objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
+ objResultPtr = TclGetRange(valuePtr, fromIdx, toIdx);
}
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
@@ -5428,7 +5428,7 @@ TEBCresume(
case INST_STR_REPLACE:
value3Ptr = POP_OBJECT();
valuePtr = OBJ_AT_DEPTH(2);
- endIdx = Tcl_GetCharLength(valuePtr) - 1;
+ endIdx = TclGetCharLength(valuePtr) - 1;
TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
DECACHE_STACK_INFO();
@@ -5495,12 +5495,12 @@ TEBCresume(
objResultPtr = value3Ptr;
goto doneStringMap;
}
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
if (length == 0) {
objResultPtr = valuePtr;
goto doneStringMap;
}
- ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+ ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2);
if (length2 > length || length2 == 0) {
objResultPtr = valuePtr;
goto doneStringMap;
@@ -5512,9 +5512,9 @@ TEBCresume(
}
goto doneStringMap;
}
- ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
+ ustring3 = TclGetUnicodeFromObj_(value3Ptr, &length3);
- objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+ objResultPtr = TclNewUnicodeObj(ustring1, 0);
p = ustring1;
end = ustring1 + length;
for (; ustring1 < end; ustring1++) {
@@ -5524,14 +5524,14 @@ TEBCresume(
memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
== 0)) {
if (p != ustring1) {
- Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
+ TclAppendUnicodeToObj(objResultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
- Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
+ TclAppendUnicodeToObj(objResultPtr, ustring3, length3);
}
}
if (p != ustring1) {
@@ -5539,7 +5539,7 @@ TEBCresume(
* Put the rest of the unmapped chars onto result.
*/
- Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
@@ -5565,7 +5565,7 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
O2S(valuePtr)));
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
match = 1;
if (length > 0) {
int ch;
@@ -5592,12 +5592,12 @@ TEBCresume(
* both.
*/
- if (TclHasInternalRep(valuePtr, &tclStringType)
- || TclHasInternalRep(value2Ptr, &tclStringType)) {
+ if (TclHasInternalRep(valuePtr, &tclUniCharStringType)
+ || TclHasInternalRep(value2Ptr, &tclUniCharStringType)) {
Tcl_UniChar *ustring1, *ustring2;
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
- ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
+ ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
+ ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2);
match = TclUniCharMatch(ustring1, length, ustring2, length2,
nocase);
} else if (TclIsPureByteArray(valuePtr) && !nocase) {
@@ -6516,7 +6516,7 @@ TEBCresume(
listVarPtr = LOCAL(listTmpIndex);
listPtr = listVarPtr->value.objPtr;
- if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
@@ -6544,7 +6544,7 @@ TEBCresume(
listVarPtr = LOCAL(listTmpIndex);
listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
- TclListObjGetElements(interp, listPtr, &listLen, &elements);
+ TclListObjGetElementsM(interp, listPtr, &listLen, &elements);
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
@@ -6635,7 +6635,7 @@ TEBCresume(
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
- if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
@@ -6716,7 +6716,7 @@ TEBCresume(
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
- TclListObjGetElements(interp, listPtr, &listLen, &elements);
+ TclListObjGetElementsM(interp, listPtr, &listLen, &elements);
valIndex = (iterNum * numVars);
for (j = 0; j < numVars; j++) {
@@ -7328,7 +7328,7 @@ TEBCresume(
}
}
Tcl_IncrRefCount(dictPtr);
- if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+ if (TclListObjGetElementsM(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -7388,7 +7388,7 @@ TEBCresume(
NEXT_INST_F(9, 1, 0);
}
if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
- || TclListObjGetElements(interp, OBJ_AT_TOS, &length,
+ || TclListObjGetElementsM(interp, OBJ_AT_TOS, &length,
&keyPtrPtr) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -7447,7 +7447,7 @@ TEBCresume(
dictPtr = OBJ_UNDER_TOS;
listPtr = OBJ_AT_TOS;
TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
- if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -7465,7 +7465,7 @@ TEBCresume(
listPtr = OBJ_AT_TOS;
TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
- if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
TclDecrRefCount(keysPtr);
goto gotError;
@@ -7496,7 +7496,7 @@ TEBCresume(
varPtr = LOCAL(opnd);
TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
O2S(keysPtr)));
- if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 1a67155..6eb6644 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1006,7 +1006,7 @@ TclFileAttrsCmd(
* Use objStrings as a list object.
*/
- if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
+ if (TclListObjLengthM(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
attributeStringsAllocated = (const char **)
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 1603951..266e31e 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -517,7 +517,7 @@ TclpNativeSplitPath(
*/
if (lenPtr != NULL) {
- TclListObjLength(NULL, resultPtr, lenPtr);
+ TclListObjLengthM(NULL, resultPtr, lenPtr);
}
return resultPtr;
}
@@ -1332,7 +1332,7 @@ Tcl_GlobObjCmd(
return TCL_ERROR;
}
typePtr = objv[i+1];
- if (TclListObjLength(interp, typePtr, &length) != TCL_OK) {
+ if (TclListObjLengthM(interp, typePtr, &length) != TCL_OK) {
return TCL_ERROR;
}
i++;
@@ -1454,7 +1454,7 @@ Tcl_GlobObjCmd(
* platform.
*/
- TclListObjLength(interp, typePtr, &length);
+ TclListObjLengthM(interp, typePtr, &length);
if (length <= 0) {
goto skipTypes;
}
@@ -1524,7 +1524,7 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
- if ((TclListObjLength(NULL, look, &len) == TCL_OK)
+ if ((TclListObjLengthM(NULL, look, &len) == TCL_OK)
&& (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
@@ -1631,7 +1631,7 @@ Tcl_GlobObjCmd(
}
if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
- if (TclListObjLength(interp, Tcl_GetObjResult(interp),
+ if (TclListObjLengthM(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/*
* This should never happen. Maybe we should be more dramatic.
@@ -2014,7 +2014,7 @@ TclGlob(
}
}
- TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
+ TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
const char *oldStr = TclGetStringFromObj(objv[i], &len);
@@ -2343,13 +2343,13 @@ DoGlob(
int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
- result = TclListObjGetElements(interp, subdirsPtr,
+ result = TclListObjGetElementsM(interp, subdirsPtr,
&subdirc, &subdirv);
for (i=0; result==TCL_OK && i<subdirc; i++) {
Tcl_Obj *copy = NULL;
if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
- TclListObjLength(NULL, matchesObj, &repair);
+ TclListObjLengthM(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
Tcl_AppendObjToObj(subdirv[i], copy);
@@ -2362,7 +2362,7 @@ DoGlob(
Tcl_DecrRefCount(subdirv[i]);
subdirv[i] = copy;
- TclListObjLength(NULL, matchesObj, &end);
+ TclListObjLengthM(NULL, matchesObj, &end);
while (repair < end) {
const char *bytes;
int numBytes;
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 7538821..606d26b 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -273,8 +273,7 @@ CreateHashEntry(
{
Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
- unsigned int hash;
- int index;
+ TCL_HASH_TYPE hash, index;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
@@ -350,11 +349,11 @@ CreateHashEntry(
} else {
hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
hPtr->key.oneWordValue = (char *) key;
- hPtr->clientData = 0;
+ Tcl_SetHashValue(hPtr, NULL);
}
hPtr->tablePtr = tablePtr;
- hPtr->hash = INT2PTR(hash);
+ hPtr->hash = UINT2PTR(hash);
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
tablePtr->numEntries++;
@@ -396,7 +395,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
- int index;
+ TCL_HASH_TYPE index;
tablePtr = entryPtr->tablePtr;
@@ -413,7 +412,7 @@ Tcl_DeleteHashEntry(
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
+ index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash));
} else {
index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
}
@@ -614,7 +613,8 @@ Tcl_HashStats(
Tcl_HashTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
- int count[NUM_COUNTERS], overflow, i, j;
+ int i;
+ TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j;
double average, tmp;
Tcl_HashEntry *hPtr;
char *result, *p;
@@ -649,15 +649,15 @@ Tcl_HashStats(
*/
result = (char *)ckalloc((NUM_COUNTERS * 60) + 300);
- sprintf(result, "%d entries in table, %d buckets\n",
+ sprintf(result, "%u entries in table, %u buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
for (i = 0; i < NUM_COUNTERS; i++) {
- sprintf(p, "number of buckets with %d entries: %d\n",
+ sprintf(p, "number of buckets with %u entries: %u\n",
i, count[i]);
p += strlen(p);
}
- sprintf(p, "number of buckets with %d or more entries: %d\n",
+ sprintf(p, "number of buckets with %u or more entries: %u\n",
NUM_COUNTERS, overflow);
p += strlen(p);
sprintf(p, "average search distance for entry: %.1f", average);
@@ -683,17 +683,14 @@ Tcl_HashStats(
static Tcl_HashEntry *
AllocArrayEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
- void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
int *array = (int *) keyPtr;
int *iPtr1, *iPtr2;
Tcl_HashEntry *hPtr;
- int count;
- unsigned int size;
-
- count = tablePtr->keyType;
+ int count = tablePtr->keyType;
+ TCL_HASH_TYPE size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
- size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
if (size < sizeof(Tcl_HashEntry)) {
size = sizeof(Tcl_HashEntry);
}
@@ -703,7 +700,7 @@ AllocArrayEntry(
count > 0; count--, iPtr1++, iPtr2++) {
*iPtr2 = *iPtr1;
}
- hPtr->clientData = 0;
+ Tcl_SetHashValue(hPtr, NULL);
return hPtr;
}
@@ -727,11 +724,11 @@ AllocArrayEntry(
static int
CompareArrayKeys(
- void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- const int *iPtr1 = (const int *) keyPtr;
- const int *iPtr2 = (const int *) hPtr->key.words;
+ const int *iPtr1 = (const int *)keyPtr;
+ const int *iPtr2 = hPtr->key.words;
Tcl_HashTable *tablePtr = hPtr->tablePtr;
int count;
@@ -767,7 +764,7 @@ CompareArrayKeys(
static TCL_HASH_TYPE
HashArrayKey(
Tcl_HashTable *tablePtr, /* Hash table. */
- void *keyPtr) /* Key from which to compute hash value. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
const int *array = (const int *) keyPtr;
TCL_HASH_TYPE result;
@@ -799,7 +796,7 @@ HashArrayKey(
static Tcl_HashEntry *
AllocStringEntry(
TCL_UNUSED(Tcl_HashTable *),
- void *keyPtr) /* Key to store in the hash table entry. */
+ void *keyPtr) /* Key to store in the hash table entry. */
{
const char *string = (const char *) keyPtr;
Tcl_HashEntry *hPtr;
@@ -812,7 +809,7 @@ AllocStringEntry(
hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize);
memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
memcpy(hPtr->key.string, string, size);
- hPtr->clientData = 0;
+ Tcl_SetHashValue(hPtr, NULL);
return hPtr;
}
@@ -835,13 +832,10 @@ AllocStringEntry(
static int
CompareStringKeys(
- void *keyPtr, /* New key to compare. */
+ void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- const char *p1 = (const char *) keyPtr;
- const char *p2 = (const char *) hPtr->key.string;
-
- return !strcmp(p1, p2);
+ return !strcmp((char *)keyPtr, hPtr->key.string);
}
/*
@@ -864,7 +858,7 @@ CompareStringKeys(
static TCL_HASH_TYPE
HashStringKey(
TCL_UNUSED(Tcl_HashTable *),
- void *keyPtr) /* Key from which to compute hash value. */
+ void *keyPtr) /* Key from which to compute hash value. */
{
const char *string = (const char *)keyPtr;
TCL_HASH_TYPE result;
@@ -985,14 +979,14 @@ static void
RebuildTable(
Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
- int count, index, oldSize = tablePtr->numBuckets;
+ TCL_HASH_TYPE count, index, oldSize = tablePtr->numBuckets;
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
Tcl_HashEntry **oldChainPtr, **newChainPtr;
Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
/* Avoid outgrowing capability of the memory allocators */
- if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
+ if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) {
tablePtr->rebuildSize = INT_MAX;
return;
}
@@ -1015,7 +1009,7 @@ RebuildTable(
tablePtr->numBuckets *= 4;
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
- tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc(
+ tablePtr->buckets = (Tcl_HashEntry **)TclpSysAlloc(
tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0);
} else {
tablePtr->buckets =
@@ -1026,7 +1020,9 @@ RebuildTable(
*newChainPtr = NULL;
}
tablePtr->rebuildSize *= 4;
- tablePtr->downShift -= 2;
+ if (tablePtr->downShift > 1) {
+ tablePtr->downShift -= 2;
+ }
tablePtr->mask = (tablePtr->mask << 2) + 3;
/*
@@ -1038,7 +1034,7 @@ RebuildTable(
*oldChainPtr = hPtr->nextPtr;
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
+ index = RANDOM_INDEX(tablePtr, PTR2UINT(hPtr->hash));
} else {
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index b504369..585dc7b 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -3569,7 +3569,7 @@ Tcl_Close(
result = flushcode;
}
if ((result != 0) && (result != TCL_ERROR) && (interp != NULL)
- && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) {
+ && 0 == TclGetCharLength(Tcl_GetObjResult(interp))) {
Tcl_SetErrno(result);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
@@ -6388,7 +6388,7 @@ ReadChars(
* bytes demanded by the Tcl_ExternalToUtf() call!
*/
- dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1);
+ dstLimit = TclUtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1);
statePtr->flags = savedFlags;
statePtr->inputEncodingFlags = savedIEFlags;
statePtr->inputEncodingState = savedState;
@@ -11079,7 +11079,7 @@ FixLevelCode(
* information. Hence an error means that we've got serious breakage.
*/
- res = TclListObjGetElements(NULL, msg, &lc, &lv);
+ res = TclListObjGetElementsM(NULL, msg, &lc, &lv);
if (res != TCL_OK) {
Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
}
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 5740304..0e15280 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -274,7 +274,7 @@ TclChannelTransform(
return TCL_ERROR;
}
- if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) {
+ if (TCL_OK != TclListObjLengthM(interp, cmdObjPtr, &objc)) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("-command value is not a list", -1));
return TCL_ERROR;
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a9bab74..ec82fc5 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -616,7 +616,7 @@ TclChanCreateObjCmd(
* Compare open mode against optional r/w.
*/
- if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
@@ -1072,7 +1072,7 @@ UnmarshallErrorResult(
* information; if we panic here, something has gone badly wrong already.
*/
- if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
@@ -2020,7 +2020,7 @@ ReflectGetOption(
* result is a valid list. Nor that the list has an even number elements.
*/
- if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, resObj, &listc, &listv) != TCL_OK) {
goto error;
}
@@ -2166,7 +2166,7 @@ EncodeEventMask(
int evIndex; /* Id of event for an element of the eventspec
* list. */
- if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, obj, &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
@@ -3331,7 +3331,7 @@ ForwardProc(
int listc;
Tcl_Obj **listv;
- if (TclListObjGetElements(interp, resObj, &listc,
+ if (TclListObjGetElementsM(interp, resObj, &listc,
&listv) != TCL_OK) {
Tcl_DecrRefCount(resObj);
resObj = MarshallError(interp);
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 4aac514..3fe2585 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -607,7 +607,7 @@ TclChanPushObjCmd(
* through the mask. Compare open mode against optional r/w.
*/
- if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
@@ -843,7 +843,7 @@ UnmarshallErrorResult(
* information; if we panic here, something has gone badly wrong already.
*/
- if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
@@ -1796,7 +1796,7 @@ NewReflectedTransform(
/* ASSERT: cmdpfxObj is a Tcl List */
- TclListObjGetElements(interp, cmdpfxObj, &listc, &listv);
+ TclListObjGetElementsM(interp, cmdpfxObj, &listc, &listv);
/*
* See [==] as well.
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 988f5b3..cb9bbfc 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1065,7 +1065,7 @@ Tcl_FSMatchInDirectory(
* resultPtr and tmpResultPtr are guaranteed to be distinct.
*/
- ret = TclListObjGetElements(interp, tmpResultPtr,
+ ret = TclListObjGetElementsM(interp, tmpResultPtr,
&resLength, &elemsPtr);
for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
ret = Tcl_ListObjAppendElement(interp, resultPtr,
@@ -1113,10 +1113,10 @@ FsAddMountsToGlobResult(
return;
}
- if (TclListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
+ if (TclListObjLengthM(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
goto endOfMounts;
}
- if (TclListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
+ if (TclListObjLengthM(NULL, resultPtr, &gLength) != TCL_OK) {
goto endOfMounts;
}
for (i=0 ; i<mLength ; i++) {
@@ -2476,7 +2476,7 @@ TclFSFileAttrIndex(
int i, objc;
Tcl_Obj **objv;
- if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) {
TclDecrRefCount(listObj);
return TCL_ERROR;
}
@@ -3949,7 +3949,7 @@ Tcl_FSSplitPath(
}
if (lenPtr != NULL) {
- TclListObjLength(NULL, result, lenPtr);
+ TclListObjLengthM(NULL, result, lenPtr);
}
return result;
}
@@ -4072,7 +4072,7 @@ TclFSNonnativePathType(
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
- if (TclListObjLength(NULL, thisFsVolumes, &numVolumes)
+ if (TclListObjLengthM(NULL, thisFsVolumes, &numVolumes)
!= TCL_OK) {
/*
* This is VERY bad; the listVolumesProc didn't return a
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index e1526ad..3b74e02 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -190,7 +190,7 @@ GetIndexFromObjList(
* of the code there. This is a bit ineffiecient but simpler.
*/
- result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv);
+ result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv);
if (result != TCL_OK) {
return result;
}
@@ -618,7 +618,7 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
i++;
- result = TclListObjLength(interp, objv[i], &errorLength);
+ result = TclListObjLengthM(interp, objv[i], &errorLength);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -642,7 +642,7 @@ PrefixMatchObjCmd(
* error case regardless of level.
*/
- result = TclListObjLength(interp, tablePtr, &dummyLength);
+ result = TclListObjLengthM(interp, tablePtr, &dummyLength);
if (result != TCL_OK) {
return result;
}
@@ -707,7 +707,7 @@ PrefixAllObjCmd(
return TCL_ERROR;
}
- result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
@@ -764,7 +764,7 @@ PrefixLongestObjCmd(
return TCL_ERROR;
}
- result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
+ result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 61cc3b3..59106cd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -89,11 +89,6 @@
#else
#include <string.h>
#endif
-#if !defined(STDC_HEADERS) && !defined(__STDC__) && !defined(__C99__FUNC__) \
- && !defined(__cplusplus) && !defined(_MSC_VER) && !defined(__ICC)
-typedef int ptrdiff_t;
-#endif
-#include <stddef.h>
#include <locale.h>
/*
@@ -129,25 +124,16 @@ typedef int ptrdiff_t;
*/
#if !defined(INT2PTR)
-# if defined(HAVE_INTPTR_T) || defined(intptr_t)
-# define INT2PTR(p) ((void *)(intptr_t)(p))
-# else
-# define INT2PTR(p) ((void *)(p))
-# endif
+# define INT2PTR(p) ((void *)(ptrdiff_t)(p))
#endif
#if !defined(PTR2INT)
-# if defined(HAVE_INTPTR_T) || defined(intptr_t)
-# define PTR2INT(p) ((intptr_t)(p))
-# else
-# define PTR2INT(p) ((long)(p))
-# endif
+# define PTR2INT(p) ((ptrdiff_t)(p))
+#endif
+#if !defined(UINT2PTR)
+# define UINT2PTR(p) ((void *)(size_t)(p))
#endif
#if !defined(PTR2UINT)
-# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
-# define PTR2UINT(p) ((uintptr_t)(p))
-# else
-# define PTR2UINT(p) ((unsigned long)(p))
-# endif
+# define PTR2UINT(p) ((size_t)(p))
#endif
#if defined(_WIN32) && defined(_MSC_VER)
@@ -2478,12 +2464,12 @@ typedef struct List {
#define ListObjIsCanonical(listPtr) \
(((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag)
-#define TclListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
+#define TclListObjGetElementsM(interp, listPtr, objcPtr, objvPtr) \
(((listPtr)->typePtr == &tclListType) \
? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\
: Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)))
-#define TclListObjLength(interp, listPtr, lenPtr) \
+#define TclListObjLengthM(interp, listPtr, lenPtr) \
(((listPtr)->typePtr == &tclListType) \
? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
: Tcl_ListObjLength((interp), (listPtr), (lenPtr)))
@@ -2771,6 +2757,7 @@ MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
+MODULE_SCOPE const Tcl_ObjType tclUniCharStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
@@ -3322,6 +3309,44 @@ MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp);
+#if TCL_UTF_MAX > 3
+ MODULE_SCOPE int *TclGetUnicodeFromObj_(Tcl_Obj *, int *);
+ MODULE_SCOPE Tcl_Obj *TclNewUnicodeObj(const int *, int);
+ MODULE_SCOPE void TclAppendUnicodeToObj(Tcl_Obj *, const int *, int);
+ MODULE_SCOPE int TclUniCharNcasecmp(const int *, const int *, unsigned long);
+ MODULE_SCOPE int TclUniCharCaseMatch(const int *, const int *, int);
+ MODULE_SCOPE int TclUniCharNcmp(const int *, const int *, unsigned long);
+# undef Tcl_NumUtfChars
+# define Tcl_NumUtfChars TclNumUtfChars
+# undef Tcl_GetCharLength
+# define Tcl_GetCharLength TclGetCharLength
+# undef Tcl_UtfAtIndex
+# define Tcl_UtfAtIndex TclUtfAtIndex
+# undef Tcl_GetRange
+# define Tcl_GetRange TclGetRange
+# undef Tcl_GetUniChar
+# define Tcl_GetUniChar TclGetUniChar
+#else
+# define tclUniCharStringType tclStringType
+# define TclGetUnicodeFromObj_ Tcl_GetUnicodeFromObj
+# define TclNewUnicodeObj Tcl_NewUnicodeObj
+# define TclAppendUnicodeToObj Tcl_AppendUnicodeToObj
+# define TclUniCharNcasecmp Tcl_UniCharNcasecmp
+# define TclUniCharCaseMatch Tcl_UniCharCaseMatch
+# define TclUniCharNcmp Tcl_UniCharNcmp
+# undef TclNumUtfChars
+# define TclNumUtfChars Tcl_NumUtfChars
+# undef TclGetCharLength
+# define TclGetCharLength Tcl_GetCharLength
+# undef TclUtfAtIndex
+# define TclUtfAtIndex Tcl_UtfAtIndex
+# undef TclGetRange
+# define TclGetRange Tcl_GetRange
+# undef TclGetUniChar
+# define TclGetUniChar Tcl_GetUniChar
+#endif
+
+
/*
* Many parsing tasks need a common definition of whitespace.
* Use this routine and macro to achieve that and place
@@ -4725,8 +4750,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
: Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
- ((((unsigned char) *(str)) < 0x80) ? \
- ((*(chPtr) = (unsigned char) *(str)), 1) \
+ (((UCHAR(*(str))) < 0x80) ? \
+ ((*(chPtr) = UCHAR(*(str))), 1) \
: Tcl_UtfToChar16(str, chPtr))
#endif
@@ -4742,14 +4767,14 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
*----------------------------------------------------------------
*/
-#define TclNumUtfChars(numChars, bytes, numBytes) \
+#define TclNumUtfCharsM(numChars, bytes, numBytes) \
do { \
int _count, _i = (numBytes); \
unsigned char *_str = (unsigned char *) (bytes); \
while (_i && (*_str < 0xC0)) { _i--; _str++; } \
_count = (numBytes) - _i; \
if (_i) { \
- _count += Tcl_NumUtfChars((bytes) + _count, _i); \
+ _count += TclNumUtfChars((bytes) + _count, _i); \
} \
(numChars) = _count; \
} while (0);
@@ -4780,24 +4805,6 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------
- * Macro used by the Tcl core to compare Unicode strings. On big-endian
- * systems we can use the more efficient memcmp, but this would not be
- * lexically correct on little-endian systems. The ANSI C "prototype" for
- * this macro is:
- *
- * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs,
- * const Tcl_UniChar *ct, unsigned long n);
- *----------------------------------------------------------------
- */
-
-#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
-# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
-#else /* !WORDS_BIGENDIAN */
-# define TclUniCharNcmp Tcl_UniCharNcmp
-#endif /* WORDS_BIGENDIAN */
-
-/*
- *----------------------------------------------------------------
* Macro used by the Tcl core to increment a namespace's export epoch
* counter. The ANSI C "prototype" for this macro is:
*
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index e590775..b87bf7c 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -2315,7 +2315,7 @@ GetInterp(
Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */
InterpInfo *parentInfoPtr;
- if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
}
@@ -2371,7 +2371,7 @@ ChildBgerror(
if (objc) {
int length;
- if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
+ if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length)
|| (length < 1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cmdPrefix must be list of length >= 1", -1));
@@ -2418,7 +2418,7 @@ ChildCreate(
int isNew, objc;
Tcl_Obj **objv;
- if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
}
if (objc < 2) {
diff --git a/generic/tclLink.c b/generic/tclLink.c
index ee77654..384fcf3 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -947,7 +947,7 @@ LinkTraceProc(
*/
if (linkPtr->flags & LINK_ALLOC_LAST) {
- if (TclListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
+ if (TclListObjGetElementsM(NULL, (valueObj), &objc, &objv) == TCL_ERROR
|| objc != linkPtr->numElems) {
return (char *) "wrong dimension";
}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c66fd1e..597ab4a 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -470,7 +470,7 @@ TclListObjRange(
int listLen, i, newLen;
List *listRepPtr;
- TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
+ TclListObjGetElementsM(NULL, listPtr, &listLen, &elemPtrs);
if (fromIdx < 0) {
fromIdx = 0;
@@ -628,7 +628,7 @@ Tcl_ListObjAppendList(
* Pull the elements to append from elemListPtr.
*/
- if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
+ if (TCL_OK != TclListObjGetElementsM(interp, elemListPtr, &objc, &objv)) {
return TCL_ERROR;
}
@@ -1364,7 +1364,7 @@ TclLindexFlat(
break;
}
- TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+ TclListObjGetElementsM(NULL, sublistCopy, &listLen, &elemPtrs);
if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
&index) == TCL_OK) {
@@ -1464,7 +1464,7 @@ TclLsetList(
return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
}
- TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
+ TclListObjGetElementsM(NULL, indexArgPtr, &indexCount, &indices);
/*
* Let TclLsetFlat handle the actual lset'ting.
@@ -1581,7 +1581,7 @@ TclLsetFlat(
* Check for the possible error conditions...
*/
- if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
+ if (TclListObjGetElementsM(interp, subListPtr, &elemCount, &elemPtrs)
!= TCL_OK) {
/* ...the sublist we're indexing into isn't a list at all. */
result = TCL_ERROR;
@@ -1728,7 +1728,7 @@ TclLsetFlat(
*/
len = -1;
- TclListObjLength(NULL, subListPtr, &len);
+ TclListObjLengthM(NULL, subListPtr, &len);
if (valuePtr == NULL) {
Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
} else if (index == len) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 1782a34..6269bbe 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -4065,7 +4065,7 @@ NamespacePathCmd(
* There is a path given, so parse it into an array of namespace pointers.
*/
- if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
goto badNamespace;
}
if (nsObjc != 0) {
@@ -4433,7 +4433,7 @@ Tcl_SetNamespaceUnknownHandler(
*/
if (handlerPtr != NULL) {
- if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
+ if (TclListObjLengthM(interp, handlerPtr, &lstlen) != TCL_OK) {
/*
* Not a list.
*/
@@ -5010,7 +5010,7 @@ TclLogCommandInfo(
int len;
iPtr->resetErrorStack = 0;
- TclListObjLength(interp, iPtr->errorStack, &len);
+ TclListObjLengthM(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
@@ -5095,7 +5095,7 @@ TclErrorStackResetIf(
int len;
iPtr->resetErrorStack = 0;
- TclListObjLength(interp, iPtr->errorStack, &len);
+ TclListObjLengthM(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 4af23c2..42c6637 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -1065,7 +1065,7 @@ MagicDefinitionInvoke(
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
/* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
- TclListObjGetElements(NULL, objPtr, &dummy, &objs);
+ TclListObjGetElementsM(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
if (isRoot) {
@@ -2372,7 +2372,7 @@ ClassFilterSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
- } else if (TclListObjGetElements(interp, objv[0], &filterc,
+ } else if (TclListObjGetElementsM(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2456,7 +2456,7 @@ ClassMixinSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
- } else if (TclListObjGetElements(interp, objv[0], &mixinc,
+ } else if (TclListObjGetElementsM(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2566,7 +2566,7 @@ ClassSuperSet(
"may not modify the superclass of the root object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
- } else if (TclListObjGetElements(interp, objv[0], &superc,
+ } else if (TclListObjGetElementsM(interp, objv[0], &superc,
&superv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2736,7 +2736,7 @@ ClassVarsSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
- } else if (TclListObjGetElements(interp, objv[0], &varc,
+ } else if (TclListObjGetElementsM(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2828,7 +2828,7 @@ ObjFilterSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
- if (TclListObjGetElements(interp, objv[0], &filterc,
+ if (TclListObjGetElementsM(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2902,7 +2902,7 @@ ObjMixinSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
- if (TclListObjGetElements(interp, objv[0], &mixinc,
+ if (TclListObjGetElementsM(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2992,7 +2992,7 @@ ObjVarsSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
- if (TclListObjGetElements(interp, objv[0], &varc,
+ if (TclListObjGetElementsM(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 8a71c6f..ae1f3bd 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -339,7 +339,7 @@ TclOONewProcInstanceMethod(
ProcedureMethod *pmPtr;
Tcl_Method method;
- if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
@@ -397,7 +397,7 @@ TclOONewProcMethod(
TclNewObj(argsObj);
Tcl_IncrRefCount(argsObj);
procName = "<destructor>";
- } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
+ } else if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
} else {
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
@@ -1389,7 +1389,7 @@ TclOONewForwardInstanceMethod(
int prefixLen;
ForwardMethod *fmPtr;
- if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
@@ -1428,7 +1428,7 @@ TclOONewForwardMethod(
int prefixLen;
ForwardMethod *fmPtr;
- if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
@@ -1476,7 +1476,7 @@ InvokeForwardMethod(
* can ignore here.
*/
- TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
+ TclListObjGetElementsM(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
numPrefixes, prefixObjs, &len);
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 0ea5511..1a9925b 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -387,7 +387,9 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
+#if (TCL_UTF_MAX < 4) || !defined(TCL_NO_DEPRECATED)
Tcl_RegisterObjType(&tclStringType);
+#endif
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
@@ -875,7 +877,7 @@ Tcl_AppendAllObjTypes(
* Get the test for a valid list out of the way first.
*/
- if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
+ if (TclListObjLengthM(interp, objPtr, &numElems) != TCL_OK) {
return TCL_ERROR;
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index cb4d0ce..9524f26 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -812,12 +812,12 @@ Tcl_FSJoinPath(
int objc;
Tcl_Obj **objv;
- if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) {
+ if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
- TclListObjGetElements(NULL, listObj, &objc, &objv);
+ TclListObjGetElementsM(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
@@ -2313,7 +2313,7 @@ SetFsPathFromAny(
Tcl_Obj **objv;
Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
- TclListObjGetElements(NULL, parts, &objc, &objv);
+ TclListObjGetElementsM(NULL, parts, &objc, &objv);
/*
* Skip '~'. It's replaced by its expansion.
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index a5708da..fd45cc1 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1359,7 +1359,7 @@ TclNRPackageObjCmd(
objvListPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(objvListPtr);
Tcl_ListObjAppendElement(interp, objvListPtr, ov);
- TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
+ TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp,
TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
@@ -1386,7 +1386,7 @@ TclNRPackageObjCmd(
Tcl_ListObjAppendElement(interp, objvListPtr,
Tcl_DuplicateObj(newobjv[i]));
}
- TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
+ TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp,
TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL);
Tcl_NRAddCallback(interp,
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 45d1afd..8c65de3 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -484,7 +484,7 @@ TclCreateProc(
* in the Proc.
*/
- result = TclListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
+ result = TclListObjGetElementsM(interp , argsPtr ,&numArgs ,&argArray);
if (result != TCL_OK) {
goto procError;
}
@@ -514,7 +514,7 @@ TclCreateProc(
* Now divide the specifier up into name and default.
*/
- result = TclListObjGetElements(interp, argArray[i], &fieldCount,
+ result = TclListObjGetElementsM(interp, argArray[i], &fieldCount,
&fieldValues);
if (result != TCL_OK) {
goto procError;
@@ -529,7 +529,7 @@ TclCreateProc(
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
- if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
+ if ((fieldCount == 0) || (TclGetCharLength(fieldValues[0]) == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
@@ -920,7 +920,7 @@ TclNRUplevelObjCmd(
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
int status ,llength;
- status = TclListObjLength(interp, objv[1], &llength);
+ status = TclListObjLengthM(interp, objv[1], &llength);
if (status == TCL_OK && llength > 1) {
/* the first argument can't interpreted as a level. Avoid
* generating a string representation of the script. */
@@ -2446,7 +2446,7 @@ SetLambdaFromAny(
* length is not 2, then it cannot be converted to lambdaType.
*/
- result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
+ result = TclListObjGetElementsM(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
diff --git a/generic/tclProcess.c b/generic/tclProcess.c
index f418c2b..65c087c 100644
--- a/generic/tclProcess.c
+++ b/generic/tclProcess.c
@@ -533,7 +533,7 @@ ProcessStatusObjCmd(
* Only return statuses of provided processes.
*/
- result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+ result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
@@ -648,7 +648,7 @@ ProcessPurgeObjCmd(
* Purge only provided processes.
*/
- result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+ result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 8e588ac..ff7c72c 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -271,8 +271,8 @@ Tcl_RegExpRange(
} else {
string = regexpPtr->string;
}
- *startPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_so);
- *endPtr = Tcl_UtfAtIndex(string, regexpPtr->matches[index].rm_eo);
+ *startPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_so);
+ *endPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_eo);
}
}
@@ -482,7 +482,7 @@ Tcl_RegExpExecObj(
regexpPtr->string = NULL;
regexpPtr->objPtr = textObj;
- udata = Tcl_GetUnicodeFromObj(textObj, &length);
+ udata = TclGetUnicodeFromObj_(textObj, &length);
if (offset > length) {
offset = length;
diff --git a/generic/tclResult.c b/generic/tclResult.c
index acdcb70..7e108e9 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1328,12 +1328,12 @@ TclProcessReturn(
* if someone does [return -errorstack [info errorstack]]
*/
- if (TclListObjGetElements(interp, valuePtr, &valueObjc,
+ if (TclListObjGetElementsM(interp, valuePtr, &valueObjc,
&valueObjv) == TCL_ERROR) {
return TCL_ERROR;
}
iPtr->resetErrorStack = 0;
- TclListObjLength(interp, iPtr->errorStack, &len);
+ TclListObjLengthM(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
@@ -1490,7 +1490,7 @@ TclMergeReturnOptions(
if (valuePtr != NULL) {
int length;
- if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
+ if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorcode.
*/
@@ -1512,7 +1512,7 @@ TclMergeReturnOptions(
if (valuePtr != NULL) {
int length;
- if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
+ if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorstack.
*/
@@ -1682,7 +1682,7 @@ Tcl_SetReturnOptions(
Tcl_Obj **objv, *mergedOpts;
Tcl_IncrRefCount(options);
- if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
+ if (TCL_ERROR == TclListObjGetElementsM(interp, options, &objc, &objv)
|| (objc % 2)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected dict but got \"%s\"", TclGetString(options)));
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index a7986b0..cda840d 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -559,7 +559,7 @@ TclParseNumber(
if (TclHasInternalRep(objPtr, &tclListType)) {
int length;
/* A list can only be a (single) number if its length == 1 */
- TclListObjLength(NULL, objPtr, &length);
+ TclListObjLengthM(NULL, objPtr, &length);
if (length != 1) {
return TCL_ERROR;
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 114e8a6..2fbf854 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -69,6 +69,12 @@ static void SetUnicodeObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
static int UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
+#if (TCL_UTF_MAX) > 3 && !defined(TCL_NO_DEPRECATED)
+static void DupUTF16StringInternalRep(Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr);
+static int SetUTF16StringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void UpdateStringOfUTF16String(Tcl_Obj *objPtr);
+#endif
#define ISCONTINUATION(bytes) (\
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
@@ -80,6 +86,20 @@ static void UpdateStringOfString(Tcl_Obj *objPtr);
* functions that can be invoked by generic object code.
*/
+#if TCL_UTF_MAX < 4
+
+#define tclUniCharStringType tclStringType
+#define GET_UNICHAR_STRING GET_STRING
+#define UniCharString String
+#define UNICHAR_STRING_MAXCHARS STRING_MAXCHARS
+#define uniCharStringAlloc stringAlloc
+#define uniCharStringRealloc stringRealloc
+#define uniCharStringAttemptAlloc stringAttemptAlloc
+#define uniCharStringAttemptRealloc stringAttemptRealloc
+#define uniCharStringCheckLimits stringCheckLimits
+#define SET_UNICHAR_STRING SET_STRING
+#define UNICHAR_STRING_SIZE STRING_SIZE
+
const Tcl_ObjType tclStringType = {
"string", /* name */
FreeStringInternalRep, /* freeIntRepPro */
@@ -87,7 +107,149 @@ const Tcl_ObjType tclStringType = {
UpdateStringOfString, /* updateStringProc */
SetStringFromAny /* setFromAnyProc */
};
-
+
+#else
+
+#ifndef TCL_NO_DEPRECATED
+const Tcl_ObjType tclStringType = {
+ "string", /* name */
+ FreeStringInternalRep, /* freeIntRepPro */
+ DupUTF16StringInternalRep, /* dupIntRepProc */
+ UpdateStringOfUTF16String, /* updateStringProc */
+ SetUTF16StringFromAny /* setFromAnyProc */
+};
+#endif
+
+const Tcl_ObjType tclUniCharStringType = {
+ "utf32string", /* name */
+ FreeStringInternalRep, /* freeIntRepPro */
+ DupStringInternalRep, /* dupIntRepProc */
+ UpdateStringOfString, /* updateStringProc */
+ SetStringFromAny /* setFromAnyProc */
+};
+
+typedef struct {
+ int numChars; /* The number of chars in the string. -1 means
+ * this value has not been calculated. >= 0
+ * means that there is a valid Unicode rep, or
+ * that the number of UTF bytes == the number
+ * of chars. */
+ int allocated; /* The amount of space actually allocated for
+ * the UTF string (minus 1 byte for the
+ * termination char). */
+ int maxChars; /* Max number of chars that can fit in the
+ * space allocated for the unicode array. */
+ int hasUnicode; /* Boolean determining whether the string has
+ * a Unicode representation. */
+ Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
+ * of this field depends on the 'maxChars'
+ * field above. */
+} UniCharString;
+
+#define UNICHAR_STRING_MAXCHARS \
+ (int)(((size_t)UINT_MAX - offsetof(UniCharString, unicode))/sizeof(Tcl_UniChar) - 1)
+#define UNICHAR_STRING_SIZE(numChars) \
+ (offsetof(UniCharString, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
+#define uniCharStringCheckLimits(numChars) \
+ do { \
+ if ((numChars) < 0 || (numChars) > UNICHAR_STRING_MAXCHARS) { \
+ Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
+ UNICHAR_STRING_MAXCHARS); \
+ } \
+ } while (0)
+#define uniCharStringAttemptAlloc(numChars) \
+ (UniCharString *) attemptckalloc(UNICHAR_STRING_SIZE(numChars))
+#define uniCharStringAlloc(numChars) \
+ (UniCharString *) ckalloc(UNICHAR_STRING_SIZE(numChars))
+#define uniCharStringRealloc(ptr, numChars) \
+ (UniCharString *) ckrealloc((ptr), UNICHAR_STRING_SIZE(numChars))
+#define uniCharStringAttemptRealloc(ptr, numChars) \
+ (UniCharString *) attemptckrealloc((ptr), UNICHAR_STRING_SIZE(numChars))
+#define GET_UNICHAR_STRING(objPtr) \
+ ((UniCharString *) (objPtr)->internalRep.twoPtrValue.ptr1)
+#define SET_UNICHAR_STRING(objPtr, stringPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \
+ ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+
+
+#ifndef TCL_NO_DEPRECATED
+static void
+DupUTF16StringInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
+ * an internal rep of type "String". */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
+ * currently have an internal rep.*/
+{
+ String *srcStringPtr = GET_STRING(srcPtr);
+ size_t size = offsetof(String, unicode) + (((srcStringPtr->allocated) + 1U) * sizeof(unsigned short));
+ String *copyStringPtr = (String *)ckalloc(size);
+ memcpy(copyStringPtr, srcStringPtr, size);
+
+ SET_STRING(copyPtr, copyStringPtr);
+ copyPtr->typePtr = &tclStringType;
+}
+
+static int
+SetUTF16StringFromAny(
+ TCL_UNUSED(Tcl_Interp *),
+ Tcl_Obj *objPtr) /* The object to convert. */
+{
+ if (!TclHasInternalRep(objPtr, &tclStringType)) {
+ Tcl_DString ds;
+
+ /*
+ * Convert whatever we have into an untyped value. Just A String.
+ */
+
+ (void) TclGetString(objPtr);
+ TclFreeInternalRep(objPtr);
+
+ /*
+ * Create a basic String internalrep that just points to the UTF-8 string
+ * already in place at objPtr->bytes.
+ */
+
+ Tcl_DStringInit(&ds);
+ unsigned short *utf16string = Tcl_UtfToChar16DString(objPtr->bytes, objPtr->length, &ds);
+ int size = Tcl_DStringLength(&ds);
+ String *stringPtr = (String *)ckalloc((offsetof(String, unicode) + sizeof(unsigned short)) + size);
+
+ memcpy(stringPtr->unicode, utf16string, size);
+ Tcl_DStringFree(&ds);
+ size /= sizeof(unsigned short);
+ stringPtr->unicode[size] = 0;
+
+ stringPtr->numChars = size;
+ stringPtr->allocated = size;
+ stringPtr->maxChars = size;
+ stringPtr->hasUnicode = 1;
+ SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
+ }
+ return TCL_OK;
+}
+
+static void
+UpdateStringOfUTF16String(
+ Tcl_Obj *objPtr) /* Object with string rep to update. */
+{
+ Tcl_DString ds;
+ String *stringPtr = GET_STRING(objPtr);
+
+ Tcl_DStringInit(&ds);
+ const char *string = Tcl_Char16ToUtfDString(stringPtr->unicode, stringPtr->numChars, &ds);
+
+ char *bytes = (char *)ckalloc(Tcl_DStringLength(&ds) + 1U);
+ memcpy(bytes, string, Tcl_DStringLength(&ds));
+ bytes[Tcl_DStringLength(&ds)] = 0;
+ objPtr->bytes = bytes;
+ objPtr->length = Tcl_DStringLength(&ds);
+ Tcl_DStringFree(&ds);
+}
+#endif
+
+#endif
+
/*
* TCL STRING GROWTH ALGORITHM
*
@@ -138,7 +300,7 @@ GrowStringBuffer(
* flag || objPtr->bytes != NULL
*/
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
char *ptr = NULL;
int attempt;
@@ -185,10 +347,10 @@ GrowUnicodeBuffer(
* Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
- * needed < STRING_MAXCHARS
+ * needed < UNICHAR_STRING_MAXCHARS
*/
- String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
+ UniCharString *ptr = NULL, *stringPtr = GET_UNICHAR_STRING(objPtr);
int attempt;
if (stringPtr->maxChars > 0) {
@@ -196,9 +358,9 @@ GrowUnicodeBuffer(
* Subsequent appends - apply the growth algorithm.
*/
- if (needed <= STRING_MAXCHARS / 2) {
+ if (needed <= UNICHAR_STRING_MAXCHARS / 2) {
attempt = 2 * needed;
- ptr = stringAttemptRealloc(stringPtr, attempt);
+ ptr = uniCharStringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
/*
@@ -206,13 +368,13 @@ GrowUnicodeBuffer(
* overflow into invalid argument values for attempt.
*/
- unsigned int limit = STRING_MAXCHARS - needed;
+ unsigned int limit = UNICHAR_STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
+ TCL_MIN_UNICHAR_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
- ptr = stringAttemptRealloc(stringPtr, attempt);
+ ptr = uniCharStringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
@@ -221,11 +383,11 @@ GrowUnicodeBuffer(
*/
attempt = needed;
- ptr = stringRealloc(stringPtr, attempt);
+ ptr = uniCharStringRealloc(stringPtr, attempt);
}
stringPtr = ptr;
stringPtr->maxChars = attempt;
- SET_STRING(objPtr, stringPtr);
+ SET_UNICHAR_STRING(objPtr, stringPtr);
}
/*
@@ -374,7 +536,7 @@ Tcl_DbNewStringObj(
*/
Tcl_Obj *
-Tcl_NewUnicodeObj(
+TclNewUnicodeObj(
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
int numChars) /* Number of characters in the unicode
@@ -387,6 +549,35 @@ Tcl_NewUnicodeObj(
return objPtr;
}
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+Tcl_Obj *
+Tcl_NewUnicodeObj(
+ const unsigned short *unicode, /* The unicode string used to initialize the
+ * new object. */
+ int numChars) /* Number of characters in the unicode
+ * string. */
+{
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ TclInvalidateStringRep(objPtr);
+
+ String *stringPtr = (String *)ckalloc((offsetof(String, unicode)
+ + sizeof(unsigned short)) + numChars * sizeof(unsigned short));
+ memcpy(stringPtr->unicode, unicode, numChars);
+ stringPtr->unicode[numChars] = 0;
+
+ stringPtr->numChars = numChars;
+ stringPtr->allocated = numChars;
+ stringPtr->maxChars = numChars;
+ stringPtr->hasUnicode = 1;
+ SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
+
+ return objPtr;
+}
+#endif
+
/*
*----------------------------------------------------------------------
*
@@ -405,11 +596,11 @@ Tcl_NewUnicodeObj(
*/
int
-Tcl_GetCharLength(
+TclGetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
int numChars;
/*
@@ -444,7 +635,7 @@ Tcl_GetCharLength(
*/
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
numChars = stringPtr->numChars;
/*
@@ -452,12 +643,52 @@ Tcl_GetCharLength(
*/
if (numChars == -1) {
- TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
}
return numChars;
}
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_GetCharLength
+int
+Tcl_GetCharLength(
+ Tcl_Obj *objPtr) /* The String object to get the num chars
+ * of. */
+{
+ int numChars;
+
+ /*
+ * Quick, no-shimmer return for short string reps.
+ */
+
+ if ((objPtr->bytes) && (objPtr->length < 2)) {
+ /* 0 bytes -> 0 chars; 1 byte -> 1 char */
+ return objPtr->length;
+ }
+
+ /*
+ * Optimize the case where we're really dealing with a bytearray object;
+ * we don't need to convert to a string to perform the get-length operation.
+ *
+ * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
+ * machinery behind that test is using a proper bytearray ObjType. We
+ * could also compute length of an improper bytearray without shimmering
+ * but there's no value in that. We *want* to shimmer an improper bytearray
+ * because improper bytearrays have worthless internal reps.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+
+ (void) Tcl_GetByteArrayFromObj(objPtr, &numChars);
+ } else {
+ Tcl_GetString(objPtr);
+ numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
+ }
+ return numChars;
+}
+#endif
+
/*
*----------------------------------------------------------------------
*
@@ -485,7 +716,7 @@ TclCheckEmptyString(
}
if (TclListObjIsCanonical(objPtr)) {
- TclListObjLength(NULL, objPtr, &length);
+ TclListObjLengthM(NULL, objPtr, &length);
return length == 0;
}
@@ -518,6 +749,8 @@ TclCheckEmptyString(
*----------------------------------------------------------------------
*/
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_GetUniChar
int
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
@@ -549,22 +782,78 @@ Tcl_GetUniChar(
* OK, need to work with the object as a string.
*/
- SetStringFromAny(NULL, objPtr);
+ SetUTF16StringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
+ if (index >= stringPtr->numChars) {
+ return -1;
+ }
+ ch = stringPtr->unicode[index];
+ /* See: bug [11ae2be95dac9417] */
+ if ((ch & 0xF800) == 0xD800) {
+ if (ch & 0x400) {
+ if ((index > 0)
+ && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
+ ch = -1; /* low surrogate preceded by high surrogate */
+ }
+ } else if ((++index < stringPtr->numChars)
+ && ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
+ /* high surrogate followed by low surrogate */
+ ch = (((ch & 0x3FF) << 10) |
+ (stringPtr->unicode[index] & 0x3FF)) + 0x10000;
+ }
+ }
+ return ch;
+}
+#endif
+
+int
+TclGetUniChar(
+ Tcl_Obj *objPtr, /* The object to get the Unicode charater
+ * from. */
+ int index) /* Get the index'th Unicode character. */
+{
+ UniCharString *stringPtr;
+ int ch, length;
+
+ if (index < 0) {
+ return -1;
+ }
+
+ /*
+ * Optimize the case where we're really dealing with a bytearray object
+ * we don't need to convert to a string to perform the indexing operation.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+ if (index >= length) {
+ return -1;
+ }
+
+ return (int) bytes[index];
+ }
+
+ /*
+ * OK, need to work with the object as a string.
+ */
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
+
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
- TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (unsigned char) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
if (index >= stringPtr->numChars) {
@@ -612,12 +901,12 @@ Tcl_GetUniChar(
#undef Tcl_GetUnicodeFromObj
#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetUnicode
-Tcl_UniChar *
+unsigned short *
Tcl_GetUnicode(
Tcl_Obj *objPtr) /* The object to find the unicode string
* for. */
{
- return Tcl_GetUnicodeFromObj(objPtr, (int *)NULL);
+ return TclGetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */
@@ -641,21 +930,21 @@ Tcl_GetUnicode(
*/
Tcl_UniChar *
-Tcl_GetUnicodeFromObj(
+TclGetUnicodeFromObj_(
Tcl_Obj *objPtr, /* The object to find the unicode string
* for. */
int *lengthPtr) /* If non-NULL, the location where the string
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
if (lengthPtr != NULL) {
@@ -663,7 +952,29 @@ Tcl_GetUnicodeFromObj(
}
return stringPtr->unicode;
}
-Tcl_UniChar *
+
+#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
+unsigned short *
+Tcl_GetUnicodeFromObj(
+ Tcl_Obj *objPtr, /* The object to find the unicode string
+ * for. */
+ int *lengthPtr) /* If non-NULL, the location where the string
+ * rep's unichar length should be stored. If
+ * NULL, no length is stored. */
+{
+ String *stringPtr;
+
+ SetUTF16StringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = stringPtr->numChars;
+ }
+ return stringPtr->unicode;
+}
+#endif
+
+unsigned short *
TclGetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the unicode string
* for. */
@@ -676,17 +987,8 @@ TclGetUnicodeFromObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
- if (stringPtr->hasUnicode == 0) {
- FillUnicodeRep(objPtr);
- stringPtr = GET_STRING(objPtr);
- }
-
if (lengthPtr != NULL) {
-#if TCL_MAJOR_VERSION > 8
*lengthPtr = stringPtr->numChars;
-#else
- *lengthPtr = ((size_t)(unsigned)(stringPtr->numChars + 1)) - 1;
-#endif
}
return stringPtr->unicode;
}
@@ -709,6 +1011,8 @@ TclGetUnicodeFromObj(
*----------------------------------------------------------------------
*/
+#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_GetRange
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
@@ -716,7 +1020,53 @@ Tcl_GetRange(
int last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
- String *stringPtr;
+ int length;
+
+ if (first < 0) {
+ first = 0;
+ }
+
+ /*
+ * Optimize the case where we're really dealing with a bytearray object
+ * we don't need to convert to a string to perform the substring operation.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+
+ if (last < 0 || last >= length) {
+ last = length - 1;
+ }
+ if (last < first) {
+ TclNewObj(newObjPtr);
+ return newObjPtr;
+ }
+ return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
+ }
+
+ int numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
+
+ if (last >= numChars) {
+ last = numChars - 1;
+ }
+ if (last < first) {
+ TclNewObj(newObjPtr);
+ return newObjPtr;
+ }
+ const char *begin = Tcl_UtfAtIndex(objPtr->bytes, first);
+ const char *end = Tcl_UtfAtIndex(objPtr->bytes, last + 1);
+ return Tcl_NewStringObj(begin, end - begin);
+}
+#endif
+
+Tcl_Obj *
+TclGetRange(
+ Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
+ int first, /* First index of the range. */
+ int last) /* Last index of the range. */
+{
+ Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
+ UniCharString *stringPtr;
int length;
if (first < 0) {
@@ -746,7 +1096,7 @@ Tcl_GetRange(
*/
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
@@ -754,7 +1104,7 @@ Tcl_GetRange(
*/
if (stringPtr->numChars == -1) {
- TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
+ TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last < 0 || last >= stringPtr->numChars) {
@@ -771,12 +1121,12 @@ Tcl_GetRange(
*/
SetStringFromAny(NULL, newObjPtr);
- stringPtr = GET_STRING(newObjPtr);
+ stringPtr = GET_UNICHAR_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
return newObjPtr;
}
FillUnicodeRep(objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
@@ -797,7 +1147,7 @@ Tcl_GetRange(
++last;
}
#endif
- return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
+ return TclNewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
/*
@@ -883,7 +1233,7 @@ Tcl_SetObjLength(
* representation of object, not including
* terminating null byte. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
if (length < 0) {
/*
@@ -903,7 +1253,7 @@ Tcl_SetObjLength(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
@@ -935,10 +1285,10 @@ Tcl_SetObjLength(
* Changing length of pure unicode string.
*/
- stringCheckLimits(length);
+ uniCharStringCheckLimits(length);
if (length > stringPtr->maxChars) {
- stringPtr = stringRealloc(stringPtr, length);
- SET_STRING(objPtr, stringPtr);
+ stringPtr = uniCharStringRealloc(stringPtr, length);
+ SET_UNICHAR_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
@@ -988,7 +1338,7 @@ Tcl_AttemptSetObjLength(
* representation of object, not including
* terminating null byte. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
if (length < 0) {
/*
@@ -1006,7 +1356,7 @@ Tcl_AttemptSetObjLength(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
@@ -1045,15 +1395,15 @@ Tcl_AttemptSetObjLength(
* Changing length of pure unicode string.
*/
- if (length > STRING_MAXCHARS) {
+ if (length > UNICHAR_STRING_MAXCHARS) {
return 0;
}
if (length > stringPtr->maxChars) {
- stringPtr = stringAttemptRealloc(stringPtr, length);
+ stringPtr = uniCharStringAttemptRealloc(stringPtr, length);
if (stringPtr == NULL) {
return 0;
}
- SET_STRING(objPtr, stringPtr);
+ SET_UNICHAR_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
@@ -1089,20 +1439,47 @@ Tcl_AttemptSetObjLength(
*---------------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED)
void
Tcl_SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
- const Tcl_UniChar *unicode, /* The unicode string used to initialize the
+ const unsigned short *unicode, /* The unicode string used to initialize the
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
- if (Tcl_IsShared(objPtr)) {
- Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
+ String *stringPtr;
+
+ if (numChars < 0) {
+ numChars = 0;
+
+ if (unicode) {
+ while (numChars >= 0 && unicode[numChars] != 0) {
+ numChars++;
+ }
+ }
+ stringCheckLimits(numChars);
}
- TclFreeInternalRep(objPtr);
- SetUnicodeObj(objPtr, unicode, numChars);
+
+ /*
+ * Allocate enough space for the String structure + Unicode string.
+ */
+
+ stringCheckLimits(numChars);
+ stringPtr = stringAlloc(numChars);
+ SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
+
+ stringPtr->maxChars = numChars;
+ memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned char));
+ stringPtr->unicode[numChars] = 0;
+ stringPtr->numChars = numChars;
+ stringPtr->hasUnicode = 1;
+
+ TclInvalidateStringRep(objPtr);
+ stringPtr->allocated = numChars;
}
+#endif
static int
UnicodeLength(
@@ -1115,7 +1492,7 @@ UnicodeLength(
numChars++;
}
}
- stringCheckLimits(numChars);
+ uniCharStringCheckLimits(numChars);
return numChars;
}
@@ -1127,7 +1504,7 @@ SetUnicodeObj(
int numChars) /* Number of characters in the unicode
* string. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
if (numChars < 0) {
numChars = UnicodeLength(unicode);
@@ -1137,10 +1514,10 @@ SetUnicodeObj(
* Allocate enough space for the String structure + Unicode string.
*/
- stringCheckLimits(numChars);
- stringPtr = stringAlloc(numChars);
- SET_STRING(objPtr, stringPtr);
- objPtr->typePtr = &tclStringType;
+ uniCharStringCheckLimits(numChars);
+ stringPtr = uniCharStringAlloc(numChars);
+ SET_UNICHAR_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclUniCharStringType;
stringPtr->maxChars = numChars;
memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
@@ -1184,7 +1561,7 @@ Tcl_AppendLimitedToObj(
* object to indicate not all available bytes
* at "bytes" were appended. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
int toCopy = 0;
int eLen = 0;
@@ -1223,13 +1600,13 @@ Tcl_AppendLimitedToObj(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867] */
if (bytes && ISCONTINUATION(bytes)) {
- Tcl_GetUnicode(objPtr);
- stringPtr = GET_STRING(objPtr);
+ TclGetUnicodeFromObj_(objPtr, NULL);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
@@ -1241,7 +1618,7 @@ Tcl_AppendLimitedToObj(
return;
}
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
} else {
@@ -1296,13 +1673,13 @@ Tcl_AppendToObj(
*/
void
-Tcl_AppendUnicodeToObj(
+TclAppendUnicodeToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
int length) /* Number of chars in "unicode". */
{
- String *stringPtr;
+ UniCharString *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
@@ -1313,7 +1690,7 @@ Tcl_AppendUnicodeToObj(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then append the "unicode" to the
@@ -1328,6 +1705,34 @@ Tcl_AppendUnicodeToObj(
}
}
+#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
+void
+Tcl_AppendUnicodeToObj(
+ Tcl_Obj *objPtr, /* Points to the object to append to. */
+ const unsigned short *unicode, /* The unicode string to append to the
+ * object. */
+ int length) /* Number of chars in "unicode". */
+{
+ String *stringPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
+ }
+
+ if (length == 0) {
+ return;
+ }
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+ stringPtr = stringAttemptRealloc(stringPtr, stringPtr->numChars + length);
+ memcpy(&stringPtr->unicode[stringPtr->numChars], unicode, length);
+ stringPtr->maxChars = stringPtr->allocated = stringPtr->numChars += length;
+ stringPtr->unicode[stringPtr->numChars] = 0;
+ SET_STRING(objPtr, stringPtr);
+}
+#endif
+
/*
*----------------------------------------------------------------------
*
@@ -1353,7 +1758,7 @@ Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
int length, numChars, appendNumChars = -1;
const char *bytes;
@@ -1426,14 +1831,14 @@ Tcl_AppendObjToObj(
*/
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867]
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
- Tcl_GetUnicode(objPtr);
- stringPtr = GET_STRING(objPtr);
+ TclGetUnicodeFromObj_(objPtr, NULL);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
@@ -1445,9 +1850,9 @@ Tcl_AppendObjToObj(
* If appendObjPtr is not of the "String" type, don't convert it.
*/
- if (TclHasInternalRep(appendObjPtr, &tclStringType)) {
+ if (TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) {
Tcl_UniChar *unicode =
- Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
+ TclGetUnicodeFromObj_(appendObjPtr, &numChars);
AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
} else {
@@ -1466,8 +1871,8 @@ Tcl_AppendObjToObj(
bytes = TclGetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars;
- if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
- String *appendStringPtr = GET_STRING(appendObjPtr);
+ if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) {
+ UniCharString *appendStringPtr = GET_UNICHAR_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
@@ -1502,7 +1907,7 @@ AppendUnicodeToUnicodeRep(
const Tcl_UniChar *unicode, /* String to append. */
int appendNumChars) /* Number of chars of "unicode" to append. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
int numChars;
if (appendNumChars < 0) {
@@ -1513,7 +1918,7 @@ AppendUnicodeToUnicodeRep(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
/*
* If not enough space has been allocated for the unicode rep, reallocate
@@ -1524,7 +1929,7 @@ AppendUnicodeToUnicodeRep(
*/
numChars = stringPtr->numChars + appendNumChars;
- stringCheckLimits(numChars);
+ uniCharStringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
int offset = -1;
@@ -1541,7 +1946,7 @@ AppendUnicodeToUnicodeRep(
}
GrowUnicodeBuffer(objPtr, numChars);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
/*
* Relocate unicode if needed; see above.
@@ -1591,7 +1996,7 @@ AppendUnicodeToUtfRep(
const Tcl_UniChar *unicode, /* String to convert to UTF. */
int numChars) /* Number of chars of "unicode" to convert. */
{
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
@@ -1624,7 +2029,7 @@ AppendUtfToUnicodeRep(
const char *bytes, /* String to convert to Unicode. */
int numBytes) /* Number of bytes of "bytes" to convert. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
if (numBytes == 0) {
return;
@@ -1632,7 +2037,7 @@ AppendUtfToUnicodeRep(
ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
TclInvalidateStringRep(objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
stringPtr->allocated = 0;
}
@@ -1660,7 +2065,7 @@ AppendUtfToUtfRep(
const char *bytes, /* String to append. */
int numBytes) /* Number of bytes of "bytes" to append. */
{
- String *stringPtr;
+ UniCharString *stringPtr;
int newLength, oldLength;
if (numBytes == 0) {
@@ -1681,7 +2086,7 @@ AppendUtfToUtfRep(
}
newLength = numBytes + oldLength;
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (newLength > stringPtr->allocated) {
int offset = -1;
@@ -2085,12 +2490,12 @@ Tcl_AppendFormatToObj(
goto errorMsg;
case 's':
if (gotPrecision) {
- numChars = Tcl_GetCharLength(segment);
+ numChars = TclGetCharLength(segment);
if (precision < numChars) {
if (precision < 1) {
TclNewObj(segment);
} else {
- segment = Tcl_GetRange(segment, 0, precision - 1);
+ segment = TclGetRange(segment, 0, precision - 1);
}
numChars = precision;
Tcl_IncrRefCount(segment);
@@ -2270,7 +2675,7 @@ Tcl_AppendFormatToObj(
gotZero = 0;
}
if (gotZero) {
- length += Tcl_GetCharLength(segment);
+ length += TclGetCharLength(segment);
if (length < width) {
segmentLimit -= width - length;
}
@@ -2401,7 +2806,7 @@ Tcl_AppendFormatToObj(
gotZero = 0;
}
if (gotZero) {
- length += Tcl_GetCharLength(segment);
+ length += TclGetCharLength(segment);
if (length < width) {
segmentLimit -= width - length;
}
@@ -2512,7 +2917,7 @@ Tcl_AppendFormatToObj(
}
if (width>0 && numChars<0) {
- numChars = Tcl_GetCharLength(segment);
+ numChars = TclGetCharLength(segment);
}
if (!gotMinus && width>0) {
if (numChars < width) {
@@ -2785,7 +3190,7 @@ AppendPrintfToObjVA(
}
} while (seekingConversion);
}
- TclListObjGetElements(NULL, list, &objc, &objv);
+ TclListObjGetElementsM(NULL, list, &objc, &objv);
code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
if (code != TCL_OK) {
Tcl_AppendPrintfToObj(objPtr,
@@ -2873,13 +3278,13 @@ TclGetStringStorage(
Tcl_Obj *objPtr,
unsigned int *sizePtr)
{
- String *stringPtr;
+ UniCharString *stringPtr;
- if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
+ if (!TclHasInternalRep(objPtr, &tclUniCharStringType) || objPtr->bytes == NULL) {
return TclGetStringFromObj(objPtr, (int *)sizePtr);
}
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
*sizePtr = stringPtr->allocated;
return objPtr->bytes;
}
@@ -2923,8 +3328,8 @@ TclStringRepeat(
*/
if (!binary) {
- if (TclHasInternalRep(objPtr, &tclStringType)) {
- String *stringPtr = GET_STRING(objPtr);
+ if (TclHasInternalRep(objPtr, &tclUniCharStringType)) {
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
if (stringPtr->hasUnicode) {
unichar = 1;
}
@@ -2936,7 +3341,7 @@ TclStringRepeat(
Tcl_GetByteArrayFromObj(objPtr, &length);
} else if (unichar) {
/* Result will be pure Tcl_UniChar array. Pre-size it. */
- Tcl_GetUnicodeFromObj(objPtr, &length);
+ TclGetUnicodeFromObj_(objPtr, &length);
} else {
/* Result will be concat of string reps. Pre-size it. */
Tcl_GetStringFromObj(objPtr, &length);
@@ -2976,7 +3381,7 @@ TclStringRepeat(
*/
if (!inPlace || Tcl_IsShared(objPtr)) {
- objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
+ objResultPtr = TclNewUnicodeObj(TclGetUnicodeFromObj_(objPtr, NULL), length);
} else {
TclInvalidateStringRep(objPtr);
objResultPtr = objPtr;
@@ -2987,7 +3392,7 @@ TclStringRepeat(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %"
TCL_Z_MODIFIER "u bytes",
- STRING_SIZE(count*length)));
+ UNICHAR_STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
@@ -2997,7 +3402,7 @@ TclStringRepeat(
Tcl_AppendObjToObj(objResultPtr, objResultPtr);
done *= 2;
}
- Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
+ TclAppendUnicodeToObj(objResultPtr, TclGetUnicodeFromObj_(objResultPtr, NULL),
(count - done) * length);
} else {
/*
@@ -3094,7 +3499,7 @@ TclStringCat(
binary = 0;
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
forceUniChar = 1;
- } else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
+ } else if ((objPtr->typePtr) && (objPtr->typePtr != &tclUniCharStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
@@ -3102,7 +3507,7 @@ TclStringCat(
} else {
/* assert (objPtr->typePtr != NULL) -- stork! */
binary = 0;
- if (TclHasInternalRep(objPtr, &tclStringType)) {
+ if (TclHasInternalRep(objPtr, &tclUniCharStringType)) {
/* Have a pure Unicode value; ask to preserve it */
requestUniChar = 1;
} else {
@@ -3156,7 +3561,7 @@ TclStringCat(
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int numChars;
- Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
+ TclGetUnicodeFromObj_(objPtr, &numChars); /* PANIC? */
if (numChars) {
last = objc - oc;
if (length == 0) {
@@ -3306,43 +3711,43 @@ TclStringCat(
objResultPtr = *objv++; objc--;
/* Ugly interface! Force resize of the unicode array. */
- Tcl_GetUnicodeFromObj(objResultPtr, &start);
+ TclGetUnicodeFromObj_(objResultPtr, &start);
Tcl_InvalidateStringRep(objResultPtr);
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
TCL_Z_MODIFIER "u bytes",
- STRING_SIZE(length)));
+ UNICHAR_STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
}
- dst = Tcl_GetUnicode(objResultPtr) + start;
+ dst = TclGetUnicodeFromObj_(objResultPtr, NULL) + start;
} else {
Tcl_UniChar ch = 0;
/* Ugly interface! No scheme to init array size. */
- objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */
+ objResultPtr = TclNewUnicodeObj(&ch, 0); /* PANIC? */
if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
Tcl_DecrRefCount(objResultPtr);
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
TCL_Z_MODIFIER "u bytes",
- STRING_SIZE(length)));
+ UNICHAR_STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return NULL;
}
- dst = Tcl_GetUnicode(objResultPtr);
+ dst = TclGetUnicodeFromObj_(objResultPtr, NULL);
}
while (objc--) {
Tcl_Obj *objPtr = *objv++;
if ((objPtr->bytes == NULL) || (objPtr->length)) {
int more;
- Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
+ Tcl_UniChar *src = TclGetUnicodeFromObj_(objPtr, &more);
memcpy(dst, src, more * sizeof(Tcl_UniChar));
dst += more;
}
@@ -3455,8 +3860,8 @@ TclStringCmp(
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
- } else if (TclHasInternalRep(value1Ptr, &tclStringType)
- && TclHasInternalRep(value2Ptr, &tclStringType)) {
+ } else if (TclHasInternalRep(value1Ptr, &tclUniCharStringType)
+ && TclHasInternalRep(value2Ptr, &tclUniCharStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -3465,12 +3870,12 @@ TclStringCmp(
*/
if (nocase) {
- s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
- s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
- memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcasecmp;
+ s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, &s1len);
+ s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, &s2len);
+ memCmpFn = (memCmpFn_t)(void *)TclUniCharNcasecmp;
} else {
- s1len = Tcl_GetCharLength(value1Ptr);
- s2len = Tcl_GetCharLength(value2Ptr);
+ s1len = TclGetCharLength(value1Ptr);
+ s2len = TclGetCharLength(value2Ptr);
if ((s1len == value1Ptr->length)
&& (value1Ptr->bytes != NULL)
&& (s2len == value2Ptr->length)
@@ -3479,8 +3884,8 @@ TclStringCmp(
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
} else {
- s1 = (char *) Tcl_GetUnicode(value1Ptr);
- s2 = (char *) Tcl_GetUnicode(value2Ptr);
+ s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, NULL);
+ s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, NULL);
if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
1
@@ -3492,7 +3897,7 @@ TclStringCmp(
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
} else {
- memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcmp;
+ memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
}
}
}
@@ -3615,7 +4020,7 @@ TclStringFirst(
Tcl_Obj *haystack,
int start)
{
- int lh, ln = Tcl_GetCharLength(needle);
+ int lh, ln = TclGetCharLength(needle);
Tcl_Obj *result;
int value = -1;
Tcl_UniChar *checkStr, *endStr, *uh, *un;
@@ -3678,8 +4083,8 @@ TclStringFirst(
* do only the well-defined Tcl_UniChar array search.
*/
- un = Tcl_GetUnicodeFromObj(needle, &ln);
- uh = Tcl_GetUnicodeFromObj(haystack, &lh);
+ un = TclGetUnicodeFromObj_(needle, &ln);
+ uh = TclGetUnicodeFromObj_(haystack, &lh);
if ((lh < ln) || (start > lh - ln)) {
/* Don't start the loop if there cannot be a valid answer */
goto firstEnd;
@@ -3722,7 +4127,7 @@ TclStringLast(
Tcl_Obj *haystack,
int last)
{
- int lh, ln = Tcl_GetCharLength(needle);
+ int lh, ln = TclGetCharLength(needle);
Tcl_Obj *result;
int value = -1;
Tcl_UniChar *checkStr, *uh, *un;
@@ -3761,8 +4166,8 @@ TclStringLast(
goto lastEnd;
}
- uh = Tcl_GetUnicodeFromObj(haystack, &lh);
- un = Tcl_GetUnicodeFromObj(needle, &ln);
+ uh = TclGetUnicodeFromObj_(haystack, &lh);
+ un = TclGetUnicodeFromObj_(needle, &ln);
if (last >= lh) {
last = lh - 1;
@@ -3832,7 +4237,7 @@ TclStringReverse(
Tcl_Obj *objPtr,
int flags)
{
- String *stringPtr;
+ UniCharString *stringPtr;
Tcl_UniChar ch = 0;
int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
@@ -3851,11 +4256,11 @@ TclStringReverse(
}
SetStringFromAny(NULL, objPtr);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
if (stringPtr->hasUnicode) {
- Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
- stringPtr = GET_STRING(objPtr);
+ Tcl_UniChar *from = TclGetUnicodeFromObj_(objPtr, NULL);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
Tcl_UniChar *to;
@@ -3865,10 +4270,10 @@ TclStringReverse(
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
- objPtr = Tcl_NewUnicodeObj(&ch, 1);
+ objPtr = TclNewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars);
- to = Tcl_GetUnicode(objPtr);
- stringPtr = GET_STRING(objPtr);
+ to = TclGetUnicodeFromObj_(objPtr, NULL);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
while (--src >= from) {
#if TCL_UTF_MAX < 4
ch = *src;
@@ -4097,16 +4502,16 @@ TclStringReplace(
/* The traditional implementation... */
{
int numChars;
- Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);
+ Tcl_UniChar *ustring = TclGetUnicodeFromObj_(objPtr, &numChars);
/* TODO: Is there an in-place option worth pursuing here? */
- result = Tcl_NewUnicodeObj(ustring, first);
+ result = TclNewUnicodeObj(ustring, first);
if (insertPtr) {
Tcl_AppendObjToObj(result, insertPtr);
}
if (first + count < numChars) {
- Tcl_AppendUnicodeToObj(result, ustring + first + count,
+ TclAppendUnicodeToObj(result, ustring + first + count,
numChars - first - count);
}
@@ -4136,7 +4541,7 @@ FillUnicodeRep(
Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars);
@@ -4149,7 +4554,7 @@ ExtendUnicodeRepWithString(
int numBytes,
int numAppendChars)
{
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
int needed, numOrigChars = 0;
Tcl_UniChar *dst, unichar = 0;
@@ -4157,14 +4562,14 @@ ExtendUnicodeRepWithString(
numOrigChars = stringPtr->numChars;
}
if (numAppendChars == -1) {
- TclNumUtfChars(numAppendChars, bytes, numBytes);
+ TclNumUtfCharsM(numAppendChars, bytes, numBytes);
}
needed = numOrigChars + numAppendChars;
- stringCheckLimits(needed);
+ uniCharStringCheckLimits(needed);
if (needed > stringPtr->maxChars) {
GrowUnicodeBuffer(objPtr, needed);
- stringPtr = GET_STRING(objPtr);
+ stringPtr = GET_UNICHAR_STRING(objPtr);
}
stringPtr->hasUnicode = 1;
@@ -4218,8 +4623,8 @@ DupStringInternalRep(
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
- String *srcStringPtr = GET_STRING(srcPtr);
- String *copyStringPtr = NULL;
+ UniCharString *srcStringPtr = GET_UNICHAR_STRING(srcPtr);
+ UniCharString *copyStringPtr = NULL;
if (srcStringPtr->numChars == -1) {
/*
@@ -4239,17 +4644,17 @@ DupStringInternalRep(
} else {
copyMaxChars = srcStringPtr->maxChars;
}
- copyStringPtr = stringAttemptAlloc(copyMaxChars);
+ copyStringPtr = uniCharStringAttemptAlloc(copyMaxChars);
if (copyStringPtr == NULL) {
copyMaxChars = srcStringPtr->numChars;
- copyStringPtr = stringAlloc(copyMaxChars);
+ copyStringPtr = uniCharStringAlloc(copyMaxChars);
}
copyStringPtr->maxChars = copyMaxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
srcStringPtr->numChars * sizeof(Tcl_UniChar));
copyStringPtr->unicode[srcStringPtr->numChars] = 0;
} else {
- copyStringPtr = stringAlloc(0);
+ copyStringPtr = uniCharStringAlloc(0);
copyStringPtr->maxChars = 0;
copyStringPtr->unicode[0] = 0;
}
@@ -4264,8 +4669,8 @@ DupStringInternalRep(
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
- SET_STRING(copyPtr, copyStringPtr);
- copyPtr->typePtr = &tclStringType;
+ SET_UNICHAR_STRING(copyPtr, copyStringPtr);
+ copyPtr->typePtr = &tclUniCharStringType;
}
/*
@@ -4290,8 +4695,8 @@ SetStringFromAny(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *objPtr) /* The object to convert. */
{
- if (!TclHasInternalRep(objPtr, &tclStringType)) {
- String *stringPtr = stringAlloc(0);
+ if (!TclHasInternalRep(objPtr, &tclUniCharStringType)) {
+ UniCharString *stringPtr = uniCharStringAlloc(0);
/*
* Convert whatever we have into an untyped value. Just A String.
@@ -4309,8 +4714,8 @@ SetStringFromAny(
stringPtr->allocated = objPtr->length;
stringPtr->maxChars = 0;
stringPtr->hasUnicode = 0;
- SET_STRING(objPtr, stringPtr);
- objPtr->typePtr = &tclStringType;
+ SET_UNICHAR_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclUniCharStringType;
}
return TCL_OK;
}
@@ -4337,7 +4742,7 @@ static void
UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
/*
* This routine is only called when we need to generate the
@@ -4369,7 +4774,7 @@ ExtendStringRepWithUnicode(
int i, origLength, size = 0;
char *dst;
- String *stringPtr = GET_STRING(objPtr);
+ UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
if (numChars < 0) {
numChars = UnicodeLength(unicode);
@@ -4423,7 +4828,7 @@ ExtendStringRepWithUnicode(
*
* FreeStringInternalRep --
*
- * Deallocate the storage associated with a String data object's internal
+ * Deallocate the storage associated with a (UniChar)String data object's internal
* representation.
*
* Results:
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index 27c3fc2..faa2c2c 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -39,11 +39,6 @@
* Unicode reps of the String object with fewer mallocs. To optimize string
* length and indexing operations, this structure also stores the number of
* characters (same of UTF and Unicode!) once that value has been computed.
- *
- * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
- * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
- * can be officially modified by altering the definition of Tcl_UniChar in
- * tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct {
@@ -59,15 +54,15 @@ typedef struct {
* space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
- Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
+ unsigned short unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
- (int)(((size_t)UINT_MAX - offsetof(String, unicode))/sizeof(Tcl_UniChar) - 1)
+ (int)(((size_t)UINT_MAX - offsetof(String, unicode))/sizeof(unsigned short) - 1)
#define STRING_SIZE(numChars) \
- (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
+ (offsetof(String, unicode) + sizeof(unsigned short) + ((numChars) * sizeof(unsigned short)))
#define stringCheckLimits(numChars) \
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 257c3ce..7d04481 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -48,6 +48,8 @@
#undef Tcl_UniCharCaseMatch
#undef Tcl_UniCharLen
#undef Tcl_UniCharNcmp
+#undef Tcl_GetRange
+#undef Tcl_GetUniChar
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
@@ -76,24 +78,31 @@
#undef Tcl_MacOSXOpenBundleResources
#undef TclWinConvertWSAError
#undef TclWinConvertError
+#undef Tcl_GetCharLength
+#undef Tcl_UtfAtIndex
+
#if defined(_WIN32) || defined(__CYGWIN__)
#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError
#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError
#endif
-#if TCL_UTF_MAX > 3
+#if TCL_UTF_MAX > 3 && defined(TCL_NO_DEPRECATED)
static void uniCodePanic(void) {
- Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
+ Tcl_Panic("Tcl is compiled without the the UTF16 compatibility layer (-DTCL_NO_DEPRECATED)");
}
-# define Tcl_GetUnicode (Tcl_UniChar *(*)(Tcl_Obj *))(void *)uniCodePanic
-# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
-# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, int))(void *)uniCodePanic
-# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
-# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
-# define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
-# define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int))(void *)uniCodePanic
-# define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
+# define Tcl_GetUnicode (unsigned short *(*)(Tcl_Obj *))(void *)uniCodePanic
+# define Tcl_GetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
+# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const unsigned short *, int))(void *)uniCodePanic
+# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic
+# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic
+# define Tcl_UtfAtIndex (const char *(*)(const char *, int))(void *)uniCodePanic
+# define Tcl_GetCharLength (int(*)(Tcl_Obj *))(void *)uniCodePanic
+# define Tcl_UniCharNcmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
+# define Tcl_UniCharNcasecmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
+# define Tcl_UniCharCaseMatch (int(*)(const unsigned short *, const unsigned short *, int))(void *)uniCodePanic
+# define Tcl_GetRange (Tcl_Obj *(*)(Tcl_Obj *, int, int))(void *)uniCodePanic
+# define Tcl_GetUniChar (int(*)(Tcl_Obj *, int))(void *)uniCodePanic
#endif
#define TclUtfCharComplete UtfCharComplete
@@ -683,8 +692,8 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
# define Tcl_SetExitProc 0
# define Tcl_SetPanicProc 0
# define Tcl_FindExecutable 0
-# define Tcl_GetUnicode 0
#if TCL_UTF_MAX < 4
+# define Tcl_GetUnicode 0
# define Tcl_AppendUnicodeToObj 0
# define Tcl_UniCharCaseMatch 0
# define Tcl_UniCharNcasecmp 0
@@ -1950,6 +1959,11 @@ const TclStubs tclStubs = {
0, /* 666 */
0, /* 667 */
Tcl_UniCharLen, /* 668 */
+ TclNumUtfChars, /* 669 */
+ TclGetCharLength, /* 670 */
+ TclUtfAtIndex, /* 671 */
+ TclGetRange, /* 672 */
+ TclGetUniChar, /* 673 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index feb230f..5002e1f 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -16,10 +16,13 @@
*/
#undef STATIC_BUILD
+#undef BUILD_tcl
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
-#ifndef TCL_NO_DEPRECATED
+#ifdef TCL_NO_DEPRECATED
+# define TCL_UTF_MAX 4
+#else
# define TCL_NO_DEPRECATED
#endif
#include "tclInt.h"
@@ -6969,7 +6972,7 @@ TestUtfNextCmd(
int objc,
Tcl_Obj *const objv[])
{
- size_t numBytes;
+ int numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
@@ -6982,7 +6985,7 @@ TestUtfNextCmd(
}
bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
- if (numBytes + 4 > sizeof(buffer)) {
+ if (numBytes + 4U > sizeof(buffer)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
sizeof(buffer) - 4));
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index a235002..223eb98 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-
+#undef BUILD_tcl
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
@@ -1073,8 +1073,9 @@ TestobjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
typeName = objv[2]->typePtr->name;
+ if (!strcmp(typeName, "utf32string")) typeName = "string";
#ifndef TCL_WIDE_INT_IS_LONG
- if (!strcmp(typeName, "wideInt")) typeName = "int";
+ else if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
@@ -1153,7 +1154,7 @@ TeststringobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar *unicode;
+ unsigned short *unicode;
size_t varIndex;
int size, option, i;
Tcl_WideInt length;
@@ -1263,10 +1264,14 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- Tcl_ConvertToType(NULL, varPtr[varIndex],
- Tcl_GetObjType("string"));
- strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
- length = (int) strPtr->allocated;
+ const Tcl_ObjType *objType = Tcl_GetObjType("string");
+ if (objType != NULL) {
+ Tcl_ConvertToType(NULL, varPtr[varIndex], objType);
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ length = (int) strPtr->allocated;
+ } else {
+ length = -1;
+ }
} else {
length = -1;
}
@@ -1317,10 +1322,14 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- Tcl_ConvertToType(NULL, varPtr[varIndex],
- Tcl_GetObjType("string"));
- strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
- length = strPtr->maxChars;
+ const Tcl_ObjType *objType = Tcl_GetObjType("string");
+ if (objType != NULL) {
+ Tcl_ConvertToType(NULL, varPtr[varIndex],objType);
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ length = strPtr->maxChars;
+ } else {
+ length = -1;
+ }
} else {
length = -1;
}
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 535e2c2..e1c03bb 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -432,7 +432,7 @@ TraceExecutionObjCmd(
* pointer to its array of element pointers.
*/
- result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -602,7 +602,7 @@ TraceExecutionObjCmd(
TclNewLiteralStringObj(opObj, "leavestep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
- TclListObjLength(NULL, elemObjPtr, &numOps);
+ TclListObjLengthM(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
@@ -673,7 +673,7 @@ TraceCommandObjCmd(
* pointer to its array of element pointers.
*/
- result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -797,7 +797,7 @@ TraceCommandObjCmd(
TclNewLiteralStringObj(opObj, "delete");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
- TclListObjLength(NULL, elemObjPtr, &numOps);
+ TclListObjLengthM(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
@@ -872,7 +872,7 @@ TraceVariableObjCmd(
* pointer to its array of element pointers.
*/
- result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
+ result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 169f240..82adf65 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -799,7 +799,7 @@ Tcl_UtfCharComplete(
*/
int
-Tcl_NumUtfChars(
+TclNumUtfChars(
const char *src, /* The UTF-8 string to measure. */
int length) /* The length of the string in bytes, or -1
* for strlen(string). */
@@ -850,6 +850,61 @@ Tcl_NumUtfChars(
return i;
}
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_NumUtfChars
+int
+Tcl_NumUtfChars(
+ const char *src, /* The UTF-8 string to measure. */
+ int length) /* The length of the string in bytes, or -1
+ * for strlen(string). */
+{
+ unsigned short ch = 0;
+ int i = 0;
+
+ if (length < 0) {
+ /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
+ while ((*src != '\0') && (i < INT_MAX)) {
+ src += Tcl_UtfToChar16(src, &ch);
+ i++;
+ }
+ } else {
+ /* Will return value between 0 and length. No overflow checks. */
+
+ /* Pointer to the end of string. Never read endPtr[0] */
+ const char *endPtr = src + length;
+ /* Pointer to last byte where optimization still can be used */
+ const char *optPtr = endPtr - 4;
+
+ /*
+ * Optimize away the call in this loop. Justified because...
+ * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr)
+ * By initialization above (endPtr - optPtr) = TCL_UTF_MAX
+ * So (endPtr - src) >= TCL_UTF_MAX, and passing that to
+ * Tcl_UtfCharComplete we know will cause return of 1.
+ */
+ while (src <= optPtr
+ /* && Tcl_UtfCharComplete(src, endPtr - src) */ ) {
+ src += Tcl_UtfToChar16(src, &ch);
+ i++;
+ }
+ /* Loop over the remaining string where call must happen */
+ while (src < endPtr) {
+ if (Tcl_UtfCharComplete(src, endPtr - src)) {
+ src += Tcl_UtfToChar16(src, &ch);
+ } else {
+ /*
+ * src points to incomplete UTF-8 sequence
+ * Treat first byte as character and count it
+ */
+ src++;
+ }
+ i++;
+ }
+ }
+ return i;
+}
+#endif
+
/*
*---------------------------------------------------------------------------
*
@@ -1127,22 +1182,20 @@ Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
int index) /* The position of the desired character. */
{
- Tcl_UniChar ch = 0;
+ unsigned short ch = 0;
int i = 0;
if (index < 0) {
return -1;
}
while (index-- > 0) {
- i = TclUtfToUniChar(src, &ch);
+ i = Tcl_UtfToChar16(src, &ch);
src += i;
}
-#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (i < 3)) {
/* Index points at character following high Surrogate */
return -1;
}
-#endif
TclUtfToUCS4(src, &i);
return i;
}
@@ -1166,27 +1219,56 @@ Tcl_UniCharAtIndex(
*---------------------------------------------------------------------------
*/
+#if TCL_UTF_MAX < 4
+# undef Tcl_UtfToUniChar
+# define Tcl_UtfToUniChar Tcl_UtfToChar16
+#endif
+
const char *
-Tcl_UtfAtIndex(
+TclUtfAtIndex(
const char *src, /* The UTF-8 string. */
int index) /* The position of the desired character. */
{
- Tcl_UniChar ch = 0;
+ Tcl_UniChar ch = 0;
int len = 0;
while (index-- > 0) {
- len = TclUtfToUniChar(src, &ch);
+ len = (Tcl_UtfToUniChar)(src, &ch);
src += len;
}
#if TCL_UTF_MAX < 4
if ((ch >= 0xD800) && (len < 3)) {
/* Index points at character following high Surrogate */
- src += TclUtfToUniChar(src, &ch);
+ src += (Tcl_UtfToUniChar)(src, &ch);
}
#endif
return src;
}
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_UtfAtIndex
+const char *
+Tcl_UtfAtIndex(
+ const char *src, /* The UTF-8 string. */
+ int index) /* The position of the desired character. */
+{
+ unsigned short ch = 0;
+ int len = 0;
+
+ while (index-- > 0) {
+ len = Tcl_UtfToChar16(src, &ch);
+ src += len;
+ }
+ if ((ch >= 0xD800) && (len < 3)) {
+ /* Index points at character following high Surrogate */
+ src += Tcl_UtfToChar16(src, &ch);
+ }
+ return src;
+}
+
+
+#endif
+
/*
*---------------------------------------------------------------------------
*
@@ -1849,7 +1931,7 @@ Tcl_UniCharLen(
*/
int
-Tcl_UniCharNcmp(
+TclUniCharNcmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
unsigned long numChars) /* Number of unichars to compare. */
@@ -1868,21 +1950,47 @@ Tcl_UniCharNcmp(
for ( ; numChars != 0; ucs++, uct++, numChars--) {
if (*ucs != *uct) {
-#if TCL_UTF_MAX < 4
+ return (*ucs - *uct);
+ }
+ }
+ return 0;
+#endif /* WORDS_BIGENDIAN */
+}
+
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+int
+Tcl_UniCharNcmp(
+ const unsigned short *ucs, /* Unicode string to compare to uct. */
+ const unsigned short *uct, /* Unicode string ucs is compared to. */
+ unsigned long numChars) /* Number of unichars to compare. */
+{
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
+ /*
+ * We are definitely on a big-endian machine; memcmp() is safe
+ */
+
+ return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
+
+#else /* !WORDS_BIGENDIAN */
+ /*
+ * We can't simply call memcmp() because that is not lexically correct.
+ */
+
+ for ( ; numChars != 0; ucs++, uct++, numChars--) {
+ if (*ucs != *uct) {
/* special case for handling upper surrogates */
if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
return 1;
} else if (((*uct & 0xFC00) == 0xD800)) {
return -1;
}
-#endif
return (*ucs - *uct);
}
}
return 0;
#endif /* WORDS_BIGENDIAN */
}
-
+#endif
/*
*----------------------------------------------------------------------
*
@@ -1902,31 +2010,51 @@ Tcl_UniCharNcmp(
*/
int
-Tcl_UniCharNcasecmp(
+TclUniCharNcasecmp(
const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
unsigned long numChars) /* Number of unichars to compare. */
{
for ( ; numChars != 0; numChars--, ucs++, uct++) {
if (*ucs != *uct) {
- Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
- Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
+ int lcs = Tcl_UniCharToLower(*ucs);
+ int lct = Tcl_UniCharToLower(*uct);
+
+ if (lcs != lct) {
+ return (lcs - lct);
+ }
+ }
+ }
+ return 0;
+}
+
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+int
+Tcl_UniCharNcasecmp(
+ const unsigned short *ucs, /* Unicode string to compare to uct. */
+ const unsigned short *uct, /* Unicode string ucs is compared to. */
+ unsigned long numChars) /* Number of unichars to compare. */
+{
+ for ( ; numChars != 0; numChars--, ucs++, uct++) {
+ if (*ucs != *uct) {
+ unsigned short lcs = Tcl_UniCharToLower(*ucs);
+ unsigned short lct = Tcl_UniCharToLower(*uct);
if (lcs != lct) {
-#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
return 1;
} else if (((lct & 0xFC00) == 0xD800)) {
return -1;
}
-#endif
return (lcs - lct);
}
}
}
return 0;
}
+#endif
+
/*
*----------------------------------------------------------------------
@@ -2290,14 +2418,182 @@ Tcl_UniCharIsWordChar(
*/
int
-Tcl_UniCharCaseMatch(
+TclUniCharCaseMatch(
const Tcl_UniChar *uniStr, /* Unicode String. */
const Tcl_UniChar *uniPattern,
/* Pattern, which may contain special
* characters. */
int nocase) /* 0 for case sensitive, 1 for insensitive */
{
- Tcl_UniChar ch1 = 0, p;
+ int ch1 = 0, p;
+
+ while (1) {
+ p = *uniPattern;
+
+ /*
+ * See if we're at the end of both the pattern and the string. If so,
+ * we succeeded. If we're at the end of the pattern but not at the end
+ * of the string, we failed.
+ */
+
+ if (p == 0) {
+ return (*uniStr == 0);
+ }
+ if ((*uniStr == 0) && (p != '*')) {
+ return 0;
+ }
+
+ /*
+ * Check for a "*" as the next pattern character. It matches any
+ * substring. We handle this by skipping all the characters up to the
+ * next matching one in the pattern, and then calling ourselves
+ * recursively for each postfix of string, until either we match or we
+ * reach the end of the string.
+ */
+
+ if (p == '*') {
+ /*
+ * Skip all successive *'s in the pattern
+ */
+
+ while (*(++uniPattern) == '*') {
+ /* empty body */
+ }
+ p = *uniPattern;
+ if (p == 0) {
+ return 1;
+ }
+ if (nocase) {
+ p = Tcl_UniCharToLower(p);
+ }
+ while (1) {
+ /*
+ * Optimization for matching - cruise through the string
+ * quickly if the next char in the pattern isn't a special
+ * character
+ */
+
+ if ((p != '[') && (p != '?') && (p != '\\')) {
+ if (nocase) {
+ while (*uniStr && (p != *uniStr)
+ && (p != Tcl_UniCharToLower(*uniStr))) {
+ uniStr++;
+ }
+ } else {
+ while (*uniStr && (p != *uniStr)) {
+ uniStr++;
+ }
+ }
+ }
+ if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) {
+ return 1;
+ }
+ if (*uniStr == 0) {
+ return 0;
+ }
+ uniStr++;
+ }
+ }
+
+ /*
+ * Check for a "?" as the next pattern character. It matches any
+ * single character.
+ */
+
+ if (p == '?') {
+ uniPattern++;
+ uniStr++;
+ continue;
+ }
+
+ /*
+ * Check for a "[" as the next pattern character. It is followed by a
+ * list of characters that are acceptable, or by a range (two
+ * characters separated by "-").
+ */
+
+ if (p == '[') {
+ int startChar, endChar;
+
+ uniPattern++;
+ ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
+ uniStr++;
+ while (1) {
+ if ((*uniPattern == ']') || (*uniPattern == 0)) {
+ return 0;
+ }
+ startChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+ : *uniPattern);
+ uniPattern++;
+ if (*uniPattern == '-') {
+ uniPattern++;
+ if (*uniPattern == 0) {
+ return 0;
+ }
+ endChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+ : *uniPattern);
+ uniPattern++;
+ if (((startChar <= ch1) && (ch1 <= endChar))
+ || ((endChar <= ch1) && (ch1 <= startChar))) {
+ /*
+ * Matches ranges of form [a-z] or [z-a].
+ */
+ break;
+ }
+ } else if (startChar == ch1) {
+ break;
+ }
+ }
+ while (*uniPattern != ']') {
+ if (*uniPattern == 0) {
+ uniPattern--;
+ break;
+ }
+ uniPattern++;
+ }
+ uniPattern++;
+ continue;
+ }
+
+ /*
+ * If the next pattern character is '\', just strip off the '\' so we
+ * do exact matching on the character that follows.
+ */
+
+ if (p == '\\') {
+ if (*(++uniPattern) == '\0') {
+ return 0;
+ }
+ }
+
+ /*
+ * There's no special character. Just make sure that the next bytes of
+ * each string match.
+ */
+
+ if (nocase) {
+ if (Tcl_UniCharToLower(*uniStr) !=
+ Tcl_UniCharToLower(*uniPattern)) {
+ return 0;
+ }
+ } else if (*uniStr != *uniPattern) {
+ return 0;
+ }
+ uniStr++;
+ uniPattern++;
+ }
+}
+
+#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
+int
+Tcl_UniCharCaseMatch(
+ const unsigned short *uniStr, /* Unicode String. */
+ const unsigned short *uniPattern,
+ /* Pattern, which may contain special
+ * characters. */
+ int nocase) /* 0 for case sensitive, 1 for insensitive */
+{
+ unsigned short ch1 = 0, p;
while (1) {
p = *uniPattern;
@@ -2385,7 +2681,7 @@ Tcl_UniCharCaseMatch(
*/
if (p == '[') {
- Tcl_UniChar startChar, endChar;
+ unsigned short startChar, endChar;
uniPattern++;
ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
@@ -2455,7 +2751,9 @@ Tcl_UniCharCaseMatch(
uniPattern++;
}
}
+#endif
+
/*
*----------------------------------------------------------------------
*
@@ -2680,7 +2978,7 @@ TclUtfToUCS4(
int *ucs4Ptr) /* Filled with the UCS4 codepoint represented
* by the UTF-8 string. */
{
- /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
+# undef Tcl_UtfToUniChar
return Tcl_UtfToUniChar(src, ucs4Ptr);
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 66d1009..e9d943b 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2591,11 +2591,11 @@ TclStringMatchObj(
trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
*/
- if (TclHasInternalRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) {
+ if (TclHasInternalRep(strObj, &tclUniCharStringType) || (strObj->typePtr == NULL)) {
Tcl_UniChar *udata, *uptn;
- udata = Tcl_GetUnicodeFromObj(strObj, &length);
- uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
+ udata = TclGetUnicodeFromObj_(strObj, &length);
+ uptn = TclGetUnicodeFromObj_(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
} else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
&& !flags) {
@@ -3786,7 +3786,7 @@ GetEndOffsetFromObj(
if ((TclMaxListLength(bytes, -1, NULL) > 1)
/* If it's possible, do the full list parse. */
- && (TCL_OK == TclListObjLength(NULL, objPtr, &length))
+ && (TCL_OK == TclListObjLengthM(NULL, objPtr, &length))
&& (length > 1)) {
goto parseError;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 6d948dd..0ab2c55 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2981,7 +2981,7 @@ Tcl_LappendObjCmd(
return TCL_ERROR;
}
} else {
- result = TclListObjLength(interp, newValuePtr, &numElems);
+ result = TclListObjLengthM(interp, newValuePtr, &numElems);
if (result != TCL_OK) {
return result;
}
@@ -3039,7 +3039,7 @@ Tcl_LappendObjCmd(
createdNewObj = 1;
}
- result = TclListObjLength(interp, varValuePtr, &numElems);
+ result = TclListObjLengthM(interp, varValuePtr, &numElems);
if (result == TCL_OK) {
result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
(objc-2), (objv+2));
@@ -3191,7 +3191,7 @@ ArrayForNRCmd(
* Parse arguments.
*/
- if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &numVars) != TCL_OK) {
return TCL_ERROR;
}
@@ -3302,7 +3302,7 @@ ArrayForLoopCallback(
goto arrayfordone;
}
- TclListObjGetElements(NULL, varListObj, &varc, &varv);
+ TclListObjGetElementsM(NULL, varListObj, &varc, &varv);
if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
@@ -3842,7 +3842,7 @@ ArrayGetCmd(
*/
TclNewObj(tmpResObj);
- result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
+ result = TclListObjGetElementsM(interp, nameLstObj, &count, &nameObjPtr);
if (result != TCL_OK) {
goto errorInArrayGet;
}
@@ -4165,7 +4165,7 @@ ArraySetCmd(
int elemLen;
Tcl_Obj **elemPtrs, *copyListObj;
- result = TclListObjGetElements(interp, arrayElemObj,
+ result = TclListObjGetElementsM(interp, arrayElemObj,
&elemLen, &elemPtrs);
if (result != TCL_OK) {
return result;
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 61dc615..82e125c 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -3044,7 +3044,7 @@ ZipFSMkZipOrImg(
}
}
Tcl_IncrRefCount(list);
- if (TclListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
+ if (TclListObjGetElementsM(interp, list, &lobjc, &lobjv) != TCL_OK) {
Tcl_DecrRefCount(list);
return TCL_ERROR;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 6a9a38a..f6d7660 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1370,7 +1370,7 @@ Tcl_ZlibStreamGet(
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = NULL;
}
- TclListObjLength(NULL, zshPtr->inData, &listLen);
+ TclListObjLengthM(NULL, zshPtr->inData, &listLen);
if (listLen > 0) {
/*
* There is more input available, get it from the list and
@@ -1419,7 +1419,7 @@ Tcl_ZlibStreamGet(
e = inflate(&zshPtr->stream, zshPtr->flush);
}
};
- TclListObjLength(NULL, zshPtr->inData, &listLen);
+ TclListObjLengthM(NULL, zshPtr->inData, &listLen);
while ((zshPtr->stream.avail_out > 0)
&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
@@ -1499,7 +1499,7 @@ Tcl_ZlibStreamGet(
inflateEnd(&zshPtr->stream);
}
} else {
- TclListObjLength(NULL, zshPtr->outData, &listLen);
+ TclListObjLengthM(NULL, zshPtr->outData, &listLen);
if (count == -1) {
count = 0;
for (i=0; i<listLen; i++) {
@@ -1521,7 +1521,7 @@ Tcl_ZlibStreamGet(
dataPtr += existing;
while ((count > dataPos) &&
- (TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
+ (TclListObjLengthM(NULL, zshPtr->outData, &listLen) == TCL_OK)
&& (listLen > 0)) {
/*
* Get the next chunk off our list of chunks and grab the data out
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 6f85e99..87003e4 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.10a2
+package provide http 2.10a3
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -268,10 +268,49 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
if {[info commands ${token}EventCoroutine] ne {}} {
rename ${token}EventCoroutine {}
}
+
+ # Is this an upgrade request/response?
+ set upgradeResponse 0
+ if { [info exists state(upgradeRequest)]
+ && [info exists state(http)]
+ && $state(upgradeRequest)
+ && ([ncode $token] eq {101})
+ } {
+ # An upgrade must be requested by the client.
+ # If 101 response, test server response headers for an upgrade.
+ set connectionHd {}
+ set upgradeHd {}
+ if {[dict exists $state(meta) connection]} {
+ set connectionHd [string tolower [dict get $state(meta) connection]]
+ }
+ if {[dict exists $state(meta) upgrade]} {
+ set upgradeHd [string tolower [dict get $state(meta) upgrade]]
+ }
+ if {($connectionHd eq {upgrade}) && ($upgradeHd ne {})} {
+ set upgradeResponse 1
+ }
+ }
+
if { ($state(status) eq "timeout")
|| ($state(status) eq "error")
|| ($state(status) eq "eof")
- || ([info exists state(-keepalive)] && !$state(-keepalive))
+ } {
+ set closeQueue 1
+ set connId $state(socketinfo)
+ set sock $state(sock)
+ CloseSocket $state(sock) $token
+ } elseif {$upgradeResponse} {
+ # Special handling for an upgrade request/response.
+ # - geturl ensures that this is not a "persistent" socket used for
+ # multiple HTTP requests, so a call to KeepSocket is not needed.
+ # - Leave socket open, so a call to CloseSocket is not needed either.
+ # - Remove fileevent bindings. The caller will set its own bindings.
+ # - THE CALLER MUST PROCESS THE UPGRADED SOCKET IN THE CALLBACK COMMAND
+ # PASSED TO http::geturl AS -command callback.
+ catch {fileevent $state(sock) readable {}}
+ catch {fileevent $state(sock) writable {}}
+ } elseif {
+ ([info exists state(-keepalive)] && !$state(-keepalive))
|| ([info exists state(connection)] && ($state(connection) eq "close"))
} {
set closeQueue 1
@@ -963,6 +1002,13 @@ proc http::geturl {url args} {
# c11a51c482]
set state(accept-types) $http(-accept)
+ set state(upgradeRequest) [expr {
+ [dict exists $state(-headers) Upgrade]
+ && [dict exists $state(-headers) Connection]
+ && ([dict get $state(-headers) Connection] eq {Upgrade})
+ && ([dict get $state(-headers) Upgrade] ne {})
+ }]
+
if {$isQuery || $isQueryChannel} {
# It's a POST.
# A client wishing to send a non-idempotent request SHOULD wait to send
@@ -978,8 +1024,13 @@ proc http::geturl {url args} {
# There is a small risk of a race against server timeout.
set state(-pipeline) 0
}
+ } elseif {$state(upgradeRequest)} {
+ # It's an upgrade request. Method must be GET (untested).
+ # Force -keepalive to 0 so the connection is not made over a persistent
+ # socket, i.e. one used for multiple HTTP requests.
+ set state(-keepalive) 0
} else {
- # It's a GET or HEAD.
+ # It's a non-upgrade GET or HEAD.
set state(-pipeline) $http(-pipeline)
}
@@ -3488,18 +3539,8 @@ proc http::mapReply {string} {
# a pre-computed map and [string map] to do the conversion (much faster
# than [regsub]/[subst]). [Bug 1020491]
- if {$http(-urlencoding) ne ""} {
- set string [encoding convertto $http(-urlencoding) $string]
- return [string map $formMap $string]
- }
- set converted [string map $formMap $string]
- if {[string match "*\[\u0100-\uffff\]*" $converted]} {
- regexp "\[\u0100-\uffff\]" $converted badChar
- # Return this error message for maximum compatibility... :^/
- return -code error \
- "can't read \"formMap($badChar)\": no such element in array"
- }
- return $converted
+ set string [encoding convertto $http(-urlencoding) $string]
+ return [string map $formMap $string]
}
interp alias {} http::quoteString {} http::mapReply
@@ -3539,7 +3580,7 @@ proc http::CharsetToEncoding {charset} {
set encoding "iso8859-$num"
} elseif {[regexp {iso-?2022-(jp|kr)} $charset -> ext]} {
set encoding "iso2022-$ext"
- } elseif {[regexp {shift[-_]?js} $charset]} {
+ } elseif {[regexp {shift[-_]?jis} $charset]} {
set encoding "shiftjis"
} elseif {[regexp {(?:windows|cp)-?([0-9]+)} $charset -> num]} {
set encoding "cp$num"
@@ -3551,6 +3592,9 @@ proc http::CharsetToEncoding {charset} {
1 - 2 - 3 {
set encoding "iso8859-$num"
}
+ default {
+ set encoding "binary"
+ }
}
} else {
# other charset, like euc-xx, utf-8,... may directly map to encoding
@@ -3575,8 +3619,12 @@ proc http::ContentEncoding {token} {
gzip - x-gzip { lappend r gunzip }
compress - x-compress { lappend r decompress }
identity {}
+ br {
+ return -code error\
+ "content-encoding \"br\" not implemented"
+ }
default {
- return -code error "unsupported content-encoding \"$coding\""
+ Log "unknown content-encoding \"$coding\" ignored"
}
}
}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index d58e8b2..aaa37f9 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
-package ifneeded http 2.10a2 [list tclPkgSetup $dir http 2.10a2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.10a3 [list tclPkgSetup $dir http 2.10a3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/manifest.txt b/library/manifest.txt
index a9e2725..1cf251d 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -5,7 +5,7 @@ apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
- 0 http 2.10a2 {http http.tcl}
+ 0 http 2.10a3 {http http.tcl}
1 msgcat 1.7.1 {msgcat msgcat.tcl}
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
diff --git a/libtommath/bn_mp_mul.c b/libtommath/bn_mp_mul.c
index b00334d..c40feac 100644
--- a/libtommath/bn_mp_mul.c
+++ b/libtommath/bn_mp_mul.c
@@ -19,7 +19,7 @@ mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c)
* The bigger one needs to be at least about one MP_KARATSUBA_MUL_CUTOFF bigger
* to make some sense, but it depends on architecture, OS, position of the
* stars... so YMMV.
- * Using it to cut the input into slices small enough for fast_s_mp_mul_digs
+ * Using it to cut the input into slices small enough for s_mp_mul_digs_fast
* was actually slower on the author's machine, but YMMV.
*/
(min_len >= MP_KARATSUBA_MUL_CUTOFF) &&
diff --git a/libtommath/tommath.h b/libtommath/tommath.h
index 1094641..4bd8f6c 100644
--- a/libtommath/tommath.h
+++ b/libtommath/tommath.h
@@ -237,13 +237,22 @@ TOOM_SQR_CUTOFF;
#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405)
# define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
+#elif defined(_MSC_VER) && _MSC_VER >= 1500
+# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
+#else
+# define MP_DEPRECATED(x)
+#endif
+
+#ifndef MP_NO_DEPRECATED_PRAGMA
+#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301)
# define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
# define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
#elif defined(_MSC_VER) && _MSC_VER >= 1500
-# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
# define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
-#else
-# define MP_DEPRECATED(s)
+#endif
+#endif
+
+#ifndef MP_DEPRECATED_PRAGMA
# define MP_DEPRECATED_PRAGMA(s)
#endif
diff --git a/tests/http.test b/tests/http.test
index a34b168..e3baf58 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -114,6 +114,27 @@ test http-1.6 {http::config} -setup {
test http-2.1 {http::reset} {
catch {http::reset http#1}
} 0
+test http-2.2 {http::CharsetToEncoding} {
+ http::CharsetToEncoding iso-8859-11
+} iso8859-11
+test http-2.3 {http::CharsetToEncoding} {
+ http::CharsetToEncoding iso-2022-kr
+} iso2022-kr
+test http-2.4 {http::CharsetToEncoding} {
+ http::CharsetToEncoding shift-jis
+} shiftjis
+test http-2.5 {http::CharsetToEncoding} {
+ http::CharsetToEncoding windows-437
+} cp437
+test http-2.6 {http::CharsetToEncoding} {
+ http::CharsetToEncoding latin5
+} iso8859-9
+test http-2.7 {http::CharsetToEncoding} {
+ http::CharsetToEncoding latin1
+} iso8859-1
+test http-2.8 {http::CharsetToEncoding} {
+ http::CharsetToEncoding latin4
+} binary
test http-3.1 {http::geturl} -returnCodes error -body {
http::geturl -bogus flag
@@ -656,17 +677,18 @@ test http-7.2 {http::mapReply} {
test http-7.3 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -returnCodes error -body {
- # this would be reverting to http <=2.4 behavior
+ # -urlencoding "" no longer supported. Use "iso8859-1".
http::config -urlencoding ""
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
-} -result "can't read \"formMap(∈)\": no such element in array"
+} -result {unknown encoding ""}
test http-7.4 {http::formatQuery} -constraints deprecated -setup {
set enc [http::config -urlencoding]
} -body {
# this would be reverting to http <=2.4 behavior w/o errors
- # (unknown chars become '?')
+ # with Tcl 8.x (unknown chars become '?'), generating a
+ # proper exception with Tcl 9.0
http::config -urlencoding "iso8859-1"
http::mapReply "∈"
} -cleanup {
diff --git a/tests/obj.test b/tests/obj.test
index 4fa8d3a..7563422 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -19,11 +19,13 @@ if {"::tcltest" ni [namespace children]} {
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
+package require tcltests
+
testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
-test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
+test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {testobj deprecated} {
set r 1
foreach {t} {
bytearray
diff --git a/tests/string.test b/tests/string.test
index 203d0c6..6863c23 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -422,7 +422,7 @@ test string-4.16.$noComp {string first, normal string vs pure unicode string} -b
# Representation checks are canaries
run {list [representationpoke $s] [representationpoke $m] \
[string first $m $s]}
-} -result {{string 1} {string 0} 2}
+} -match glob -result {{*string 1} {*string 0} 2}
test string-4.17.$noComp {string first, corner case} -body {
run {string first a aaa 4294967295}
} -result {-1}
diff --git a/tests/stringObj.test b/tests/stringObj.test
index abe02b2..0aa9a47 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -25,8 +25,9 @@ testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
-
-test stringObj-1.1 {string type registration} testobj {
+testConstraint utf32 [expr {[string length [format %c 0x10000]] == 1}]
+
+test stringObj-1.1 {string type registration} {testobj deprecated} {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first >= 0}]
@@ -57,27 +58,27 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob
lappend result [testobj refcount 1]
} {{} 512 foo string 2}
-test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} testobj {
+test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 test
teststringobj setlength 1 3
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {3 4 tes}
-test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
+} {3 3 tes}
+test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj deprecated} {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj setlength 1 10
list [teststringobj length 1] [teststringobj length2 1]
} {10 10}
-test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
+test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj append 1 xyzq -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {10 20 abcdefxyzq}
-test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj {
+} {10 10 abcdefxyzq}
+test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj setlength 1 0
@@ -97,7 +98,7 @@ test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj {
teststringobj append 1 123 -1
teststringobj get 1
} {x y bbCC123}
-test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
+test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 xyz
teststringobj setlength 1 15
@@ -109,7 +110,7 @@ test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
teststringobj append 1 abcdef -1
lappend result [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {15 15 16 32 xy12345678abcdef}
+} {15 15 16 16 xy12345678abcdef}
test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
testobj freeallvars
@@ -135,13 +136,13 @@ test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj {
teststringobj appendstrings 1 { 123 } abcdefg
list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
-test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
+test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {testobj utf32 deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 123 abcdefg
list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
-} {10 20 123abcdefg}
-test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
+} {10 10 123abcdefg}
+test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj deprecated} {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -150,7 +151,7 @@ test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testob
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {10 10 ab34567890}
-test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
+test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -158,8 +159,8 @@ test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testob
teststringobj appendstrings 1 34567890x
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {11 22 ab34567890x}
-test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
+} {11 11 ab34567890x}
+test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
@@ -172,14 +173,14 @@ test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
teststringobj get 1
} adcfoobarsoom
-test stringObj-7.1 {SetStringFromAny procedure} testobj {
+test stringObj-7.1 {SetStringFromAny procedure} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set2 1 [list a b]
teststringobj append 1 x -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {4 8 {a bx}}
-test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
+} {4 4 {a bx}}
+test stringObj-7.2 {SetStringFromAny procedure, null object} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
@@ -197,7 +198,7 @@ test stringObj-7.4 {SetStringFromAny called with string obj} testobj {
[string length $x] [testobj objtype $x]
} {6 string 6 string}
-test stringObj-8.1 {DupStringInternalRep procedure} testobj {
+test stringObj-8.1 {DupStringInternalRep procedure} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 {}
teststringobj append 1 abcde -1
@@ -206,7 +207,7 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj {
[teststringobj maxchars 1] [teststringobj get 1] \
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj maxchars 2] [teststringobj get 2]
-} {5 10 0 abcde 5 5 0 abcde}
+} {5 5 5 abcde 5 5 5 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abc\xEF\xBF\xAEghi
string length $x
diff --git a/tests/utf.test b/tests/utf.test
index 6402c93..c0d64e2 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -1230,7 +1230,7 @@ test utf-19.1 {TclUniCharLen} -body {
test utf-20.1 {TclUniCharNcmp} utf32 {
string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0]
} -1
-test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} {
+test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} utf32 {
set one [format %c 0xFFFF]
set two [format %c 0x10000]
set first [string compare $one $two]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 149353f..f6e442f 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1039,9 +1039,9 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done
- @echo "Installing package http 2.10a2 as a Tcl Module"
+ @echo "Installing package http 2.10a3 as a Tcl Module"
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
- "$(MODULE_INSTALL_DIR)/8.6/http-2.10a2.tm"
+ "$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm"
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
@for i in $(TOP_DIR)/library/opt/*.tcl; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
diff --git a/win/Makefile.in b/win/Makefile.in
index 1464792..edeb46f 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -878,8 +878,8 @@ install-libraries: libraries install-tzdata install-msgs
$(ROOT_DIR)/library/cookiejar/*.gz; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
- @echo "Installing package http 2.10a2 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a2.tm";
+ @echo "Installing package http 2.10a3 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm";
@echo "Installing package opt 0.4.7";
@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
diff --git a/win/configure b/win/configure
index 56342c0..ba0007f 100755
--- a/win/configure
+++ b/win/configure
@@ -4107,7 +4107,7 @@ printf "%s\n" "$ac_cv_cross" >&6; }
RC="x86_64-w64-mingw32-windres"
;;
arm64|aarch64)
- CC="aarch64-w64-mingw32-clang"
+ CC="aarch64-w64-mingw32-${CC}"
LD="aarch64-w64-mingw32-ld"
AR="aarch64-w64-mingw32-ar"
RANLIB="aarch64-w64-mingw32-ranlib"
diff --git a/win/makefile.vc b/win/makefile.vc
index 1ef64f2..6ff6118 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -52,7 +52,7 @@
# turn on the 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
-# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utfmax,none
+# OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utf16,none
# Sets special options for the core. The default is for none.
# Any combination of the above may be used (comma separated).
# 'none' will over-ride everything to nothing.
@@ -80,7 +80,7 @@
# unchecked = Allows a symbols build to not use the debug
# enabled runtime (msvcrt.dll not msvcrtd.dll
# or libcmt.lib not libcmtd.lib).
-# utfmax = Forces a build using UTF-32 representation internally.
+# utf16 = Forces a build using UTF-16 representation internally.
#
# STATS=compdbg,memdbg,none
# Sets optional memory and bytecode compiler debugging code added
diff --git a/win/rules.vc b/win/rules.vc
index a571899..3107756 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -816,8 +816,7 @@ DOTSEPARATED=$(DOTSEPARATED:b=.)
# configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
# (CRT library should support this, not needed for Tcl 9.x)
-# TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally.
-# (Not needed for Tcl 9.x)
+# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended).
# Further, LINKERFLAGS are modified based on above.
# Default values for all the above
@@ -884,9 +883,9 @@ USE_THREAD_ALLOC= 0
_USE_64BIT_TIME_T = 1
!endif
-!if [nmakehlp -f $(OPTS) "utfmax"]
-!message *** Force allowing 4-byte UTF-8 sequences internally
-TCL_UTF_MAX = 4
+!if [nmakehlp -f $(OPTS) "utf16"]
+!message *** Force UTF-16 internally
+TCL_UTF_MAX = 3
!endif
!endif
@@ -1423,13 +1422,13 @@ OPTDEFINES = $(OPTDEFINES) /DNO_STRTOI64=1
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
-!if "$(TCL_UTF_MAX)" == "4"
-OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=4
-!endif
# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS = /D_ATL_XP_TARGETING
!endif
+!if "$(TCL_UTF_MAX)" == "3"
+OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=3
+!endif
# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
diff --git a/win/tcl.m4 b/win/tcl.m4
index cfc9167..8774b94 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -527,7 +527,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
RC="x86_64-w64-mingw32-windres"
;;
arm64|aarch64)
- CC="aarch64-w64-mingw32-clang"
+ CC="aarch64-w64-mingw32-${CC}"
LD="aarch64-w64-mingw32-ld"
AR="aarch64-w64-mingw32-ar"
RANLIB="aarch64-w64-mingw32-ranlib"
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index f45b557..c910bc5 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -322,18 +322,14 @@ TestSizeCmd(
if (objc != 2) {
goto syntax;
}
- if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) {
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t)));
- return TCL_OK;
- }
if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
- Tcl_StatBuf *statPtr;
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
- return TCL_OK;
+ Tcl_StatBuf *statPtr;
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
+ return TCL_OK;
}
syntax:
- Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime");
+ Tcl_WrongNumArgs(interp, 1, objv, "st_mtime");
return TCL_ERROR;
}