summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-05-17 16:27:19 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-05-17 16:27:19 (GMT)
commit59f20f23bdf80b9aa0106269a64e16715a0deb2c (patch)
tree1c09e78560216f9c0d9d708bca172ef4dd93cc6b
parentc0d3b18e36ba15b38e066951ddf5adaf995be0d0 (diff)
parent292c03d1c289ed9aae8eac6aba53c1857e4bf90d (diff)
downloadtcl-59f20f23bdf80b9aa0106269a64e16715a0deb2c.zip
tcl-59f20f23bdf80b9aa0106269a64e16715a0deb2c.tar.gz
tcl-59f20f23bdf80b9aa0106269a64e16715a0deb2c.tar.bz2
Merge 9.0
-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.decls9
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclAssembly.c2
-rw-r--r--generic/tclBasic.c14
-rw-r--r--generic/tclBinary.c4
-rw-r--r--generic/tclClock.c8
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclCmdIL.c38
-rw-r--r--generic/tclCmdMZ.c64
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclCompCmdsSZ.c12
-rw-r--r--generic/tclCompExpr.c4
-rw-r--r--generic/tclDate.c1
-rw-r--r--generic/tclDecls.h11
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclDisassemble.c2
-rw-r--r--generic/tclEncoding.c12
-rw-r--r--generic/tclEnsemble.c38
-rw-r--r--generic/tclEvent.c2
-rw-r--r--generic/tclExecute.c44
-rw-r--r--generic/tclFCmd.c2
-rw-r--r--generic/tclFileName.c18
-rw-r--r--generic/tclHash.c18
-rw-r--r--generic/tclIO.c2
-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.decls5
-rw-r--r--generic/tclInt.h30
-rw-r--r--generic/tclIntDecls.h9
-rw-r--r--generic/tclInterp.c12
-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.c2
-rw-r--r--generic/tclPathObj.c6
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclProc.c8
-rw-r--r--generic/tclProcess.c4
-rw-r--r--generic/tclResult.c10
-rw-r--r--generic/tclStrToD.c2
-rw-r--r--generic/tclStringObj.c10
-rw-r--r--generic/tclStubInit.c6
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclTestObj.c2
-rw-r--r--generic/tclTrace.c10
-rw-r--r--generic/tclUtil.c2
-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--unix/Makefile.in4
-rw-r--r--win/Makefile.in4
-rwxr-xr-xwin/configure2
-rw-r--r--win/tcl.m42
75 files changed, 538 insertions, 380 deletions
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 807174c..d8ed445 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1408,11 +1408,10 @@ declare 381 {
declare 383 {
Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
-# Removed in 9.0
-#declare 384 {
-# void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
-# int length)
-#}
+declare 384 {
+ void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
+ size_t length)
+}
declare 385 {
int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
Tcl_Obj *patternObj)
diff --git a/generic/tcl.h b/generic/tcl.h
index 44ea473..b55a295 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -99,6 +99,7 @@ extern "C" {
*/
#include <stdio.h>
+#include <stddef.h>
#if defined(__GNUC__) && (__GNUC__ > 2)
# if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
@@ -976,7 +977,7 @@ struct Tcl_HashEntry {
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
- size_t hash; /* Hash value. */
+ TCL_HASH_TYPE hash; /* Hash value. */
void *clientData; /* Application stores something here with
* Tcl_SetHashValue. */
union { /* Key has one of these forms: */
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 1ffcf07..e889bff 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1983,7 +1983,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 3ae8d43..d5f7198 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4703,7 +4703,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);
@@ -5211,7 +5211,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) {
/*
@@ -5263,7 +5263,7 @@ TclEvalEx(
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
- TclListObjGetElements(NULL, temp, &numElements,
+ TclListObjGetElementsM(NULL, temp, &numElements,
&elements);
objectsUsed += numElements;
while (numElements--) {
@@ -6026,7 +6026,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);
}
@@ -8629,7 +8629,7 @@ TclNRTailcallEval(
int objc;
Tcl_Obj **objv;
- TclListObjGetElements(interp, listPtr, &objc, &objv);
+ TclListObjGetElementsM(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
if (result == TCL_OK) {
@@ -9057,7 +9057,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);
}
@@ -9343,7 +9343,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 1955d85..36f4482 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1015,7 +1015,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;
}
@@ -1299,7 +1299,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 620a9d2..31265f0 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 a236f8f..6e18fbe 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2593,7 +2593,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(
@@ -2611,7 +2611,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 b1d55ce..0909e98 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;
@@ -2407,7 +2407,7 @@ Tcl_LinsertObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &len);
+ result = TclListObjLengthM(interp, objv[1], &len);
if (result != TCL_OK) {
return result;
}
@@ -2525,7 +2525,7 @@ Tcl_LlengthObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2578,7 +2578,7 @@ Tcl_LpopObjCmd(
return TCL_ERROR;
}
- result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+ result = TclListObjGetElementsM(interp, listPtr, &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -2673,7 +2673,7 @@ Tcl_LrangeObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2747,7 +2747,7 @@ Tcl_LremoveObjCmd(
}
listObj = objv[1];
- if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
+ if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) {
return TCL_ERROR;
}
@@ -2971,7 +2971,7 @@ Tcl_LreplaceObjCmd(
return TCL_ERROR;
}
- result = TclListObjLength(interp, objv[1], &listLen);
+ result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
return result;
}
@@ -3069,7 +3069,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;
}
@@ -3342,7 +3342,7 @@ Tcl_LsearchObjCmd(
*/
i++;
- if (TclListObjGetElements(interp, objv[i],
+ if (TclListObjGetElementsM(interp, objv[i],
&sortInfo.indexc, &indices) != TCL_OK) {
result = TCL_ERROR;
goto done;
@@ -3448,7 +3448,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;
}
@@ -3553,7 +3553,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);
@@ -3566,7 +3566,7 @@ Tcl_LsearchObjCmd(
* 1844789]
*/
- TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+ TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
break;
}
} else {
@@ -4081,7 +4081,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;
@@ -4174,7 +4174,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;
@@ -4234,7 +4234,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;
@@ -4651,10 +4651,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);
@@ -4864,7 +4864,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 45ed9eb..a3790b9 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -622,8 +622,8 @@ Tcl_RegsubObjCmd(
resultPtr = Tcl_NewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
for (; wstring < wend; wstring++) {
- TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
- TclAppendUnicodeToObj(resultPtr, wstring, 1);
+ Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
numMatches++;
}
wlen = 0;
@@ -639,14 +639,14 @@ Tcl_RegsubObjCmd(
Tcl_IncrRefCount(resultPtr);
}
if (p != wstring) {
- TclAppendUnicodeToObj(resultPtr, p, wstring - p);
+ Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
p = wstring + slen;
} else {
p += slen;
}
wstring = p - 1;
- TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
+ Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
numMatches++;
}
}
@@ -673,7 +673,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) {
@@ -749,7 +749,7 @@ Tcl_RegsubObjCmd(
* specified.
*/
- TclAppendUnicodeToObj(resultPtr, wstring, offset);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
}
}
numMatches++;
@@ -762,7 +762,7 @@ Tcl_RegsubObjCmd(
Tcl_RegExpGetInfo(regExpr, &info);
start = info.matches[0].start;
end = info.matches[0].end;
- TclAppendUnicodeToObj(resultPtr, wstring + offset, start);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
/*
* In command-prefix mode, the substitutions are added as quoted
@@ -775,7 +775,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 **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
@@ -837,7 +837,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
}
@@ -866,7 +866,7 @@ Tcl_RegsubObjCmd(
idx = ch - '0';
} else if ((ch == '\\') || (ch == '&')) {
*wsrc = ch;
- TclAppendUnicodeToObj(resultPtr, wfirstChar,
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar + 1);
*wsrc = '\\';
wfirstChar = wsrc + 2;
@@ -880,7 +880,7 @@ Tcl_RegsubObjCmd(
}
if (wfirstChar != wsrc) {
- TclAppendUnicodeToObj(resultPtr, wfirstChar,
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar);
}
@@ -888,7 +888,7 @@ Tcl_RegsubObjCmd(
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) {
- TclAppendUnicodeToObj(resultPtr,
+ Tcl_AppendUnicodeToObj(resultPtr,
wstring + offset + subStart, subEnd - subStart);
}
}
@@ -900,7 +900,7 @@ Tcl_RegsubObjCmd(
}
if (wfirstChar != wsrc) {
- TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
}
if (end == 0) {
@@ -910,7 +910,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
} else {
@@ -922,7 +922,7 @@ Tcl_RegsubObjCmd(
*/
if (offset < wlen) {
- TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
}
offset++;
}
@@ -947,7 +947,7 @@ Tcl_RegsubObjCmd(
resultPtr = objv[1];
Tcl_IncrRefCount(resultPtr);
} else if (offset < wlen) {
- TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
if (objc == 4) {
if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
@@ -1811,7 +1811,7 @@ StringIsCmd(
* well-formed lists.
*/
- if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) {
+ if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length3)) {
break;
}
@@ -2027,7 +2027,7 @@ StringMapCmd(
Tcl_DictObjDone(&search);
} else {
int i;
- if (TclListObjGetElements(interp, objv[objc-2], &i,
+ if (TclListObjGetElementsM(interp, objv[objc-2], &i,
&mapElemv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2110,14 +2110,14 @@ StringMapCmd(
(length2==1 || strCmpFn(ustring1, ustring2,
length2) == 0)) {
if (p != ustring1) {
- TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
- TclAppendUnicodeToObj(resultPtr, mapString, mapLen);
+ Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
}
}
}
@@ -2163,7 +2163,7 @@ StringMapCmd(
* Put the skipped chars onto the result first.
*/
- TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
@@ -2179,7 +2179,7 @@ StringMapCmd(
* Append the map value to the unicode string.
*/
- TclAppendUnicodeToObj(resultPtr,
+ Tcl_AppendUnicodeToObj(resultPtr,
mapStrings[index+1], mapLens[index+1]);
break;
}
@@ -2196,7 +2196,7 @@ StringMapCmd(
* Put the rest of the unmapped chars onto result.
*/
- TclAppendUnicodeToObj(resultPtr, p, ustring1 - p);
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
}
Tcl_SetObjResult(interp, resultPtr);
done:
@@ -3576,7 +3576,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;
}
@@ -3961,7 +3961,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(
@@ -4749,7 +4749,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",
TclGetString(objv[i+1])));
@@ -4761,7 +4761,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;
}
@@ -4911,12 +4911,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) {
@@ -4937,8 +4937,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;
}
@@ -4978,7 +4978,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 e95b1fb..dc0bbd3 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);
/*
@@ -893,7 +893,7 @@ TclCompileConcatCmd(
int len;
size_t slen;
- TclListObjGetElements(NULL, listObj, &len, &objs);
+ TclListObjGetElementsM(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
bytes = Tcl_GetStringFromObj(objPtr, &slen);
@@ -2753,7 +2753,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 875cede..93a07be 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -944,7 +944,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) {
@@ -2739,7 +2739,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) {
@@ -2872,7 +2872,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;
@@ -2915,7 +2915,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;
@@ -3130,7 +3130,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.
@@ -3342,7 +3342,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 87d9a71..0807593 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2226,8 +2226,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 9cd147f..e4517da 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 79db673..b4a1a65 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
@@ -1003,7 +1005,9 @@ EXTERN int TclGetUniChar(Tcl_Obj *objPtr, size_t index);
/* 383 */
EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, size_t first,
size_t last);
-/* Slot 384 is reserved */
+/* 384 */
+EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
+ const Tcl_UniChar *unicode, size_t length);
/* 385 */
EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp,
Tcl_Obj *textObj, Tcl_Obj *patternObj);
@@ -2180,7 +2184,7 @@ typedef struct TclStubs {
int (*tclGetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */
void (*reserved382)(void);
Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */
- void (*reserved384)(void);
+ void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t 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 */
@@ -3199,7 +3203,8 @@ extern const TclStubs *tclStubsPtr;
/* Slot 382 is reserved */
#define TclGetRange \
(tclStubsPtr->tclGetRange) /* 383 */
-/* Slot 384 is reserved */
+#define Tcl_AppendUnicodeToObj \
+ (tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
#define Tcl_RegExpMatchObj \
(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
#define Tcl_SetNotifier \
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 26a4586..4764502 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -606,7 +606,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;
}
@@ -2471,7 +2471,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) {
@@ -2490,7 +2490,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];
@@ -2665,7 +2665,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) {
@@ -2691,7 +2691,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];
@@ -3104,7 +3104,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) {
@@ -3365,7 +3365,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) {
@@ -3489,7 +3489,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;
@@ -3695,7 +3695,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 1ab1af6..571884b 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -763,7 +763,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 043c725..5b625aa 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;
@@ -1555,7 +1555,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);
@@ -3943,7 +3943,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 6ff5df4..410d454 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -234,7 +234,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);
}
@@ -243,7 +243,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);
}
@@ -273,7 +273,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) {
@@ -338,7 +338,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);
}
@@ -535,13 +535,13 @@ TclNamespaceEnsembleCmd(
}
switch (idx) {
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);
@@ -563,7 +563,7 @@ TclNamespaceEnsembleCmd(
continue;
}
do {
- if (TclListObjGetElements(interp, listObj, &len,
+ if (TclListObjGetElementsM(interp, listObj, &len,
&listv) != TCL_OK) {
Tcl_DictObjDone(&search);
if (patchedDict) {
@@ -625,7 +625,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);
@@ -794,7 +794,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) {
@@ -870,7 +870,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) {
@@ -1045,7 +1045,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) {
@@ -1888,7 +1888,7 @@ NsEnsembleImplementationCmdNR(
Tcl_Obj **copyObjv;
int copyObjc, prefixObjc;
- TclListObjLength(NULL, prefixObj, &prefixObjc);
+ TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
@@ -1922,7 +1922,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);
}
@@ -2296,7 +2296,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);
/*
@@ -2333,7 +2333,7 @@ EnsembleUnknownCallback(
/* A non-empty list is the replacement command. */
- 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");
@@ -2590,7 +2590,7 @@ BuildEnsembleConfig(
* Determine the target for each.
*/
- TclListObjGetElements(NULL, subList, &subc, &subv);
+ TclListObjGetElementsM(NULL, subList, &subc, &subv);
if (subList == mapDict) {
/*
* Unusual case where explicit list of subcommands is same value
@@ -2987,7 +2987,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++) {
@@ -3107,7 +3107,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) {
/*
@@ -3390,7 +3390,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 49c61da..cfb5b09 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -219,7 +219,7 @@ HandleBgErrors(
errPtr = assocPtr->firstBgPtr;
- TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+ TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv);
tempObjv = (Tcl_Obj**)Tcl_Alloc((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 9df881e..a8c7db4 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2672,7 +2672,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;
}
@@ -2882,7 +2882,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);
@@ -3293,7 +3293,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;
@@ -3319,7 +3319,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;
@@ -3361,7 +3361,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;
}
@@ -3382,7 +3382,7 @@ TEBCresume(
lappendList:
opnd = -1;
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv)
+ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -3420,7 +3420,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 {
@@ -4636,7 +4636,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;
}
@@ -4653,7 +4653,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;
@@ -4698,7 +4698,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;
}
@@ -4837,7 +4837,7 @@ TEBCresume(
* in the process.
*/
- if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
+ if (TclListObjLengthM(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -4902,7 +4902,7 @@ TEBCresume(
s1 = Tcl_GetStringFromObj(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;
}
@@ -5299,14 +5299,14 @@ TEBCresume(
memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
== 0)) {
if (p != ustring1) {
- TclAppendUnicodeToObj(objResultPtr, p, ustring1-p);
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
- TclAppendUnicodeToObj(objResultPtr, ustring3, length3);
+ Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
}
}
if (p != ustring1) {
@@ -5314,7 +5314,7 @@ TEBCresume(
* Put the rest of the unmapped chars onto result.
*/
- TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
@@ -6247,7 +6247,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;
@@ -6328,7 +6328,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++) {
@@ -6940,7 +6940,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;
@@ -7000,7 +7000,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;
@@ -7059,7 +7059,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;
}
@@ -7077,7 +7077,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;
@@ -7108,7 +7108,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 7770fb2..d9ed982 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 7980878..27da364 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -516,7 +516,7 @@ TclpNativeSplitPath(
*/
if (lenPtr != NULL) {
- TclListObjLength(NULL, resultPtr, lenPtr);
+ TclListObjLengthM(NULL, resultPtr, lenPtr);
}
return resultPtr;
}
@@ -1334,7 +1334,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++;
@@ -1456,7 +1456,7 @@ Tcl_GlobObjCmd(
* platform.
*/
- TclListObjLength(interp, typePtr, &length);
+ TclListObjLengthM(interp, typePtr, &length);
if (length <= 0) {
goto skipTypes;
}
@@ -1527,7 +1527,7 @@ Tcl_GlobObjCmd(
Tcl_Obj *item;
int llen;
- if ((TclListObjLength(NULL, look, &llen) == TCL_OK)
+ if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK)
&& (llen == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", TclGetString(item))) {
@@ -1634,7 +1634,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.
@@ -2017,7 +2017,7 @@ TclGlob(
}
}
- TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
+ TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
size_t len;
const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
@@ -2346,13 +2346,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 && TclGetString(subdirv[i])[0] == '~') {
- TclListObjLength(NULL, matchesObj, &repair);
+ TclListObjLengthM(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
Tcl_AppendObjToObj(subdirv[i], copy);
@@ -2365,7 +2365,7 @@ DoGlob(
Tcl_DecrRefCount(subdirv[i]);
subdirv[i] = copy;
- TclListObjLength(NULL, matchesObj, &end);
+ TclListObjLengthM(NULL, matchesObj, &end);
while (repair < end) {
const char *bytes;
size_t numBytes;
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 802b627..3ca269c 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -247,7 +247,7 @@ CreateHashEntry(
{
Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
- size_t hash, index;
+ TCL_HASH_TYPE hash, index;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
@@ -268,7 +268,7 @@ CreateHashEntry(
index = hash & tablePtr->mask;
}
} else {
- hash = (size_t) key;
+ hash = PTR2UINT(key);
index = RANDOM_INDEX(tablePtr, hash);
}
@@ -369,7 +369,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
- size_t index;
+ TCL_HASH_TYPE index;
tablePtr = entryPtr->tablePtr;
@@ -587,7 +587,8 @@ Tcl_HashStats(
Tcl_HashTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
- size_t count[NUM_COUNTERS], overflow, i, j;
+ size_t i;
+ TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j;
double average, tmp;
Tcl_HashEntry *hPtr;
char *result, *p;
@@ -661,12 +662,9 @@ AllocArrayEntry(
int *array = (int *) keyPtr;
int *iPtr1, *iPtr2;
Tcl_HashEntry *hPtr;
- int count;
- size_t 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);
}
@@ -955,7 +953,7 @@ static void
RebuildTable(
Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
- size_t 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;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 4cf6a7e..d0a05a3 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10938,7 +10938,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 5ed36ee..5e7e27c 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -266,7 +266,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 9cd9b96..c9c83ed 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -609,7 +609,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)));
@@ -1062,7 +1062,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) {
@@ -1993,7 +1993,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;
}
@@ -2139,7 +2139,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;
}
@@ -3307,7 +3307,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 bf8f469..bad3f32 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -599,7 +599,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)));
@@ -835,7 +835,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) {
@@ -1757,7 +1757,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 46ec1f1..dc96f0f 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++) {
@@ -2477,7 +2477,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;
}
@@ -3950,7 +3950,7 @@ Tcl_FSSplitPath(
}
if (lenPtr != NULL) {
- TclListObjLength(NULL, result, lenPtr);
+ TclListObjLengthM(NULL, result, lenPtr);
}
return result;
}
@@ -4073,7 +4073,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 567bdc5..56a8431 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -121,7 +121,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;
}
@@ -552,7 +552,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;
}
@@ -576,7 +576,7 @@ PrefixMatchObjCmd(
* error case regardless of level.
*/
- result = TclListObjLength(interp, tablePtr, &dummyLength);
+ result = TclListObjLengthM(interp, tablePtr, &dummyLength);
if (result != TCL_OK) {
return result;
}
@@ -642,7 +642,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;
}
@@ -700,7 +700,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.decls b/generic/tclInt.decls
index 2d91d0a..79694a7 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -478,11 +478,6 @@ declare 234 {
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
-# TIP 542
-declare 236 {
- void TclAppendUnicodeToObj(Tcl_Obj *objPtr,
- const Tcl_UniChar *unicode, size_t length)
-}
# TIP #285: Script cancellation support.
declare 237 {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e0cc282..52262c1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -76,11 +76,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>
/*
@@ -116,25 +111,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)
@@ -2416,12 +2402,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)))
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 48cec3d..bf05a0e 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -500,9 +500,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
/* 235 */
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
-/* 236 */
-EXTERN void TclAppendUnicodeToObj(Tcl_Obj *objPtr,
- const Tcl_UniChar *unicode, size_t length);
+/* Slot 236 is reserved */
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -819,7 +817,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
- void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 236 */
+ void (*reserved236)(void);
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, size_t skip, ProcErrorProc *errorProc); /* 239 */
@@ -1211,8 +1209,7 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
-#define TclAppendUnicodeToObj \
- (tclIntStubsPtr->tclAppendUnicodeToObj) /* 236 */
+/* Slot 236 is reserved */
#define TclResetCancellation \
(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index cfa6b7c..8f30128 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -789,7 +789,7 @@ NRInterpCmd(
};
enum option {
OPT_SAFE, OPT_LAST
- };
+ } idx;
safe = Tcl_IsSafe(interp);
@@ -802,10 +802,10 @@ NRInterpCmd(
for (i = 2; i < objc; i++) {
if ((last == 0) && (TclGetString(objv[i])[0] == '-')) {
if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
- "option", 0, &index) != TCL_OK) {
+ "option", 0, &idx) != TCL_OK) {
return TCL_ERROR;
}
- if (index == OPT_SAFE) {
+ if (idx == OPT_SAFE) {
safe = 1;
continue;
}
@@ -2322,7 +2322,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;
}
@@ -2378,7 +2378,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));
@@ -2425,7 +2425,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 62c3370..e338ae8 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
|| (size_t)objc != linkPtr->numElems) {
return (char *) "wrong dimension";
}
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 0d5aad5..e104136 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -435,7 +435,7 @@ TclListObjRange(
size_t i, newLen;
List *listRepPtr;
- TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
+ TclListObjGetElementsM(NULL, listPtr, &listLen, &elemPtrs);
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = 0;
@@ -604,7 +604,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;
}
@@ -1341,7 +1341,7 @@ TclLindexFlat(
break;
}
- TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+ TclListObjGetElementsM(NULL, sublistCopy, &listLen, &elemPtrs);
if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
&index) == TCL_OK) {
@@ -1434,7 +1434,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.
@@ -1555,7 +1555,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;
@@ -1702,7 +1702,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 == (size_t)len) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7f034fe..50d3085 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -4068,7 +4068,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) {
@@ -4436,7 +4436,7 @@ Tcl_SetNamespaceUnknownHandler(
*/
if (handlerPtr != NULL) {
- if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
+ if (TclListObjLengthM(interp, handlerPtr, &lstlen) != TCL_OK) {
/*
* Not a list.
*/
@@ -5013,7 +5013,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.
@@ -5098,7 +5098,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 854ea8f..6f404fb 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 ca2b642..300b8c7 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 *)Tcl_Alloc(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));
@@ -1390,7 +1390,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) {
@@ -1429,7 +1429,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) {
@@ -1478,7 +1478,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 c63a883..b4d6332 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -841,7 +841,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 9f655ea..ff08bd4 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -810,12 +810,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;
}
@@ -2314,7 +2314,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 4297207..9cf0ab3 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -1361,7 +1361,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);
@@ -1388,7 +1388,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 adc015f..613225c 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;
}
@@ -515,7 +515,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;
@@ -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. */
@@ -2396,7 +2396,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 a76ede5..a4967ec 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/tclResult.c b/generic/tclResult.c
index 82abbaa..50eebfd 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -750,12 +750,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.
@@ -912,7 +912,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.
*/
@@ -934,7 +934,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.
*/
@@ -1104,7 +1104,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 15aeaf4..a52f78f 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -558,7 +558,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 91cf9dc..61f566a 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -516,7 +516,7 @@ TclCheckEmptyString(
}
if (TclListObjIsCanonical(objPtr)) {
- TclListObjLength(NULL, objPtr, &length);
+ TclListObjLengthM(NULL, objPtr, &length);
return length == 0;
}
@@ -1343,7 +1343,7 @@ Tcl_AppendToObj(
*/
void
-TclAppendUnicodeToObj(
+Tcl_AppendUnicodeToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
@@ -2799,7 +2799,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,
@@ -3011,7 +3011,7 @@ TclStringRepeat(
Tcl_AppendObjToObj(objResultPtr, objResultPtr);
done *= 2;
}
- TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
+ Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
(count - done) * length);
} else {
/*
@@ -4115,7 +4115,7 @@ TclStringReplace(
Tcl_AppendObjToObj(result, insertPtr);
}
if (first + count < (size_t)numChars) {
- TclAppendUnicodeToObj(result, ustring + first + count,
+ Tcl_AppendUnicodeToObj(result, ustring + first + count,
numChars - first - count);
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 704c51a..9f052e3 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -81,7 +81,7 @@ static void uniCodePanic() {
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
-# define TclAppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
+# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
#endif
#define TclUtfCharComplete Tcl_UtfCharComplete
@@ -528,7 +528,7 @@ static const TclIntStubs tclIntStubs = {
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
- TclAppendUnicodeToObj, /* 236 */
+ 0, /* 236 */
TclResetCancellation, /* 237 */
TclNRInterpProc, /* 238 */
TclNRInterpProcCore, /* 239 */
@@ -1077,7 +1077,7 @@ const TclStubs tclStubs = {
TclGetUniChar, /* 381 */
0, /* 382 */
TclGetRange, /* 383 */
- 0, /* 384 */
+ Tcl_AppendUnicodeToObj, /* 384 */
Tcl_RegExpMatchObj, /* 385 */
Tcl_SetNotifier, /* 386 */
Tcl_GetAllocMutex, /* 387 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7db35e1..0af2d65 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6984,7 +6984,7 @@ TestUtfNextCmd(
bytes = Tcl_GetString(objv[1]);
numBytes = objv[1]->length;
- 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 c4f9e1f..a85a002 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1377,7 +1377,7 @@ TeststringobjCmd(
return TCL_ERROR;
}
- TclAppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
+ Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
}
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index a7c7b5d..f1cdaad 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -429,7 +429,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;
}
@@ -599,7 +599,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;
@@ -672,7 +672,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;
}
@@ -796,7 +796,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;
@@ -873,7 +873,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/tclUtil.c b/generic/tclUtil.c
index bc51a41..8c2485e 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3486,7 +3486,7 @@ GetEndOffsetFromObj(
if ((TclMaxListLength(bytes, -1, NULL) > 1)
/* If it's possible, do the full list parse. */
- && (TCL_OK == TclListObjLength(NULL, objPtr, &len))
+ && (TCL_OK == TclListObjLengthM(NULL, objPtr, &len))
&& (len > 1)) {
goto parseError;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 71489e1..424c698 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -2835,7 +2835,7 @@ Tcl_LappendObjCmd(
return TCL_ERROR;
}
} else {
- result = TclListObjLength(interp, newValuePtr, &numElems);
+ result = TclListObjLengthM(interp, newValuePtr, &numElems);
if (result != TCL_OK) {
return result;
}
@@ -2893,7 +2893,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));
@@ -3045,7 +3045,7 @@ ArrayForNRCmd(
* Parse arguments.
*/
- if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) {
+ if (TclListObjLengthM(interp, objv[1], &numVars) != TCL_OK) {
return TCL_ERROR;
}
@@ -3156,7 +3156,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;
@@ -3696,7 +3696,7 @@ ArrayGetCmd(
*/
TclNewObj(tmpResObj);
- result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
+ result = TclListObjGetElementsM(interp, nameLstObj, &count, &nameObjPtr);
if (result != TCL_OK) {
goto errorInArrayGet;
}
@@ -4019,7 +4019,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 85b57a5..63b6e7c 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -3029,7 +3029,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 8a95fd5..3d2f4cc 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1373,7 +1373,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
@@ -1422,7 +1422,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)) {
@@ -1502,7 +1502,7 @@ Tcl_ZlibStreamGet(
inflateEnd(&zshPtr->stream);
}
} else {
- TclListObjLength(NULL, zshPtr->outData, &listLen);
+ TclListObjLengthM(NULL, zshPtr->outData, &listLen);
if (count == TCL_INDEX_NONE) {
count = 0;
for (i=0; i<listLen; i++) {
@@ -1524,7 +1524,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 3b2963e..aeb1029 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -113,6 +113,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
@@ -655,15 +676,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} -setup {
set enc [http::config -urlencoding]
} -body {
+ # this would be reverting to http <=2.4 behavior w/o errors
+ # 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/unix/Makefile.in b/unix/Makefile.in
index 062698f..416073a 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1043,9 +1043,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)/9.0/http-2.10a2.tm"
+ "$(MODULE_INSTALL_DIR)/9.0/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 b5aed05..23f7fe4 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -889,8 +889,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)/9.0/http-2.10a2.tm";
+ @echo "Installing package http 2.10a3 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/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 66d807a..703125e 100755
--- a/win/configure
+++ b/win/configure
@@ -4085,7 +4085,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/tcl.m4 b/win/tcl.m4
index dc98570..fa9d4a9 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"