summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2024-08-06 11:12:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2024-08-06 11:12:47 (GMT)
commit6c41478f2cdcbefeae9c340e1ba2bc9d8d51d47d (patch)
tree10b477c4f96989d84a5453310c9715aaef2b3413
parent351ab9f3bf86ea2d971416a759964c836e91c1b9 (diff)
parente92ac699c1a4fc8683a61f855f5250c72d12b1c1 (diff)
downloadtcl-6c41478f2cdcbefeae9c340e1ba2bc9d8d51d47d.zip
tcl-6c41478f2cdcbefeae9c340e1ba2bc9d8d51d47d.tar.gz
tcl-6c41478f2cdcbefeae9c340e1ba2bc9d8d51d47d.tar.bz2
merge 8.6
-rw-r--r--.github/workflows/mac-build.yml4
-rw-r--r--doc/AddErrInfo.32
-rw-r--r--doc/Eval.32
-rw-r--r--doc/SaveResult.31
-rw-r--r--doc/SetResult.33
-rw-r--r--doc/StringObj.32
-rw-r--r--doc/TclZlib.35
-rw-r--r--doc/chan.n126
-rw-r--r--doc/encoding.n7
-rw-r--r--doc/fileevent.n2
-rw-r--r--doc/interp.n1
-rw-r--r--doc/object.n5
-rw-r--r--doc/tm.n6
-rw-r--r--generic/tclAssembly.c66
-rw-r--r--generic/tclBasic.c661
-rw-r--r--generic/tclBinary.c111
-rw-r--r--generic/tclClock.c28
-rw-r--r--generic/tclCmdAH.c10
-rw-r--r--generic/tclCmdIL.c17
-rw-r--r--generic/tclCmdMZ.c8
-rw-r--r--generic/tclCompCmds.c15
-rw-r--r--generic/tclCompCmdsSZ.c5
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclCompile.c16
-rw-r--r--generic/tclCompile.h5
-rw-r--r--generic/tclConfig.c8
-rw-r--r--generic/tclDate.c18
-rw-r--r--generic/tclDictObj.c159
-rw-r--r--generic/tclDisassemble.c124
-rw-r--r--generic/tclEncoding.c15
-rw-r--r--generic/tclEnsemble.c12
-rw-r--r--generic/tclEvent.c36
-rw-r--r--generic/tclExecute.c135
-rw-r--r--generic/tclFCmd.c6
-rw-r--r--generic/tclFileName.c112
-rw-r--r--generic/tclGetDate.y18
-rw-r--r--generic/tclIO.c28
-rw-r--r--generic/tclIOCmd.c7
-rw-r--r--generic/tclIORChan.c2
-rw-r--r--generic/tclIOUtil.c11
-rw-r--r--generic/tclInt.h11
-rw-r--r--generic/tclInterp.c43
-rw-r--r--generic/tclLink.c10
-rw-r--r--generic/tclListObj.c10
-rw-r--r--generic/tclLoad.c26
-rw-r--r--generic/tclMain.c8
-rw-r--r--generic/tclOO.c18
-rw-r--r--generic/tclOOBasic.c50
-rw-r--r--generic/tclOOInfo.c6
-rw-r--r--generic/tclOOMethod.c6
-rw-r--r--generic/tclObj.c238
-rw-r--r--generic/tclPathObj.c6
-rw-r--r--generic/tclPipe.c34
-rw-r--r--generic/tclPkg.c34
-rw-r--r--generic/tclProc.c30
-rw-r--r--generic/tclRegexp.c2
-rw-r--r--generic/tclResult.c14
-rw-r--r--generic/tclScan.c2
-rw-r--r--generic/tclStrToD.c20
-rw-r--r--generic/tclStringObj.c141
-rw-r--r--generic/tclTest.c38
-rw-r--r--generic/tclTestObj.c4
-rw-r--r--generic/tclThreadTest.c2
-rw-r--r--generic/tclTimer.c4
-rw-r--r--generic/tclTrace.c8
-rw-r--r--generic/tclUtil.c33
-rw-r--r--generic/tclVar.c56
-rw-r--r--generic/tclZlib.c54
-rw-r--r--library/history.tcl2
-rw-r--r--library/http/http.tcl37
-rw-r--r--library/http1.0/http.tcl4
-rw-r--r--library/init.tcl10
-rw-r--r--library/msgcat/msgcat.tcl6
-rw-r--r--library/opt/optparse.tcl2
-rw-r--r--library/package.tcl20
-rw-r--r--library/platform/shell.tcl2
-rw-r--r--library/reg/pkgIndex.tcl4
-rw-r--r--library/safe.tcl20
-rw-r--r--library/tcltest/tcltest.tcl18
-rw-r--r--library/tm.tcl2
-rw-r--r--tests-perf/chan.perf.tcl6
-rw-r--r--tests/chanio.test24
-rw-r--r--tests/clock.test19
-rw-r--r--tests/cmdAH.test24
-rw-r--r--tests/cmdMZ.test15
-rw-r--r--tests/encoding.test8
-rw-r--r--tests/info.test38
-rw-r--r--tests/interp.test72
-rw-r--r--tests/ioCmd.test5
-rw-r--r--tests/ioTrans.test2
-rw-r--r--tests/namespace.test16
-rw-r--r--tests/oo.test111
-rw-r--r--tests/remote.tcl8
-rw-r--r--tests/socket.test19
-rw-r--r--tests/zlib.test34
-rw-r--r--unix/Makefile.in2
-rwxr-xr-xunix/installManPage47
-rw-r--r--unix/tclLoadDl.c2
-rw-r--r--unix/tclLoadDyld.c2
-rw-r--r--unix/tclLoadNext.c2
-rw-r--r--unix/tclLoadOSF.c4
-rw-r--r--unix/tclUnixChan.c96
-rw-r--r--unix/tclUnixCompat.c16
-rw-r--r--unix/tclUnixFCmd.c6
-rw-r--r--unix/tclUnixFile.c54
-rw-r--r--unix/tclUnixInit.c67
-rw-r--r--unix/tclUnixPipe.c41
-rw-r--r--unix/tclUnixSock.c599
-rw-r--r--unix/tclUnixTest.c40
-rw-r--r--unix/tclUnixTime.c2
-rw-r--r--win/Makefile.in2
-rw-r--r--win/nmakehlp.c45
-rw-r--r--win/tclWinFCmd.c2
-rw-r--r--win/tclWinFile.c12
-rw-r--r--win/tclWinSock.c25
-rw-r--r--win/tclWinTime.c14
116 files changed, 2337 insertions, 1980 deletions
diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml
index 30408d8..bd8e703 100644
--- a/.github/workflows/mac-build.yml
+++ b/.github/workflows/mac-build.yml
@@ -11,7 +11,7 @@ permissions:
contents: read
jobs:
xcode:
- runs-on: macos-11
+ runs-on: macos-12
defaults:
run:
shell: bash
@@ -34,7 +34,7 @@ jobs:
MAC_CI: 1
timeout-minutes: 15
clang:
- runs-on: macos-11
+ runs-on: macos-12
strategy:
matrix:
config:
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index 99ec904..aad1cd7 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -68,7 +68,7 @@ If negative, all bytes up to the first null byte are used.
The \fB\-errorcode\fR return option will be set to this value.
.AP "const char" *element in
String to record as one element of the \fB\-errorcode\fR return option.
-Last \fIelement\fR argument must be NULL.
+Last \fIelement\fR argument must be (char *)NULL.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
diff --git a/doc/Eval.3 b/doc/Eval.3
index 277d028..27ef204 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -151,7 +151,7 @@ of any length, concatenates them into a single string,
then calls \fBTcl_Eval\fR to execute that string as a Tcl command.
It returns the result of the command and also modifies
\fIinterp->result\fR in the same way as \fBTcl_Eval\fR.
-The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
+The last argument to \fBTcl_VarEval\fR must be (char *)NULL to indicate the end
of arguments.
.PP
\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 918941e..fe532b6 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -27,6 +27,7 @@ int
\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR)
.sp
\fBTcl_DiscardResult\fR(\fIsavedPtr\fR)
+.fi
.SH ARGUMENTS
.AS Tcl_InterpState savedPtr
.AP Tcl_Interp *interp in
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index 0b0697a..9c6d47c 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -37,6 +37,7 @@ const char *
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.sp
\fBTcl_FreeResult\fR(\fIinterp\fR)
+.fi
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp out
.AP Tcl_Interp *interp out
@@ -149,7 +150,7 @@ It also manages conversion to and from the \fIresult\fR field of the
\fIinterp\fR so as to handle backward-compatibility with old-style
extensions.
Any number of \fIresult\fR arguments may be passed in a single
-call; the last argument in the list must be a NULL pointer.
+call; the last argument in the list must be (char *)NULL.
.PP
\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
instead of taking a variable number of arguments it takes an argument list.
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 9ce4d16..91b852d 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -249,7 +249,7 @@ except that it can be passed more than one value to append and
each value must be a null-terminated string (i.e. none of the
values may contain internal null characters). Any number of
\fIstring\fR arguments may be provided, but the last argument
-must be a NULL pointer to indicate the end of the list.
+must be (char *)NULL to indicate the end of the list.
.PP
\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR
except that instead of taking a variable number of arguments it takes an
diff --git a/doc/TclZlib.3 b/doc/TclZlib.3
index 4a5df89..106a5ef 100644
--- a/doc/TclZlib.3
+++ b/doc/TclZlib.3
@@ -18,7 +18,7 @@ int
\fBTcl_ZlibDeflate\fR(\fIinterp, format, dataObj, level, dictObj\fR)
.sp
int
-\fBTcl_ZlibInflate\fR(\fIinterp, format, dataObj, dictObj\fR)
+\fBTcl_ZlibInflate\fR(\fIinterp, format, dataObj, bufferSize, dictObj\fR)
.sp
unsigned int
\fBTcl_ZlibCRC32\fR(\fIinitValue, bytes, length\fR)
@@ -85,6 +85,9 @@ section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
+.AP "int" bufferSize in
+A hint as to what size of buffer is to be used to receive the data.
+Use 0 to use a geric guess based on the input data.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
diff --git a/doc/chan.n b/doc/chan.n
index 77e9326..53f8123 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -21,6 +21,7 @@ channels \fBstdin\fR, \fBstdout\fR or \fBstderr\fR which correspond to
the process's standard input, output and error streams respectively).
\fIOption\fR indicates what to do with the channel; any unique
abbreviation for \fIoption\fR is acceptable. Valid options are:
+.\" METHOD: blocked
.TP
\fBchan blocked \fIchannelId\fR
.
@@ -30,6 +31,7 @@ process to block, and returns 1 if that was the case. It returns 0
otherwise. Note that this only ever returns 1 when the channel has
been configured to be non-blocking; all Tcl channels have blocking
turned on by default.
+.\" METHOD: close
.TP
\fBchan close \fIchannelId\fR ?\fIdirection\fR?
.
@@ -90,6 +92,7 @@ system resource, which can change how other processes or systems respond to
the Tcl program.
.VE 8.6
.RE
+.\" METHOD: configure
.TP
\fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
@@ -112,8 +115,10 @@ for the options supported by that specific type of channel. For
example, see the manual entry for the \fBsocket\fR command for additional
options for sockets, and the \fBopen\fR command for additional options for
serial devices.
+.RE
+.\" OPTION: -blocking
.TP
-\fB\-blocking\fR \fIboolean\fR
+\fB\-blocking\fI boolean\fR
.
The \fB\-blocking\fR option determines whether I/O operations on the
channel can cause the process to block indefinitely. The value of the
@@ -125,8 +130,9 @@ documentation for those commands for details. For non-blocking mode to
work correctly, the application must be using the Tcl event loop
(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR
command).
+.\" OPTION: -buffering
.TP
-\fB\-buffering\fR \fInewValue\fR
+\fB\-buffering\fI newValue\fR
.
If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output
until its internal buffer is full or until the \fBchan flush\fR
@@ -139,13 +145,15 @@ channels that connect to terminal-like devices; for these channels the
initial setting is \fBline\fR. Additionally, \fBstdin\fR and
\fBstdout\fR are initially set to \fBline\fR, and \fBstderr\fR is set
to \fBnone\fR.
+.\" OPTION: -buffersize
.TP
-\fB\-buffersize\fR \fInewSize\fR
+\fB\-buffersize\fI newSize\fR
.
-\fINewvalue\fR must be an integer; its value is used to set the size
+\fInewSize\fR must be an integer; its value is used to set the size
of buffers, in bytes, subsequently allocated for this channel to store
-input or output. \fINewvalue\fR must be a number of no more than one
+input or output. \fInewSize\fR must be a number of no more than one
million, allowing buffers of up to one million bytes in size.
+.\" OPTION: -encoding
.TP
\fB\-encoding\fR \fIname\fR
.
@@ -174,6 +182,7 @@ The default encoding for newly opened channels is the same platform-
and locale-dependent system encoding used for interfacing with the
operating system, as returned by \fBencoding system\fR.
.RE
+.\" OPTION: -eofchar
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
@@ -197,10 +206,11 @@ for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
+.\" OPTION: -translation
.TP
-\fB\-translation\fR \fImode\fR
+\fB\-translation\fI translation\fR
.TP
-\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
+\fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en). However, in actual files and devices the end
@@ -226,9 +236,7 @@ you can specify a single value that will apply to both reading and
writing. When querying the translation mode of a read-write channel, a
two-element list will always be returned. The following values are
currently supported:
-.TP
-\fBauto\fR
-.
+.IP \fBauto\fR
As the input translation mode, \fBauto\fR treats any of newline
(\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by
a newline (\fBcrlf\fR) as the end of line representation. The end of
@@ -239,26 +247,24 @@ all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses
\fBlf\fR, and for the various flavors of Windows it chooses
\fBcrlf\fR. The default setting for \fB\-translation\fR is \fBauto\fR
for both input and output.
-.TP
-\fBbinary\fR
-.
-No end-of-line translations are performed. This is nearly identical
-to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets
-the end-of-file character to the empty string (which disables it) and
-sets the encoding to \fBbinary\fR (which disables encoding filtering).
-See the description of \fB\-eofchar\fR and \fB\-encoding\fR for more
-information.
-.TP
-\fBcr\fR
-.
+.IP \fBbinary\fR
+Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets
+\fB\-eofchar\fR to the empty string to disable it, and sets \fB\-encoding\fR
+to \fBiso8859-1\fR. With this one setting, a channel is fully configured
+for binary input and output: Each byte read from the channel
+becomes the Unicode character having the same value as that byte, and each
+character written to the channel becomes a single byte in the output. This
+makes it possible to work seamlessly with binary data as long as each character
+in the data remains in the range of 0 to 255 so that there is no distinction
+between binary data and text. For example, A JPEG image can be read from a
+such a channel, manipulated, and then written back to such a channel.
+.IP \fBcr\fR
The end of a line in the underlying file or device is represented by a
single carriage return character. As the input translation mode,
\fBcr\fR mode converts carriage returns to newline characters. As the
output translation mode, \fBcr\fR mode translates newline characters
to carriage returns.
-.TP
-\fBcrlf\fR
-.
+.IP \fBcrlf\fR
The end of a line in the underlying file or device is represented by a
carriage return character followed by a linefeed character. As the
input translation mode, \fBcrlf\fR mode converts
@@ -266,15 +272,13 @@ carriage-return-linefeed sequences to newline characters. As the
output translation mode, \fBcrlf\fR mode translates newline characters
to carriage-return-linefeed sequences. This mode is typically used on
Windows platforms and for network connections.
-.TP
-\fBlf\fR
-.
+.IP \fBlf\fR
The end of a line in the underlying file or device is represented by a
single newline (linefeed) character. In this mode no translations
occur during either input or output. This mode is typically used on
UNIX platforms.
.RE
-.RE
+.\" METHOD: copy
.TP
\fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.
@@ -346,6 +350,7 @@ incoming bytes are valid UTF-8 characters and convert them according
to the output encoding. The behaviour of the system for bytes which
are not valid UTF-8 characters is undefined in this case.
.RE
+.\" METHOD: create
.TP
\fBchan create \fImode cmdPrefix\fR
.
@@ -364,7 +369,7 @@ reading, writing, or both. It has to be a list containing any of the
strings
.QW \fBread\fR
or
-.QW \fBwrite\fR .
+.QW \fBwrite\fR ,
The list must have at least one
element, as a channel you can neither write to nor read from makes no
sense. The handler command for the new channel must support the chosen
@@ -412,12 +417,14 @@ interpreters. While it arranges for the execution of arbitrary Tcl
code the system also makes sure that the code is always executed
within the safe interpreter.
.RE
+.\" METHOD: eof
.TP
\fBchan eof \fIchannelId\fR
.
Test whether the last input operation on the channel called
\fIchannelId\fR failed because the end of the data stream was reached,
returning 1 if end-of-file was reached, and 0 otherwise.
+.\" METHOD: event
.TP
\fBchan event \fIchannelId event\fR ?\fIscript\fR?
.
@@ -444,7 +451,8 @@ while waiting for the data to arrive. If an application invokes
no input data available, the process will block; until the input data
arrives, it will not be able to service other events, so it will
appear to the user to
-.QW "freeze up" .
+.QW "freeze up"
+\&.
With \fBchan event\fR, the
process can tell when data is present and only invoke \fBchan gets\fR
or \fBchan read\fR when they will not block.
@@ -486,6 +494,7 @@ to report the error. In addition, the file event handler is deleted
if it ever returns an error; this is done in order to prevent infinite
loops due to buggy handlers.
.RE
+.\" METHOD: flush
.TP
\fBchan flush \fIchannelId\fR
.
@@ -500,6 +509,7 @@ buffered output has been flushed; the remainder will be flushed in the
background as fast as the underlying file or device is able to absorb
it.
.RE
+.\" METHOD: gets
.TP
\fBchan gets \fIchannelId\fR ?\fIvarName\fR?
.
@@ -521,12 +531,14 @@ distinguished from an empty line using the \fBchan eof\fR command, and
the partial-line-but-non-blocking case can be distinguished with the
\fBchan blocked\fR command.
.RE
+.\" METHOD: names
.TP
\fBchan names\fR ?\fIpattern\fR?
.
Produces a list of all channel names. If \fIpattern\fR is specified,
only those channel names that match it (according to the rules of
\fBstring match\fR) will be returned.
+.\" METHOD: pending
.TP
\fBchan pending \fImode channelId\fR
.
@@ -538,8 +550,10 @@ callback to impose application-specific limits on input line lengths to avoid
a potential denial-of-service attack where a hostile user crafts
an extremely long line that exceeds the available memory to buffer it).
Returns -1 if the channel was not opened for the mode in question.
+.\" METHOD: pipe
.TP
\fBchan pipe\fR
+.
.VS 8.6
Creates a standalone pipe whose read- and write-side channels are
returned as a 2-element list, the first element being the read side and
@@ -560,10 +574,12 @@ differences, but the details of what exactly gets written when are not. This
is most likely to show up when using pipelines for testing; care should be
taken to ensure that deadlocks do not occur and that potential short reads are
allowed for.
-.RE
.VE 8.6
+.RE
+.\" METHOD: pop
.TP
\fBchan pop \fIchannelId\fR
+.
.VS 8.6
Removes the topmost transformation from the channel \fIchannelId\fR, if there
is any. If there are no transformations added to \fIchannelId\fR, this is
@@ -571,6 +587,7 @@ equivalent to \fBchan close\fR of that channel. The result is normally the
empty string, but can be an error in some situations (i.e. where the
underlying system stream is closed and that results in an error).
.VE 8.6
+.\" METHOD: postevent
.TP
\fBchan postevent \fIchannelId eventSpec\fR
.
@@ -607,8 +624,10 @@ where the event is posted from a safe interpreter and listened for by
a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR
executed in the interpreter that set them up.
.RE
+.\" METHOD: push
.TP
\fBchan push \fIchannelId cmdPrefix\fR
+.
.VS 8.6
Adds a new transformation on top of the channel \fIchannelId\fR. The
\fIcmdPrefix\fR argument describes a list of one or more words which represent
@@ -619,6 +638,7 @@ is important to make sure that the transformation is capable of supporting the
channel mode that it is used with or this can make the channel neither
readable nor writable.
.VE 8.6
+.\" METHOD: puts
.TP
\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
.
@@ -658,6 +678,7 @@ used in an event-driven fashion with the \fBchan event\fR command
(do not invoke \fBchan puts\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
.RE
+.\" METHOD: read
.TP
\fBchan read \fIchannelId\fR ?\fInumChars\fR?
.TP
@@ -712,6 +733,7 @@ end-of-file character, see \fBchan configure -eofchar\fR. If there no
end-of-file character has been configured for the channel, then
\fBchan read\fR will block forever.
.RE
+.\" METHOD: seek
.TP
\fBchan seek \fIchannelId offset\fR ?\fIorigin\fR?
.
@@ -720,20 +742,14 @@ the channel named \fIchannelId\fR to be \fIoffset\fR bytes relative to
\fIorigin\fR. \fIOffset\fR must be an integer (which may be negative)
and \fIorigin\fR must be one of the following:
.RS
-.TP 10
-\fBstart\fR
-.
+.IP \fBstart\fR
The new access position will be \fIoffset\fR bytes from the start
of the underlying file or device.
-.TP 10
-\fBcurrent\fR
-.
+.IP \fBcurrent\fR
The new access position will be \fIoffset\fR bytes from the current
access position; a negative \fIoffset\fR moves the access position
backwards in the underlying file or device.
-.TP 10
-\fBend\fR
-.
+.IP \fBend\fR
The new access position will be \fIoffset\fR bytes from the end of the
file or device. A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
@@ -751,6 +767,7 @@ Note that \fIoffset\fR values are byte offsets, not character offsets.
Both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters, unlike \fBchan read\fR.
.RE
+.\" METHOD: tell
.TP
\fBchan tell \fIchannelId\fR
.
@@ -760,6 +777,7 @@ value returned is a byte offset that can be passed to \fBchan seek\fR
in order to set the channel to a particular position. Note that this
value is in terms of bytes, not characters like \fBchan read\fR. The
value returned is -1 for channels that do not support seeking.
+.\" METHOD: truncate
.TP
\fBchan truncate \fIchannelId\fR ?\fIlength\fR?
.
@@ -769,10 +787,18 @@ offset within the underlying data stream if \fIlength\fR is
omitted). The channel is flushed before truncation.
.
.SH EXAMPLES
+.SS "SIMPLE CHANNEL OPERATION EXAMPLES"
+.PP
+Instruct Tcl to always send output to \fBstdout\fR immediately,
+whether or not it is to a terminal:
+.PP
+.CS
+\fBfconfigure\fR stdout -buffering none
+.CE
.PP
-This opens a file using a known encoding (CP1252, a very common encoding
-on Windows), searches for a string, rewrites that part, and truncates the
-file after a further two lines.
+In the following example a file is opened using the encoding CP1252, which is
+common on Windows, searches for a string, rewrites that part, and truncates the
+file two lines later.
.PP
.CS
set f [open somefile.txt r+]
@@ -782,7 +808,7 @@ set offset 0
\fI# Search for string "FOOBAR" in the file\fR
while {[\fBchan gets\fR $f line] >= 0} {
set idx [string first FOOBAR $line]
- if {$idx > -1} {
+ if {$idx >= 0} {
\fI# Found it; rewrite line\fR
\fBchan seek\fR $f [expr {$offset + $idx}]
@@ -803,8 +829,8 @@ while {[\fBchan gets\fR $f line] >= 0} {
\fBchan close\fR $f
.CE
.PP
-A network server that does echoing of its input line-by-line without
-preventing servicing of other connections at the same time.
+A network server that echoes its input line-by-line without
+preventing servicing of other connections at the same time:
.PP
.CS
# This is a very simple logger...
@@ -842,9 +868,11 @@ vwait forever
.SH "SEE ALSO"
close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n),
fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n),
-socket(n), tell(n), refchan(n), transchan(n)
+socket(n), tell(n), refchan(n), transchan(n),
+Tcl_StandardChannels(3)
.SH KEYWORDS
-channel, input, output, events, offset
+blocking, channel, end of file, events, input, non-blocking,
+offset, output, readable, seek, stdio, tell, writable
'\" Local Variables:
'\" mode: nroff
'\" End:
diff --git a/doc/encoding.n b/doc/encoding.n
index e78a8e7..8a0b163 100644
--- a/doc/encoding.n
+++ b/doc/encoding.n
@@ -33,6 +33,7 @@ formats.
.PP
Performs one of several encoding related operations, depending on
\fIoption\fR. The legal \fIoption\fRs are:
+.\" METHOD: convertfrom
.TP
\fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR
.
@@ -42,6 +43,7 @@ characters in \fIdata\fR are treated as binary data where the lower
sequence of bytes is treated as a string in the specified
\fIencoding\fR. If \fIencoding\fR is not specified, the current
system encoding is used.
+.\" METHOD: convertto
.TP
\fBencoding convertto\fR ?\fIencoding\fR? \fIstring\fR
.
@@ -51,6 +53,7 @@ string. Each byte is stored in the lower 8-bits of a Unicode
character (indeed, the resulting string is a binary string as far as
Tcl is concerned, at least initially). If \fIencoding\fR is not
specified, the current system encoding is used.
+.\" METHOD: dirs
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
@@ -63,6 +66,7 @@ search path. It is an error for \fIdirectoryList\fR to not be a valid
list. If, when a search for an encoding data file is happening, an
element in \fIdirectoryList\fR does not refer to a readable,
searchable directory, that element is ignored.
+.\" METHOD: names
.TP
\fBencoding names\fR
.
@@ -73,6 +77,7 @@ The encodings
and
.QW iso8859-1
are guaranteed to be present in the list.
+.\" METHOD: system
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
@@ -91,7 +96,7 @@ The result is the unicode codepoint:
.QW "\eu306F" ,
which is the Hiragana letter HA.
.SH "SEE ALSO"
-Tcl_GetEncoding(3)
+Tcl_GetEncoding(3), fconfigure(n)
.SH KEYWORDS
encoding, unicode
.\" Local Variables:
diff --git a/doc/fileevent.n b/doc/fileevent.n
index 2751040..d9b70a5 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -125,7 +125,7 @@ proc GetData {chan} {
}
}
-fconfigure $chan -blocking 0 -encoding binary
+fconfigure $chan -blocking 0 -translation binary
\fBfileevent\fR $chan readable [list GetData $chan]
.CE
.PP
diff --git a/doc/interp.n b/doc/interp.n
index 1127632..42b1e08 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -605,6 +605,7 @@ built-in commands:
\fBtell\fR \fBtime\fR \fBtrace\fR \fBunset\fR
\fBupdate\fR \fBuplevel\fR \fBupvar\fR \fBvariable\fR
\fBvwait\fR \fBwhile\fR
+\fBzlib\fR
.DE
The following commands are hidden by \fBinterp create\fR when it
creates a safe interpreter:
diff --git a/doc/object.n b/doc/object.n
index df657a9..381b963 100644
--- a/doc/object.n
+++ b/doc/object.n
@@ -64,6 +64,11 @@ The \fBoo::object\fR class supports the following non-exported methods:
This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR,
and then evaluates the resulting script in the namespace that is uniquely
associated with \fIobj\fR, returning the result of the evaluation.
+.RS
+.PP
+Note that object-internal commands such as \fBmy\fR and \fBself\fR can be
+invoked in this context.
+.RE
.TP
\fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR?
.
diff --git a/doc/tm.n b/doc/tm.n
index bdc167a..60d1aae 100644
--- a/doc/tm.n
+++ b/doc/tm.n
@@ -15,7 +15,7 @@ tm \- Facilities for locating and loading of Tcl Modules
\fB::tcl::tm::path add \fR?\fIpath\fR...?
\fB::tcl::tm::path remove \fR?\fIpath\fR...?
\fB::tcl::tm::path list\fR
-\fB::tcl::tm::roots \fR?\fIpath\fR...?
+\fB::tcl::tm::roots \fR\fIpaths\fR
.fi
.BE
.SH DESCRIPTION
@@ -56,10 +56,10 @@ ignores all paths which are not on the list.
Returns a list containing all registered module paths, in the order
that they are searched for modules.
.TP
-\fB::tcl::tm::roots \fR?\fIpath\fR...?
+\fB::tcl::tm::roots \fR\fIpaths\fR
.
Similar to \fBpath add\fR, and layered on top of it. This command
-takes a list of paths, extends each with
+takes a single argument containing a list of paths, extends each with
.QW "\fBtcl\fIX\fB/site-tcl\fR" ,
and
.QW "\fBtcl\fIX\fB/\fIX\fB.\fIy\fR" ,
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index fa59db0..a871f05 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -6,8 +6,8 @@
* This file contains the procedures that convert Tcl Assembly Language (TAL)
* to a sequence of bytecode instructions for the Tcl execution engine.
*
- * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
- * Copyright (c) 2010 by Kevin B. Kenny.
+ * Copyright (c) 2010 Ozgur Dogan Ugurlu.
+ * Copyright (c) 2010 Kevin B. Kenny.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -271,15 +271,14 @@ static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src,
- Tcl_Obj* dest);
+static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
static void FillInJumpOffsets(AssemblyEnv*);
static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_Obj* jumpTable);
static int FindLocalVar(AssemblyEnv* envPtr,
Tcl_Token** tokenPtrPtr);
static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static Tcl_FreeInternalRepProc FreeAssembleCodeInternalRep;
static void FreeAssemblyEnv(AssemblyEnv*);
static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -759,7 +758,7 @@ BBEmitInst1or4(
int
Tcl_AssembleObjCmd(
- ClientData dummy, /* Not used. */
+ void *clientData, /* clientData */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -769,12 +768,12 @@ Tcl_AssembleObjCmd(
* because there needs to be one in place to execute bytecode.
*/
- return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
+ return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, clientData, objc, objv);
}
int
TclNRAssembleObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -912,12 +911,7 @@ CompileAssembleObj(
* Report on what the assembler did.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
return codePtr;
}
@@ -1257,7 +1251,7 @@ AssembleOneLine(
Tcl_Obj* instNameObj; /* Name of the instruction */
int tblIdx; /* Index in TalInstructionTable of the
* instruction */
- enum TalInstType instType; /* Type of the instruction */
+ TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
/* First operand to the instruction */
const char* operand1; /* String rep of the operand */
@@ -1377,7 +1371,7 @@ AssembleOneLine(
if (opnd < 0 || opnd > 3) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operand must be [0..3]", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", (char *)NULL);
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
@@ -1617,7 +1611,7 @@ AssembleOneLine(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operand must be >=2", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", (char *)NULL);
}
goto cleanup;
}
@@ -1983,7 +1977,7 @@ CreateMirrorJumpTable(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"jump table must have an even number of list elements",
-1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2011,7 +2005,7 @@ CreateMirrorJumpTable(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate entry in jump table for \"%s\"",
TclGetString(objv[i])));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
}
@@ -2096,7 +2090,7 @@ GetNextOperand(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"assembly code may not contain substitutions", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2319,7 +2313,7 @@ FindLocalVar(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use this instruction to create a variable"
" in a non-proc context", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", (char *)NULL);
}
return -1;
}
@@ -2354,7 +2348,7 @@ CheckNamespaceQualifiers(
if ((*p == ':') && (p[1] == ':')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"variable \"%s\" is not local", name));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, (char *)NULL);
return TCL_ERROR;
}
}
@@ -2390,7 +2384,7 @@ CheckOneByte(
if (value < 0 || value > 0xFF) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2425,7 +2419,7 @@ CheckSignedOneByte(
if (value > 0x7F || value < -0x80) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2458,7 +2452,7 @@ CheckNonNegative(
if (value < 0) {
result = Tcl_NewStringObj("operand must be nonnegative", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2491,7 +2485,7 @@ CheckStrictlyPositive(
if (value <= 0) {
result = Tcl_NewStringObj("operand must be positive", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2543,7 +2537,7 @@ DefineLabel(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate definition of label \"%s\"", labelName));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -2944,7 +2938,7 @@ ReportUndefinedLabel(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"undefined label \"%s\"", TclGetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
- TclGetString(jumpTarget), NULL);
+ TclGetString(jumpTarget), (char *)NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
}
}
@@ -3229,7 +3223,7 @@ CheckNonThrowingBlock(
"a context where an exception has been "
"caught and not disposed of.",
tclInstructionTable[opcode].name));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
}
return TCL_ERROR;
@@ -3409,7 +3403,7 @@ StackCheckBasicBlock(
*/
Tcl_SetErrorLine(interp, blockPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3432,7 +3426,7 @@ StackCheckBasicBlock(
if (initialStackDepth + blockPtr->minStackDepth < 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
}
@@ -3451,7 +3445,7 @@ StackCheckBasicBlock(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"code pops stack below level of enclosing catch", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
}
@@ -3579,7 +3573,7 @@ StackCheckExit(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"stack is unbalanced on exit from the code (depth=%d)",
depth));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3724,7 +3718,7 @@ ProcessCatchesInBasicBlock(
"execution reaches an instruction in inconsistent "
"exception contexts", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3783,7 +3777,7 @@ ProcessCatchesInBasicBlock(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"endCatch without a corresponding beginCatch", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3859,7 +3853,7 @@ CheckForUnclosedCatches(
"catch still active on exit from assembly code", -1));
Tcl_SetErrorLine(interp,
assemEnvPtr->curr_bb->enclosingCatch->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", (char *)NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c462278..be4e56a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -45,17 +45,17 @@ void *
TclGetCStackPtr(void)
{
#if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address)
- return __builtin_frame_address(0);
+ return __builtin_frame_address(0);
#elif defined(_MSC_VER) && defined(HAVE_INTRIN_H)
- return _AddressOfReturnAddress();
+ return _AddressOfReturnAddress();
#else
- size_t unused = 0;
- /*
- * LLVM recommends using volatile:
- * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31
- */
- size_t *volatile stackLevel = &unused;
- return (void *)stackLevel;
+ size_t unused = 0;
+ /*
+ * LLVM recommends using volatile:
+ * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31
+ */
+ size_t *volatile stackLevel = &unused;
+ return (void *)stackLevel;
#endif
}
@@ -220,9 +220,9 @@ typedef struct {
int flags; /* Various flag bits, as defined below. */
} CmdInfo;
-#define CMD_IS_SAFE 1 /* Whether this command is part of the set of
- * commands present by default in a safe
- * interpreter. */
+#define CMD_IS_SAFE 1 /* Whether this command is part of the set of
+ * commands present by default in a safe
+ * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
* expansion for itself rather than needing the generic layer to take care of
* it for it. Defined in tclInt.h. */
@@ -652,7 +652,7 @@ Tcl_CreateInterp(void)
iPtr->flags |= INTERP_DEBUG_FRAME;
#else
if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
- iPtr->flags |= INTERP_DEBUG_FRAME;
+ iPtr->flags |= INTERP_DEBUG_FRAME;
}
#endif
@@ -820,9 +820,9 @@ Tcl_CreateInterp(void)
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
cmdPtr->flags = 0;
- if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
- cmdPtr->flags |= CMD_COMPILES_EXPANDED;
- }
+ if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
+ cmdPtr->flags |= CMD_COMPILES_EXPANDED;
+ }
cmdPtr->importRefPtr = NULL;
cmdPtr->tracePtr = NULL;
cmdPtr->nreProc = cmdInfoPtr->nreProc;
@@ -881,15 +881,15 @@ Tcl_CreateInterp(void)
/* Adding the bytecode assembler command */
cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
- "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
- TclNRAssembleObjCmd, NULL, NULL);
+ "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
+ TclNRAssembleObjCmd, NULL, NULL);
cmdPtr->compileProc = &TclCompileAssembleCmd;
/* Coroutine monkeybusiness */
Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
NRCoroInjectObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
- CoroTypeObjCmd, NULL, NULL);
+ CoroTypeObjCmd, NULL, NULL);
/* Create an unsupported command for timerate */
Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate",
@@ -901,7 +901,6 @@ Tcl_CreateInterp(void)
Tcl_Export(interp, nsPtr, "*", 1);
}
-
#ifdef USE_DTRACE
/*
* Register the tcl::dtrace command.
@@ -922,7 +921,7 @@ Tcl_CreateInterp(void)
memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
builtinFuncPtr++) {
- strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
+ strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
Tcl_CreateObjCommand(interp, mathFuncName,
builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
@@ -986,11 +985,11 @@ Tcl_CreateInterp(void)
TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
- Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
+ Tcl_NewLongObj((long)sizeof(long)), TCL_GLOBAL_ONLY);
/* TIP #291 */
Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
- Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
+ Tcl_NewLongObj((long)sizeof(void *)), TCL_GLOBAL_ONLY);
/*
* Set up other variables such as tcl_version and tcl_library
@@ -1118,8 +1117,8 @@ Tcl_CallWhenDeleted(
{
Interp *iPtr = (Interp *) interp;
static Tcl_ThreadDataKey assocDataCounterKey;
- int *assocDataCounterPtr =
- (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
+ int *assocDataCounterPtr = (int *)
+ Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
int isNew;
char buffer[32 + TCL_INTEGER_SPACE];
AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData));
@@ -1461,7 +1460,7 @@ DeleteInterpProc(
*/
Tcl_MutexLock(&cancelLock);
- hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
+ hPtr = Tcl_FindHashEntry(&cancelTable, (char *)iPtr);
if (hPtr != NULL) {
CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);
@@ -1662,7 +1661,7 @@ DeleteInterpProc(
if (eclPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(eclPtr->path);
}
- for (i=0; i< eclPtr->nuloc; i++) {
+ for (i=0; i<eclPtr->nuloc; i++) {
ckfree(eclPtr->loc[i].line);
}
@@ -1693,7 +1692,7 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLAPtr);
- ckfree((char *) iPtr->lineLAPtr);
+ ckfree((char *)iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
@@ -1786,7 +1785,7 @@ Tcl_HideCommand(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use namespace qualifiers in hidden command"
" token (rename)", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL);
return TCL_ERROR;
}
@@ -1809,9 +1808,9 @@ Tcl_HideCommand(
if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can only hide global namespace commands (use rename then hide)",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL);
+ "can only hide global namespace commands (use rename then hide)",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL);
return TCL_ERROR;
}
@@ -1835,9 +1834,9 @@ Tcl_HideCommand(
hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "hidden command named \"%s\" already exists",
- hiddenCmdToken));
- Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL);
+ "hidden command named \"%s\" already exists",
+ hiddenCmdToken));
+ Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL);
return TCL_ERROR;
}
@@ -1939,9 +1938,9 @@ Tcl_ExposeCommand(
if (strstr(cmdName, "::") != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "cannot expose to a namespace (use expose to toplevel, then rename)",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL);
+ "cannot expose to a namespace (use expose to toplevel, then rename)",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL);
return TCL_ERROR;
}
@@ -1956,9 +1955,9 @@ Tcl_ExposeCommand(
}
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown hidden command \"%s\"", hiddenCmdToken));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
- hiddenCmdToken, (char *)NULL);
+ "unknown hidden command \"%s\"", hiddenCmdToken));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
+ hiddenCmdToken, (char *)NULL);
return TCL_ERROR;
}
cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
@@ -1995,8 +1994,8 @@ Tcl_ExposeCommand(
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
if (!isNew) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "exposed command \"%s\" already exists", cmdName));
- Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL);
+ "exposed command \"%s\" already exists", cmdName));
+ Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL);
return TCL_ERROR;
}
@@ -2124,26 +2123,26 @@ Tcl_CreateCommand(
*/
while (1) {
- /*
- * Determine where the command should reside. If its name contains
- * namespace qualifiers, we put it in the specified namespace;
+ /*
+ * Determine where the command should reside. If its name contains
+ * namespace qualifiers, we put it in the specified namespace;
* otherwise, we always put it in the global namespace.
- */
+ */
- if (strstr(cmdName, "::") != NULL) {
+ if (strstr(cmdName, "::") != NULL) {
Namespace *dummy1, *dummy2;
TclGetNamespaceForQualName(interp, cmdName, NULL,
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
if ((nsPtr == NULL) || (tail == NULL)) {
- return (Tcl_Command) NULL;
+ return (Tcl_Command) NULL;
}
- } else {
+ } else {
nsPtr = iPtr->globalNsPtr;
tail = cmdName;
- }
+ }
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
+ hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (isNew || deleted) {
/*
@@ -2154,8 +2153,8 @@ Tcl_CreateCommand(
}
/*
- * An existing command conflicts. Try to delete it...
- */
+ * An existing command conflicts. Try to delete it...
+ */
cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
@@ -2293,10 +2292,9 @@ Tcl_CreateObjCommand(
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
- Tcl_CmdDeleteProc *deleteProc
+ Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
-)
{
Interp *iPtr = (Interp *) interp;
Namespace *nsPtr;
@@ -2337,8 +2335,8 @@ Tcl_Command
TclCreateObjCommandInNs(
Tcl_Interp *interp,
const char *cmdName, /* Name of command, without any namespace
- * components. */
- Tcl_Namespace *namesp, /* The namespace to create the command in */
+ * components. */
+ Tcl_Namespace *namesp, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
ClientData clientData, /* Arbitrary value to pass to object
@@ -2373,8 +2371,8 @@ TclCreateObjCommandInNs(
}
/*
- * An existing command conflicts. Try to delete it...
- */
+ * An existing command conflicts. Try to delete it...
+ */
cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
@@ -2392,7 +2390,7 @@ TclCreateObjCommandInNs(
&& cmdPtr->deleteProc == deleteProc) {
cmdPtr->objProc = proc;
cmdPtr->objClientData = clientData;
- return (Tcl_Command) cmdPtr;
+ return (Tcl_Command)cmdPtr;
}
/*
@@ -2408,14 +2406,14 @@ TclCreateObjCommandInNs(
}
/*
- * Make sure namespace doesn't get deallocated.
- */
+ * Make sure namespace doesn't get deallocated.
+ */
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
nsPtr = (Namespace *) TclEnsureNamespace(interp,
- (Tcl_Namespace *) cmdPtr->nsPtr);
+ (Tcl_Namespace *) cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
@@ -2484,6 +2482,7 @@ TclCreateObjCommandInNs(
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
+
dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2535,7 +2534,7 @@ TclInvokeStringCommand(
TclStackAlloc(interp, (objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
+ argv[i] = TclGetString(objv[i]);
}
argv[objc] = 0;
@@ -2670,10 +2669,10 @@ TclRenameCommand(
cmdPtr = (Command *) cmd;
if (cmdPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't %s \"%s\": command doesn't exist",
- ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
+ "can't %s \"%s\": command doesn't exist",
+ ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename",
oldName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL);
return TCL_ERROR;
}
@@ -2703,16 +2702,16 @@ TclRenameCommand(
if ((newNsPtr == NULL) || (newTail == NULL)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't rename to \"%s\": bad command name", newName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
+ "can't rename to \"%s\": bad command name", newName));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
result = TCL_ERROR;
goto done;
}
if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't rename to \"%s\": command already exists", newName));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
- "TARGET_EXISTS", (char *)NULL);
+ "can't rename to \"%s\": command already exists", newName));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
+ "TARGET_EXISTS", (char *)NULL);
result = TCL_ERROR;
goto done;
}
@@ -2789,7 +2788,7 @@ TclRenameCommand(
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
- CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
+ CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
Tcl_DStringFree(&newFullName);
@@ -2897,7 +2896,7 @@ Tcl_SetCommandInfoFromToken(
* The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
*/
- cmdPtr = (Command *) cmd;
+ cmdPtr = (Command *)cmd;
cmdPtr->proc = infoPtr->proc;
cmdPtr->clientData = infoPtr->clientData;
if (infoPtr->objProc == NULL) {
@@ -2992,7 +2991,6 @@ Tcl_GetCommandInfoFromToken(
infoPtr->deleteProc = cmdPtr->deleteProc;
infoPtr->deleteData = cmdPtr->deleteData;
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
-
return 1;
}
@@ -3664,7 +3662,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
- TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
+ TclCheckBadOctal(interp, TclGetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
@@ -3820,8 +3818,8 @@ Tcl_GetMathFuncInfo(
*/
if (cmdPtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown math function \"%s\"", name));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, (char *)NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
@@ -3962,7 +3960,7 @@ TclInterpReady(
* probably because of an infinite loop somewhere.
*/
- if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
+ if (iPtr->numLevels <= iPtr->maxNestingDepth) {
return TCL_OK;
}
@@ -4045,7 +4043,7 @@ Tcl_Canceled(
*/
if (!TclCanceled(iPtr)) {
- return TCL_OK;
+ return TCL_OK;
}
/*
@@ -4066,7 +4064,7 @@ Tcl_Canceled(
*/
if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
- return TCL_OK;
+ return TCL_OK;
}
/*
@@ -4075,34 +4073,34 @@ Tcl_Canceled(
*/
if (flags & TCL_LEAVE_ERR_MSG) {
- const char *id, *message = NULL;
- int length;
+ const char *id, *message = NULL;
+ int length;
- /*
- * Setup errorCode variables so that we can differentiate between
- * being canceled and unwound.
- */
+ /*
+ * Setup errorCode variables so that we can differentiate between
+ * being canceled and unwound.
+ */
- if (iPtr->asyncCancelMsg != NULL) {
- message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
- } else {
- length = 0;
- }
+ if (iPtr->asyncCancelMsg != NULL) {
+ message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
+ } else {
+ length = 0;
+ }
- if (iPtr->flags & TCL_CANCEL_UNWIND) {
- id = "IUNWIND";
- if (length == 0) {
- message = "eval unwound";
- }
- } else {
- id = "ICANCEL";
- if (length == 0) {
- message = "eval canceled";
- }
- }
+ if (iPtr->flags & TCL_CANCEL_UNWIND) {
+ id = "IUNWIND";
+ if (length == 0) {
+ message = "eval unwound";
+ }
+ } else {
+ id = "ICANCEL";
+ if (length == 0) {
+ message = "eval canceled";
+ }
+ }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
- Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
+ Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL);
}
/*
@@ -4164,7 +4162,7 @@ Tcl_CancelEval(
goto done;
}
- hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp);
+ hPtr = Tcl_FindHashEntry(&cancelTable, (char *)interp);
if (hPtr == NULL) {
/*
* No CancelInfo record for this interpreter.
@@ -4183,8 +4181,8 @@ Tcl_CancelEval(
*/
if (resultObjPtr != NULL) {
- result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
- cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length);
+ result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
+ cancelInfo->result = (char *)ckrealloc(cancelInfo->result, cancelInfo->length);
memcpy(cancelInfo->result, result, cancelInfo->length);
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
} else {
@@ -4287,9 +4285,9 @@ TclNREvalObjv(
*/
if (iPtr->deferredCallbacks) {
- iPtr->deferredCallbacks = NULL;
+ iPtr->deferredCallbacks = NULL;
} else {
- TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, (char *)NULL);
+ TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
}
iPtr->numLevels++;
@@ -4330,6 +4328,10 @@ EvalObjvCore(
}
if (TclLimitExceeded(iPtr->limit)) {
+ /* generate error message if not yet already logged at this stage */
+ if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ Tcl_LimitCheck(interp);
+ }
return TCL_ERROR;
}
@@ -4375,13 +4377,13 @@ EvalObjvCore(
assert(cmdPtr == NULL);
if (preCmdPtr) {
/*
- * Caller gave it to us.
- */
+ * Caller gave it to us.
+ */
if (!(preCmdPtr->flags & CMD_DEAD)) {
/*
- * So long as it exists, use it.
- */
+ * So long as it exists, use it.
+ */
cmdPtr = preCmdPtr;
} else if (flags & TCL_EVAL_NORESOLVE) {
@@ -4406,7 +4408,7 @@ EvalObjvCore(
if (enterTracesDone || iPtr->tracePtr
|| (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
Tcl_Obj *commandPtr = TclGetSourceFromFrame(
- flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
+ flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
objc, objv);
Tcl_IncrRefCount(commandPtr);
@@ -4449,7 +4451,7 @@ EvalObjvCore(
cmdPtr->refCount++;
TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
- commandPtr, cmdPtr, objv);
+ commandPtr, cmdPtr, objv);
}
TclNRAddCallback(interp, Dispatch,
@@ -4532,8 +4534,8 @@ TclNRRunCallbacks(
*/
while (TOP_CB(interp) != rootPtr) {
- NRE_callback *callbackPtr = TOP_CB(interp);
- Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
+ NRE_callback *callbackPtr = TOP_CB(interp);
+ Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
TOP_CB(interp) = callbackPtr->nextPtr;
result = procPtr(callbackPtr->data, interp, result);
@@ -4552,12 +4554,12 @@ NRCommand(
iPtr->numLevels--;
- /*
- * If there is a tailcall, schedule it next
- */
+ /*
+ * If there is a tailcall, schedule it next
+ */
if (data[1] && (data[1] != INT2PTR(1))) {
- TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
}
/* OPT ??
@@ -4702,7 +4704,7 @@ TEOV_Error(
*/
listPtr = Tcl_NewListObj(objc, objv);
- cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+ cmdString = TclGetStringFromObj(listPtr, &cmdLen);
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(listPtr);
}
@@ -4766,7 +4768,7 @@ TEOV_NotFound(
newObjv[i] = handlerObjv[i];
Tcl_IncrRefCount(newObjv[i]);
}
- memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);
+ memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc);
/*
* Look up and invoke the handler (by recursive call to this function). If
@@ -4781,9 +4783,9 @@ TEOV_NotFound(
cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
if (cmdPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid command name \"%s\"", TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(objv[0]), (char *)NULL);
+ "invalid command name \"%s\"", TclGetString(objv[0])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
+ TclGetString(objv[0]), (char *)NULL);
/*
* Release any resources we locked and allocated during the handler
@@ -4846,9 +4848,9 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
- int length, traceCode = TCL_OK;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+ int length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ int traceCode = TCL_OK;
+ const char *command = TclGetStringFromObj(commandPtr, &length);
/*
* Call trace functions.
@@ -4900,7 +4902,7 @@ TEOV_RunLeaveTraces(
Command *cmdPtr = (Command *)data[2];
Tcl_Obj **objv = (Tcl_Obj **)data[3];
int length;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+ const char *command = TclGetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
@@ -5271,7 +5273,7 @@ TclEvalEx(
iPtr->cmdFramePtr = eeFramePtr->nextPtr;
for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
objectsUsed < numWords;
- objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
+ objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) {
/*
* TIP #280. Track lines to current word. Save the information
* on a per-word basis, signaling dynamic words as needed.
@@ -5292,7 +5294,7 @@ TclEvalEx(
iPtr->evalFlags |= TCL_EVAL_FILE;
}
- code = TclSubstTokens(interp, tokenPtr+1,
+ code = TclSubstTokens(interp, tokenPtr + 1,
tokenPtr->numComponents, NULL, wordLine,
wordCLNext, outerScript);
@@ -5347,8 +5349,7 @@ TclEvalEx(
int objIdx = objectsNeeded - 1;
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
- objv = objvSpace =
- (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
+ objv = objvSpace = (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int));
}
@@ -5373,7 +5374,7 @@ TclEvalEx(
objectsUsed++;
}
}
- objv += objIdx+1;
+ objv += objIdx + 1;
if (copy != stackObjArray) {
ckfree(copy);
@@ -5647,7 +5648,8 @@ TclArgumentEnter(
CmdFrame *cfPtr)
{
Interp *iPtr = (Interp *) interp;
- int isNew, i;
+ int isNew;
+ int i;
Tcl_HashEntry *hPtr;
CFWord *cfwPtr;
@@ -5718,8 +5720,7 @@ TclArgumentRelease(
for (i = 1; i < objc; i++) {
CFWord *cfwPtr;
- Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *)objv[i]);
if (!hPtr) {
continue;
@@ -5770,8 +5771,7 @@ TclArgumentBCEnter(
ECL *ePtr;
CFWordBC *lastPtr = NULL;
Interp *iPtr = (Interp *) interp;
- Tcl_HashEntry *hePtr =
- Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
+ Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, (char *)codePtr);
if (!hePtr) {
return;
@@ -5793,7 +5793,7 @@ TclArgumentBCEnter(
*/
if (ePtr->nline != objc) {
- return;
+ return;
}
/*
@@ -5811,7 +5811,7 @@ TclArgumentBCEnter(
if (ePtr->line[word] >= 0) {
int isNew;
Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
- objv[word], &isNew);
+ objv[word], &isNew);
CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC));
cfwPtr->framePtr = cfPtr;
@@ -5877,7 +5877,7 @@ TclArgumentBCRelease(
while (cfwPtr) {
CFWordBC *nextPtr = cfwPtr->nextPtr;
Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
+ Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *)cfwPtr->obj);
CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
if (xPtr != cfwPtr) {
@@ -5942,7 +5942,7 @@ TclArgumentGet(
* stack. That is nearest.
*/
- hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
+ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *)obj);
if (hPtr) {
CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
@@ -5956,12 +5956,12 @@ TclArgumentGet(
* that stack.
*/
- hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
+ hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *)obj);
if (hPtr) {
CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
framePtr = cfwPtr->framePtr;
- framePtr->data.tebc.pc = (char *) (((ByteCode *)
+ framePtr->data.tebc.pc = (char *)(((ByteCode *)
framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
*cfPtrPtr = cfwPtr->framePtr;
*wordPtr = cfwPtr->word;
@@ -6006,7 +6006,7 @@ Tcl_Eval(
* string result (some callers may expect it there).
*/
- (void) Tcl_GetStringResult(interp);
+ (void)Tcl_GetStringResult(interp);
return code;
}
@@ -6076,7 +6076,7 @@ int
Tcl_EvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
- Tcl_Obj *objPtr, /* Pointer to object containing commands to
+ Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6089,7 +6089,7 @@ int
TclEvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
- Tcl_Obj *objPtr, /* Pointer to object containing commands to
+ Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6108,7 +6108,7 @@ int
TclNREvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
- Tcl_Obj *objPtr, /* Pointer to object containing commands to
+ Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6193,7 +6193,7 @@ TclNREvalObjEx(
}
TclMarkTailcall(interp);
- TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
+ TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
objPtr, NULL);
ListObjGetElements(listPtr, objc, objv);
@@ -6214,9 +6214,9 @@ TclNREvalObjEx(
* iPtr->varFramePtr in case
* TCL_EVAL_GLOBAL was set. */
- if (TclInterpReady(interp) != TCL_OK) {
- return TCL_ERROR;
- }
+ if (TclInterpReady(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
if (flags & TCL_EVAL_GLOBAL) {
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
@@ -6226,7 +6226,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
objPtr, INT2PTR(allowExceptions), NULL);
- return TclNRExecuteByteCode(interp, codePtr);
+ return TclNRExecuteByteCode(interp, codePtr);
}
{
@@ -6264,7 +6264,7 @@ TclNREvalObjEx(
Tcl_IncrRefCount(objPtr);
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ script = TclGetStringFromObj(objPtr, &numSrcBytes);
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
TclDecrRefCount(objPtr);
@@ -6295,7 +6295,7 @@ TEOEx_ByteCodeCallback(
ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ script = TclGetStringFromObj(objPtr, &numSrcBytes);
Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
}
@@ -6385,7 +6385,7 @@ ProcessUnexpectedResult(
"command returned bad code: %d", returnCode));
}
snprintf(buf, sizeof(buf), "%d", returnCode);
- Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, (char *)NULL);
}
/*
@@ -6703,7 +6703,7 @@ TclObjInvoke(
}
if ((objc < 1) || (objv == NULL)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "illegal argument vector", -1));
+ "illegal argument vector", -1));
return TCL_ERROR;
}
if ((flags & TCL_INVOKE_HIDDEN) == 0) {
@@ -6732,9 +6732,9 @@ TclNRInvoke(
}
if (hPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid hidden command name \"%s\"", cmdName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
- NULL);
+ "invalid hidden command name \"%s\"", cmdName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
+ (char *)NULL);
return TCL_ERROR;
}
cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
@@ -6957,7 +6957,7 @@ Tcl_AddObjErrorInfo(
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_VarEvalVA --
*
@@ -6966,12 +6966,12 @@ Tcl_AddObjErrorInfo(
*
* Results:
* A standard Tcl return result. An error message or other result may be
- * left in the interp's result.
+ * left in the interp.
*
* Side effects:
* Depends on what was done by the command.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
@@ -7013,13 +7013,14 @@ Tcl_VarEvalVA(
*
* Results:
* A standard Tcl return result. An error message or other result may be
- * left in interp->result.
+ * left in the interp.
*
* Side effects:
* Depends on what was done by the command.
*
*----------------------------------------------------------------------
*/
+
int
Tcl_VarEval(
Tcl_Interp *interp,
@@ -7318,7 +7319,7 @@ ExprIsqrtFunc(
if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
return TCL_ERROR;
}
- if (big.sign) {
+ if (mp_isneg(&big)) {
mp_clear(&big);
goto negarg;
}
@@ -7343,7 +7344,7 @@ ExprIsqrtFunc(
}
if (exact) {
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)sqrt(d)));
} else {
mp_int root;
@@ -7356,7 +7357,7 @@ ExprIsqrtFunc(
negarg:
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "square root of negative argument", -1));
+ "square root of negative argument", -1));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range", (char *)NULL);
return TCL_ERROR;
@@ -7577,7 +7578,7 @@ ExprAbsFunc(
if (type == TCL_NUMBER_WIDE) {
Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
- if (w >= (Tcl_WideInt)0) {
+ if (w >= 0) {
goto unChanged;
}
if (w == LLONG_MIN) {
@@ -7590,7 +7591,7 @@ ExprAbsFunc(
#endif
if (type == TCL_NUMBER_BIG) {
- if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
+ if (mp_isneg((const mp_int *)ptr)) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
(void)mp_neg(&big, &big);
@@ -7693,7 +7694,7 @@ ExprEntierFunc(
return TCL_OK;
#ifndef TCL_WIDE_INT_IS_LONG
} else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) {
- Tcl_WideInt result = (Tcl_WideInt) d;
+ Tcl_WideInt result = (Tcl_WideInt)d;
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
@@ -7819,7 +7820,7 @@ ExprRandFunc(
* take into consideration the thread this interp is running in.
*/
- iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U;
+ iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U;
/*
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
@@ -8041,13 +8042,13 @@ MathFuncWrongNumArgs(
int found, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- const char *name = Tcl_GetString(objv[0]);
+ const char *name = TclGetString(objv[0]);
const char *tail = name + strlen(name);
- while (tail > name+1) {
+ while (tail > name + 1) {
tail--;
if (*tail == ':' && tail[-1] == ':') {
- name = tail+1;
+ name = tail + 1;
break;
}
}
@@ -8283,7 +8284,8 @@ Tcl_NRCreateCommand(
* this command is deleted. */
{
Command *cmdPtr = (Command *)
- Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
+ Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
@@ -8300,7 +8302,8 @@ TclNRCreateCommandInNs(
Tcl_CmdDeleteProc *deleteProc)
{
Command *cmdPtr = (Command *)
- TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+ TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
@@ -8364,14 +8367,14 @@ Tcl_NRCmdSwap(
* will execute. There are functions whose purpose is to help define the
* precise spot:
* TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
- * should continue right here
+ * should continue right here
* TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution
- * should continue after the CURRENT command is fully returned ("skip
- * the next command: we are redirecting to it, tailcalls should run
- * after WE return")
+ * should continue after the CURRENT command is fully returned ("skip
+ * the next command: we are redirecting to it, tailcalls should run
+ * after WE return")
* TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
- * this point. This is special for OO, as some of the oo constructs
- * that behave like commands may not push an NRCommand callback.
+ * this point. This is special for OO, as some of the oo constructs
+ * that behave like commands may not push an NRCommand callback.
*/
void
@@ -8382,8 +8385,8 @@ TclMarkTailcall(
if (iPtr->deferredCallbacks == NULL) {
TclNRAddCallback(interp, NRCommand, NULL, NULL,
- NULL, NULL);
- iPtr->deferredCallbacks = TOP_CB(interp);
+ NULL, NULL);
+ iPtr->deferredCallbacks = TOP_CB(interp);
}
}
@@ -8430,12 +8433,12 @@ TclSetTailcall(
NRE_callback *runPtr;
for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
- if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
- break;
- }
+ if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
+ break;
+ }
}
if (!runPtr) {
- Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
+ Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
}
runPtr->data[1] = listPtr;
}
@@ -8471,9 +8474,9 @@ TclNRTailcallObjCmd(
}
if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "tailcall can only be called from a proc, lambda or method", -1));
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "tailcall can only be called from a proc, lambda or method", -1));
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL);
return TCL_ERROR;
}
@@ -8483,8 +8486,8 @@ TclNRTailcallObjCmd(
*/
if (iPtr->varFramePtr->tailcallPtr) {
- Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
- iPtr->varFramePtr->tailcallPtr = NULL;
+ Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
+ iPtr->varFramePtr->tailcallPtr = NULL;
}
/*
@@ -8494,19 +8497,19 @@ TclNRTailcallObjCmd(
*/
if (objc > 1) {
- Tcl_Obj *listPtr, *nsObjPtr;
- Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+ Tcl_Obj *listPtr, *nsObjPtr;
+ Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- /*
- * The tailcall data is in a Tcl list: the first element is the
- * namespace, the rest the command to be tailcalled.
- */
+ /*
+ * The tailcall data is in a Tcl list: the first element is the
+ * namespace, the rest the command to be tailcalled.
+ */
- nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
- listPtr = Tcl_NewListObj(objc, objv);
+ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+ listPtr = Tcl_NewListObj(objc, objv);
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
- iPtr->varFramePtr->tailcallPtr = listPtr;
+ iPtr->varFramePtr->tailcallPtr = listPtr;
}
return TCL_RETURN;
}
@@ -8541,13 +8544,13 @@ TclNRTailcallEval(
}
if (result != TCL_OK) {
- /*
- * Tailcall execution was preempted, eg by an intervening catch or by
- * a now-gone namespace: cleanup and return.
- */
+ /*
+ * Tailcall execution was preempted, eg by an intervening catch or by
+ * a now-gone namespace: cleanup and return.
+ */
Tcl_DecrRefCount(listPtr);
- return result;
+ return result;
}
/*
@@ -8557,7 +8560,7 @@ TclNRTailcallEval(
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
iPtr->lookupNsPtr = (Namespace *) nsPtr;
- return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
+ return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL);
}
int
@@ -8634,7 +8637,7 @@ TclNRYieldObjCmd(
if (!corPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "yield can only be called in a coroutine", -1));
+ "yield can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL);
return TCL_ERROR;
}
@@ -8645,7 +8648,7 @@ TclNRYieldObjCmd(
NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- clientData, NULL, NULL);
+ clientData, NULL, NULL);
return TCL_OK;
}
@@ -8667,17 +8670,17 @@ TclNRYieldToObjCmd(
if (!corPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "yieldto can only be called in a coroutine", -1));
+ "yieldto can only be called in a coroutine", -1));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL);
return TCL_ERROR;
}
if (((Namespace *) nsPtr)->flags & NS_DYING) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
"yieldto called in deleted namespace", -1));
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
(char *)NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
/*
@@ -8840,14 +8843,14 @@ NRCoroutineExitCallback(
*
* TclNRCoroutineActivateCallback --
*
- * This is the workhorse for coroutines: it implements both yield and
- * resume.
+ * This is the workhorse for coroutines: it implements both yield and
+ * resume.
*
- * It is important that both be implemented in the same callback: the
- * detection of the impossibility to suspend due to a busy C-stack relies
- * on the precise position of a local variable in the stack. We do not
- * want the compiler to play tricks on us, either by moving things around
- * or inlining.
+ * It is important that both be implemented in the same callback: the
+ * detection of the impossibility to suspend due to a busy C-stack relies
+ * on the precise position of a local variable in the stack. We do not
+ * want the compiler to play tricks on us, either by moving things around
+ * or inlining.
*
*----------------------------------------------------------------------
*/
@@ -8864,57 +8867,57 @@ TclNRCoroutineActivateCallback(
void *stackLevel = TclGetCStackPtr();
if (!corPtr->stackLevel) {
- /*
- * -- Coroutine is suspended --
- * Push the callback to restore the caller's context on yield or
- * return.
- */
-
- TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
- NULL, NULL, NULL);
-
- /*
- * Record the stackLevel at which the resume is happening, then swap
- * the interp's environment to make it suitable to run this coroutine.
- */
-
- corPtr->stackLevel = stackLevel;
- numLevels = corPtr->auxNumLevels;
- corPtr->auxNumLevels = iPtr->numLevels;
-
- SAVE_CONTEXT(corPtr->caller);
- corPtr->callerEEPtr = iPtr->execEnvPtr;
- RESTORE_CONTEXT(corPtr->running);
- iPtr->execEnvPtr = corPtr->eePtr;
- iPtr->numLevels += numLevels;
+ /*
+ * -- Coroutine is suspended --
+ * Push the callback to restore the caller's context on yield or
+ * return.
+ */
+
+ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
+ NULL, NULL, NULL);
+
+ /*
+ * Record the stackLevel at which the resume is happening, then swap
+ * the interp's environment to make it suitable to run this coroutine.
+ */
+
+ corPtr->stackLevel = stackLevel;
+ numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = iPtr->numLevels;
+
+ SAVE_CONTEXT(corPtr->caller);
+ corPtr->callerEEPtr = iPtr->execEnvPtr;
+ RESTORE_CONTEXT(corPtr->running);
+ iPtr->execEnvPtr = corPtr->eePtr;
+ iPtr->numLevels += numLevels;
} else {
- /*
- * Coroutine is active: yield
- */
+ /*
+ * Coroutine is active: yield
+ */
- if (corPtr->stackLevel != stackLevel) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "cannot yield: C stack busy", -1));
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
- (char *)NULL);
- return TCL_ERROR;
- }
+ if (corPtr->stackLevel != stackLevel) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot yield: C stack busy", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
- if (type == CORO_ACTIVATE_YIELD) {
- corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
- } else if (type == CORO_ACTIVATE_YIELDM) {
- corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
- } else {
- Tcl_Panic("Yield received an option which is not implemented");
- }
+ if (type == CORO_ACTIVATE_YIELD) {
+ corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
+ } else if (type == CORO_ACTIVATE_YIELDM) {
+ corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
+ } else {
+ Tcl_Panic("Yield received an option which is not implemented");
+ }
- corPtr->stackLevel = NULL;
+ corPtr->stackLevel = NULL;
- numLevels = iPtr->numLevels;
- iPtr->numLevels = corPtr->auxNumLevels;
- corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
+ numLevels = iPtr->numLevels;
+ iPtr->numLevels = corPtr->auxNumLevels;
+ corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
- iPtr->execEnvPtr = corPtr->callerEEPtr;
+ iPtr->execEnvPtr = corPtr->callerEEPtr;
}
return TCL_OK;
@@ -8925,7 +8928,7 @@ TclNRCoroutineActivateCallback(
*
* TclNREvalList --
*
- * Callback to invoke command as list, used in order to delayed
+ * Callback to invoke command as list, used in order to delayed
* processing of canonical list command in sane environment.
*
*----------------------------------------------------------------------
@@ -8954,7 +8957,7 @@ TclNREvalList(
*
* CoroTypeObjCmd --
*
- * Implementation of [::tcl::unsupported::corotype] command.
+ * Implementation of [::tcl::unsupported::corotype] command.
*
*----------------------------------------------------------------------
*/
@@ -8980,11 +8983,11 @@ CoroTypeObjCmd(
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can only get coroutine type of a coroutine", -1));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
- TclGetString(objv[1]), NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only get coroutine type of a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+ TclGetString(objv[1]), (char *)NULL);
+ return TCL_ERROR;
}
/*
@@ -8994,8 +8997,8 @@ CoroTypeObjCmd(
corPtr = (CoroutineData *)cmdPtr->objClientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
- return TCL_OK;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
+ return TCL_OK;
}
/*
@@ -9005,16 +9008,16 @@ CoroTypeObjCmd(
switch (corPtr->nargs) {
case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
- return TCL_OK;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
+ return TCL_OK;
case COROUTINE_ARGUMENTS_ARBITRARY:
- Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
- return TCL_OK;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
+ return TCL_OK;
default:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unknown coroutine type", -1));
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown coroutine type", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL);
+ return TCL_ERROR;
}
}
@@ -9051,19 +9054,19 @@ NRCoroInjectObjCmd(
cmdPtr = (Command *)Tcl_GetCommandFromObj(interp, objv[1]);
if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can only inject a command into a coroutine", -1));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
- TclGetString(objv[1]), (char *)NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+ TclGetString(objv[1]), (char *)NULL);
+ return TCL_ERROR;
}
corPtr = (CoroutineData *)cmdPtr->objClientData;
if (!COR_IS_SUSPENDED(corPtr)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can only inject a command into a suspended coroutine", -1));
- Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL);
- return TCL_ERROR;
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only inject a command into a suspended coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL);
+ return TCL_ERROR;
}
/*
@@ -9072,8 +9075,8 @@ NRCoroInjectObjCmd(
*/
iPtr->execEnvPtr = corPtr->eePtr;
- TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
- NULL, NULL, NULL);
+ TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2),
+ NULL, NULL, NULL);
iPtr->execEnvPtr = savedEEPtr;
return TCL_OK;
@@ -9090,8 +9093,8 @@ TclNRInterpCoroutine(
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "coroutine \"%s\" is already running",
- Tcl_GetString(objv[0])));
+ "coroutine \"%s\" is already running",
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL);
return TCL_ERROR;
}
@@ -9104,31 +9107,31 @@ TclNRInterpCoroutine(
switch (corPtr->nargs) {
case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
- if (objc == 2) {
- Tcl_SetObjResult(interp, objv[1]);
- } else if (objc > 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
- return TCL_ERROR;
- }
- break;
+ if (objc == 2) {
+ Tcl_SetObjResult(interp, objv[1]);
+ } else if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
+ return TCL_ERROR;
+ }
+ break;
default:
- if (corPtr->nargs != objc-1) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("wrong coro nargs; how did we get here? "
- "not implemented!", -1));
- Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
- return TCL_ERROR;
- }
- /* fallthrough */
+ if (corPtr->nargs + 1 != objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("wrong coro nargs; how did we get here? "
+ "not implemented!", -1));
+ Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
+ return TCL_ERROR;
+ }
+ /* fallthrough */
case COROUTINE_ARGUMENTS_ARBITRARY:
- if (objc > 1) {
- Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
- }
- break;
+ if (objc > 1) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1));
+ }
+ break;
}
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- NULL, NULL, NULL);
+ NULL, NULL, NULL);
return TCL_OK;
}
@@ -9137,8 +9140,8 @@ TclNRInterpCoroutine(
*
* TclNRCoroutineObjCmd --
*
- * Implementation of [coroutine] command; see documentation for
- * description of what this does.
+ * Implementation of [coroutine] command; see documentation for
+ * description of what this does.
*
*----------------------------------------------------------------------
*/
@@ -9168,16 +9171,16 @@ TclNRCoroutineObjCmd(
if (nsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't create procedure \"%s\": unknown namespace",
- procName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL);
+ "can't create procedure \"%s\": unknown namespace",
+ procName));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL);
return TCL_ERROR;
}
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't create procedure \"%s\": bad procedure name",
- procName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL);
+ "can't create procedure \"%s\": bad procedure name",
+ procName));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL);
return TCL_ERROR;
}
@@ -9268,7 +9271,7 @@ TclNRCoroutineObjCmd(
*/
TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
- NULL, NULL, NULL);
+ NULL, NULL, NULL);
return TCL_OK;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 9836d02..cbcb4a1 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -4,8 +4,8 @@
* This file contains the implementation of the "binary" Tcl built-in
* command and the Tcl binary data object.
*
- * Copyright (c) 1997 by Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -185,7 +185,7 @@ typedef struct ByteArray {
* of the following "bytes" field. */
unsigned char bytes[TCLFLEXARRAY];
/* The array of bytes. The actual size of this
- * field depends on the 'allocated' field
+ * field is stored in the 'allocated' field
* above. */
} ByteArray;
@@ -206,7 +206,7 @@ typedef struct ByteArray {
* from the given array of bytes.
*
* Results:
- * The newly create object is returned. This object will have no initial
+ * The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
@@ -221,16 +221,16 @@ Tcl_Obj *
Tcl_NewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
- int length) /* Length of the array of bytes, which must be
- * >= 0. */
+ int numBytes) /* Number of bytes in the array,
+ * must be >= 0. */
{
#ifdef TCL_MEM_DEBUG
- return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
+ return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *objPtr;
TclNewObj(objPtr);
- Tcl_SetByteArrayObj(objPtr, bytes, length);
+ Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
#endif /* TCL_MEM_DEBUG */
}
@@ -251,7 +251,7 @@ Tcl_NewByteArrayObj(
* result of calling Tcl_NewByteArrayObj.
*
* Results:
- * The newly create object is returned. This object will have no initial
+ * The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
@@ -264,8 +264,8 @@ Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
- int length, /* Length of the array of bytes, which must be
- * >= 0. */
+ int numBytes, /* Number of bytes in the array,
+ * must be >= 0. */
const char *file, /* The name of the source file calling this
* procedure; used for debugging. */
int line) /* Line number in the source file; used for
@@ -275,10 +275,10 @@ Tcl_DbNewByteArrayObj(
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
- Tcl_SetByteArrayObj(objPtr, bytes, length);
+ Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
#else /* if not TCL_MEM_DEBUG */
- return Tcl_NewByteArrayObj(bytes, length);
+ return Tcl_NewByteArrayObj(bytes, numBytes);
#endif /* TCL_MEM_DEBUG */
}
@@ -304,9 +304,9 @@ void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
- * May be NULL even if length > 0. */
- int length) /* Length of the array of bytes, which must
- * be >= 0. */
+ * May be NULL even if numBytes > 0. */
+ int numBytes) /* Number of bytes in the array,
+ * must be >= 0 */
{
ByteArray *byteArrayPtr;
@@ -316,15 +316,15 @@ Tcl_SetByteArrayObj(
TclFreeIntRep(objPtr);
TclInvalidateStringRep(objPtr);
- if (length < 0) {
- length = 0;
+ if (numBytes < 0) {
+ numBytes = 0;
}
- byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
- byteArrayPtr->used = length;
- byteArrayPtr->allocated = length;
+ byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(numBytes));
+ byteArrayPtr->used = numBytes;
+ byteArrayPtr->allocated = numBytes;
- if ((bytes != NULL) && (length > 0)) {
- memcpy(byteArrayPtr->bytes, bytes, length);
+ if ((bytes != NULL) && (numBytes > 0)) {
+ memcpy(byteArrayPtr->bytes, bytes, numBytes);
}
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
@@ -351,8 +351,8 @@ Tcl_SetByteArrayObj(
unsigned char *
Tcl_GetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
- int *lengthPtr) /* If non-NULL, filled with length of the
- * array of bytes in the ByteArray object. */
+ int *numBytesPtr) /* If non-NULL, write the number of bytes
+ * in the array here */
{
ByteArray *baPtr;
@@ -361,10 +361,10 @@ Tcl_GetByteArrayFromObj(
}
baPtr = GET_BYTEARRAY(objPtr);
- if (lengthPtr != NULL) {
- *lengthPtr = baPtr->used;
+ if (numBytesPtr != NULL) {
+ *numBytesPtr = baPtr->used;
}
- return (unsigned char *) baPtr->bytes;
+ return (unsigned char *)baPtr->bytes;
}
/*
@@ -392,7 +392,7 @@ Tcl_GetByteArrayFromObj(
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
- int length) /* New length for internal byte array. */
+ int numBytes) /* Number of bytes in resized array */
{
ByteArray *byteArrayPtr;
@@ -402,17 +402,17 @@ Tcl_SetByteArrayLength(
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
}
- if (length < 0) {
- length = 0;
+ if (numBytes < 0) {
+ numBytes = 0;
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
- if ((unsigned int)length > byteArrayPtr->allocated) {
- byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
- byteArrayPtr->allocated = length;
+ if ((unsigned int)numBytes > byteArrayPtr->allocated) {
+ byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(numBytes));
+ byteArrayPtr->allocated = numBytes;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
TclInvalidateStringRep(objPtr);
- byteArrayPtr->used = length;
+ byteArrayPtr->used = numBytes;
return byteArrayPtr->bytes;
}
@@ -865,7 +865,6 @@ BinaryFormatCmd(
&listv) != TCL_OK) {
return TCL_ERROR;
}
- arg++;
if (count == BINARY_ALL) {
count = listc;
@@ -875,6 +874,7 @@ BinaryFormatCmd(
-1));
return TCL_ERROR;
}
+ arg++;
}
offset += count*size;
break;
@@ -1260,9 +1260,8 @@ BinaryScanCmd(
unsigned char *buffer; /* Start of result buffer. */
const char *errorString;
const char *str;
- int offset, size, length;
+ int offset, size, length, i;
- int i;
Tcl_Obj *valuePtr, *elementPtr;
Tcl_HashTable numberCacheHash;
Tcl_HashTable *numberCachePtr;
@@ -1489,7 +1488,7 @@ BinaryScanCmd(
goto badIndex;
}
if (count == BINARY_NOCOUNT) {
- if ((length - offset) < size) {
+ if (length < (size + offset)) {
goto done;
}
valuePtr = ScanNumber(buffer+offset, cmd, flags,
@@ -2198,7 +2197,7 @@ ScanNumber(
bigObj = Tcl_NewBignumObj(&big);
return bigObj;
}
- return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+ return Tcl_NewWideIntObj((Tcl_WideInt)uwvalue);
/*
* Do not cache double values; they are already too large to use as
@@ -2359,7 +2358,8 @@ BinaryDecodeHex(
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend;
unsigned char *begin, *cursor, c;
- int i, index, value, size, pure, count = 0, cut = 0, strict = 0;
+ int i, index, value, pure, strict = 0;
+ int size, cut = 0, count = 0;
Tcl_UniChar ch = 0;
enum {OPT_STRICT };
static const char *const optStrings[] = { "-strict", NULL };
@@ -2437,7 +2437,7 @@ BinaryDecodeHex(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid hexadecimal digit \"%c\" at position %d",
ch, (int) (data - datastart - 1)));
- Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
return TCL_ERROR;
}
@@ -2482,7 +2482,8 @@ BinaryEncode64(
int maxlen = 0;
const char *wrapchar = "\n";
int wrapcharlen = 1;
- int offset, i, index, size, outindex = 0, count = 0, purewrap = 1;
+ int index, purewrap = 1;
+ int i, offset, size, outindex = 0, count = 0;
enum { OPT_MAXLEN, OPT_WRAPCHAR };
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
@@ -2505,7 +2506,7 @@ BinaryEncode64(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"line length out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
- "LINE_LENGTH", NULL);
+ "LINE_LENGTH", (char *)NULL);
return TCL_ERROR;
}
break;
@@ -2515,7 +2516,7 @@ BinaryEncode64(
wrapchar = (const char *) Tcl_GetByteArrayFromObj(
objv[i + 1], &wrapcharlen);
} else {
- wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
+ wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
}
break;
}
@@ -2602,12 +2603,12 @@ BinaryEncodeUu(
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
- int offset, count, rawLength, i, j, bits, index;
+ int i, bits, index;
unsigned int n;
int lineLength = 61;
const unsigned char SingleNewline[] = { UCHAR('\n') };
const unsigned char *wrapchar = SingleNewline;
- int wrapcharlen = sizeof(SingleNewline);
+ int j, rawLength, offset, count, wrapcharlen = sizeof(SingleNewline);
enum { OPT_MAXLEN, OPT_WRAPCHAR };
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
@@ -2631,7 +2632,7 @@ BinaryEncodeUu(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"line length out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
- "LINE_LENGTH", NULL);
+ "LINE_LENGTH", (char *)NULL);
return TCL_ERROR;
}
lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
@@ -2660,7 +2661,7 @@ BinaryEncodeUu(
"invalid wrapchar; will defeat decoding",
-1));
Tcl_SetErrorCode(interp, "TCL", "BINARY",
- "ENCODE", "WRAPCHAR", NULL);
+ "ENCODE", "WRAPCHAR", (char *)NULL);
return TCL_ERROR;
}
}
@@ -2752,7 +2753,8 @@ BinaryDecodeUu(
Tcl_Obj *resultObj = NULL;
unsigned char *data, *datastart, *dataend;
unsigned char *begin, *cursor;
- int i, index, size, pure, count = 0, strict = 0, lineLen;
+ int i, index, pure, strict = 0, lineLen;
+ int size, count = 0;
unsigned char c;
Tcl_UniChar ch = 0;
enum { OPT_STRICT };
@@ -2878,7 +2880,7 @@ BinaryDecodeUu(
shortUu:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
- Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", (char *)NULL);
TclDecrRefCount(resultObj);
return TCL_ERROR;
@@ -2891,7 +2893,7 @@ BinaryDecodeUu(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid uuencode character \"%c\" at position %d",
ch, (int) (data - datastart - 1)));
- Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
TclDecrRefCount(resultObj);
return TCL_ERROR;
}
@@ -2924,7 +2926,8 @@ BinaryDecode64(
unsigned char *begin = NULL;
unsigned char *cursor = NULL;
int pure, strict = 0;
- int i, index, size, cut = 0, count = 0;
+ int i, index, cut = 0;
+ int size, count = 0;
Tcl_UniChar ch = 0;
enum { OPT_STRICT };
static const char *const optStrings[] = { "-strict", NULL };
@@ -3063,7 +3066,7 @@ BinaryDecode64(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid base64 character \"%c\" at position %d", ch,
(int) (data - datastart - 1)));
- Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", (char *)NULL);
TclDecrRefCount(resultObj);
return TCL_ERROR;
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7d54edd..5d39de4 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -29,7 +29,7 @@
#define JULIAN_DAY_POSIX_EPOCH 2440588
#define SECONDS_PER_DAY 86400
-#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
+#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt)JULIAN_DAY_POSIX_EPOCH) \
* SECONDS_PER_DAY)
#define FOUR_CENTURIES 146097 /* days */
#define JDAY_1_JAN_1_CE_JULIAN 1721424
@@ -912,7 +912,7 @@ ConvertLocalToUTCUsingC(
TzsetIfNecessary();
Tcl_MutexLock(&clockMutex);
errno = 0;
- fields->seconds = (Tcl_WideInt) mktime(&timeVal);
+ fields->seconds = (Tcl_WideInt)mktime(&timeVal);
localErrno = (fields->seconds == -1) ? errno : 0;
Tcl_MutexUnlock(&clockMutex);
@@ -1061,10 +1061,10 @@ ConvertUTCToLocalUsingC(
*/
tock = (time_t) fields->seconds;
- if ((Tcl_WideInt) tock != fields->seconds) {
+ if ((Tcl_WideInt)tock != fields->seconds) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"number too large to represent as a Posix time", -1));
- Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL);
return TCL_ERROR;
}
TzsetIfNecessary();
@@ -1073,7 +1073,7 @@ ConvertUTCToLocalUsingC(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"localtime failed (clock value may be too "
"large/small to represent)", -1));
- Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL);
return TCL_ERROR;
}
@@ -1091,7 +1091,7 @@ ConvertUTCToLocalUsingC(
* Convert that value to seconds.
*/
- fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24
+ fields->localSeconds = (((fields->julianDay * (Tcl_WideInt)24
+ timeVal->tm_hour) * 60 + timeVal->tm_min) * 60
+ timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH;
@@ -1783,13 +1783,13 @@ ClockClicksObjCmd(
switch (index) {
case CLICKS_MILLIS:
Tcl_GetTime(&now);
- clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
+ clicks = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000;
break;
case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
clicks = TclpGetWideClicks();
#else
- clicks = (Tcl_WideInt) TclpGetClicks();
+ clicks = TclpGetClicks();
#endif
break;
case CLICKS_MICROS:
@@ -1834,8 +1834,8 @@ ClockMillisecondsObjCmd(
return TCL_ERROR;
}
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
- now.sec * 1000 + now.usec / 1000));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ (Tcl_WideInt)now.sec * 1000 + now.usec / 1000));
return TCL_OK;
}
@@ -1925,7 +1925,7 @@ ClockParseformatargsObjCmd(
Tcl_WrongNumArgs(interp, 0, objv,
"clock format clockval ?-format string? "
"?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
- Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL);
return TCL_ERROR;
}
@@ -1940,7 +1940,7 @@ ClockParseformatargsObjCmd(
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&optionIndex) != TCL_OK) {
Tcl_SetErrorCode(interp, "CLOCK", "badOption",
- Tcl_GetString(objv[i]), NULL);
+ TclGetString(objv[i]), (char *)NULL);
return TCL_ERROR;
}
switch (optionIndex) {
@@ -1972,7 +1972,7 @@ ClockParseformatargsObjCmd(
if ((saw & (1 << CLOCK_FORMAT_GMT))
&& (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
- Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
+ Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL);
return TCL_ERROR;
}
if (gmtFlag) {
@@ -2024,7 +2024,7 @@ ClockSecondsObjCmd(
return TCL_ERROR;
}
Tcl_GetTime(&now);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(now.sec));
return TCL_OK;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 51d90ed..adbe9a6 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1622,7 +1622,7 @@ FileAttrSizeCmd(
if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(buf.st_size));
return TCL_OK;
}
@@ -2063,7 +2063,7 @@ PathFilesystemCmd(
if (fsInfo == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
- TclGetString(objv[1]), NULL);
+ TclGetString(objv[1]), (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, fsInfo);
@@ -2213,7 +2213,7 @@ PathSplitCmd(
"could not read \"%s\": no such file or directory",
TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, res);
@@ -2315,7 +2315,7 @@ FilesystemSeparatorCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unrecognised path", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
- TclGetString(objv[1]), NULL);
+ TclGetString(objv[1]), (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, separatorObj);
@@ -2681,7 +2681,7 @@ TclNRForIterCallback(
Tcl_ResetResult(interp);
TclNewObj(boolObj);
TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
- NULL);
+ (char *)NULL);
return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
case TCL_BREAK:
result = TCL_OK;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index aef0399..b4f821f 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1160,9 +1160,9 @@ InfoFrameCmd(
}
corPtr = corPtr->callerEEPtr->corPtr;
}
- topLevel += (*cmdFramePtrPtr)->level;
+ topLevel += *cmdFramePtrPtr ? (*cmdFramePtrPtr)->level : 1;
- if (topLevel != iPtr->cmdFramePtr->level) {
+ if (iPtr->cmdFramePtr && topLevel != iPtr->cmdFramePtr->level) {
framePtr = iPtr->cmdFramePtr;
while (framePtr) {
framePtr->level = topLevel--;
@@ -1279,9 +1279,14 @@ TclInfoFrame(
static const char *const typeString[TCL_LOCATION_LAST] = {
"eval", "eval", "eval", "precompiled", "source", "proc"
};
- Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+ Proc *procPtr = NULL;
int needsFree = -1;
+ if (!framePtr) {
+ goto precompiled;
+ }
+ procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+
/*
* Pull the information and construct the dictionary to return, as list.
* Regarding use of the CmdFrame fields see tclInt.h, and its definition.
@@ -1309,11 +1314,11 @@ TclInfoFrame(
break;
case TCL_LOCATION_PREBC:
+ precompiled:
/*
* Precompiled. Result contains the type as signal, nothing else.
*/
-
- ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
+ ADD_PAIR("type", Tcl_NewStringObj(typeString[TCL_LOCATION_PREBC], -1));
break;
case TCL_LOCATION_BC: {
@@ -1428,7 +1433,7 @@ TclInfoFrame(
* _visible_ CallFrame.
*/
- if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
+ if (framePtr && (framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
CallFrame *current = framePtr->framePtr;
CallFrame *top = iPtr->varFramePtr;
CallFrame *idx;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 41782b0..cfccd5e 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1863,7 +1863,7 @@ StringMapCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": must be -nocase", string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
- string, NULL);
+ string, (char *)NULL);
return TCL_ERROR;
}
}
@@ -5115,12 +5115,10 @@ TryPostBody(
*/
if (code == TCL_ERROR) {
- Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
+ Tcl_Obj *errcode, **bits1, **bits2;
int len1, len2, j;
- TclNewLiteralStringObj(errorCodeName, "-errorcode");
- Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
- Tcl_DecrRefCount(errorCodeName);
+ TclDictGet(NULL, options, "-errorcode", &errcode);
TclListObjGetElements(NULL, info[2], &len1, &bits1);
if (TclListObjGetElements(NULL, errcode, &len2,
&bits2) != TCL_OK) {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index bafcb13..a422072 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2293,8 +2293,7 @@ DisassembleDictUpdateInfo(
Tcl_ListObjAppendElement(NULL, variables,
Tcl_NewIntObj(duiPtr->varIndices[i]));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
- variables);
+ TclDictPut(NULL, dictObj, "variables", variables);
}
/*
@@ -3035,14 +3034,13 @@ DisassembleForeachInfo(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewIntObj(infoPtr->firstValueTemp + i));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
+ TclDictPut(NULL, dictObj, "data", objPtr);
/*
* Loop counter.
*/
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
- Tcl_NewIntObj(infoPtr->loopCtTemp));
+ TclDictPut(NULL, dictObj, "loop", Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
@@ -3058,7 +3056,7 @@ DisassembleForeachInfo(
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+ TclDictPut(NULL, dictObj, "assign", objPtr);
}
static void
@@ -3077,8 +3075,7 @@ DisassembleNewForeachInfo(
* Jump offset.
*/
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
- Tcl_NewIntObj(infoPtr->loopCtTemp));
+ TclDictPut(NULL, dictObj, "jumpOffset", Tcl_NewIntObj(infoPtr->loopCtTemp));
/*
* Assignment targets.
@@ -3094,7 +3091,7 @@ DisassembleNewForeachInfo(
}
Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
+ TclDictPut(NULL, dictObj, "assign", objPtr);
}
/*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index a7db705..4f2ee70 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2574,10 +2574,9 @@ DisassembleJumptableInfo(
for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
offset = PTR2INT(Tcl_GetHashValue(hPtr));
- Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
- Tcl_NewIntObj(offset));
+ TclDictPut(NULL, mapping, keyPtr, Tcl_NewIntObj(offset));
}
- Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
+ TclDictPut(NULL, dictObj, "mapping", mapping);
}
/*
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 989ca79..313c51f 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1439,7 +1439,7 @@ ParseExpr(
parsePtr->string, (numBytes < limit) ? "" : "..."));
if (errCode) {
Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
- subErrCode, NULL);
+ subErrCode, (char *)NULL);
}
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 76e0efb..3813077 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -872,12 +872,7 @@ TclSetByteCodeFromAny(
if (result == TCL_OK) {
TclInitByteCodeObj(objPtr, &compEnv);
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
TclFreeCompileEnv(&compEnv);
@@ -1322,12 +1317,7 @@ CompileSubstObj(
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
return codePtr;
}
@@ -2137,7 +2127,7 @@ TclCompileScript(
if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"too many nested compilations (infinite loop?)", -1));
- Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL);
TclCompileSyntaxError(interp, envPtr);
return;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index f262b37..44c89bc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1148,8 +1148,9 @@ MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+MODULE_SCOPE void TclDebugPrintByteCodeObj(Tcl_Obj *objPtr);
+#else
+#define TclDebugPrintByteCodeObj(objPtr) (void)(objPtr)
#endif
MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
const unsigned char *pc);
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index a1a53bc..f00a568 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -128,7 +128,7 @@ Tcl_RegisterConfig(
*/
for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
- Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
+ TclDictPut(interp, pkgDict, cfg->key,
Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value)));
}
@@ -230,7 +230,7 @@ QueryConfigObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
- Tcl_GetString(pkgName), NULL);
+ Tcl_GetString(pkgName), (char *)NULL);
return TCL_ERROR;
}
@@ -245,7 +245,7 @@ QueryConfigObjCmd(
|| val == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
- Tcl_GetString(objv[2]), NULL);
+ Tcl_GetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -278,7 +278,7 @@ QueryConfigObjCmd(
if (!listPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"insufficient memory to create list", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return TCL_ERROR;
}
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 900b538..7e2aded 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -2758,7 +2758,7 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
- yyInput = Tcl_GetString( objv[1] );
+ yyInput = TclGetString(objv[1]);
dateInfo.dateStart = yyInput;
yyHaveDate = 0;
@@ -2792,12 +2792,12 @@ TclClockOldscanObjCmd(
if (status == 1) {
Tcl_SetObjResult(interp, dateInfo.messages);
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
@@ -2805,7 +2805,7 @@ TclClockOldscanObjCmd(
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(dateInfo.messages);
@@ -2813,31 +2813,31 @@ TclClockOldscanObjCmd(
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveTime > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time of day in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveZone > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time zone in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveDay > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one weekday in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index de3547e..d67de7c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -720,7 +720,7 @@ SetDictFromAny(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing value to go with key", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", (char *)NULL);
}
errorInFindDictElement:
DeleteChainTable(dict);
@@ -796,7 +796,7 @@ TclTraceDictPath(
"key \"%s\" not known in dictionary",
TclGetString(keyv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(keyv[i]), NULL);
+ TclGetString(keyv[i]), (char *)NULL);
}
return NULL;
}
@@ -1440,6 +1440,153 @@ Tcl_DbNewDictObj(
#endif
}
+/***** START OF FUNCTIONS ACTING AS HELPERS *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictGet --
+ *
+ * Given a key, get its value from the dictionary (or NULL if key is not
+ * found in dictionary.)
+ *
+ * Results:
+ * A standard Tcl result. The variable pointed to by valuePtrPtr is
+ * updated with the value for the key. Note that it is not an error for
+ * the key to have no mapping in the dictionary.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictGet(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ Tcl_Obj **valuePtrPtr) /* Where to write the value. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ code = Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr);
+ Tcl_DecrRefCount(keyPtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictPut --
+ *
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
+ *
+ * If valuePtr is a zero-count object and is not written into the
+ * dictionary because of an error, it is freed by this routine. The caller
+ * does NOT need to do reference count management.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictPut(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ Tcl_Obj *valuePtr) /* The value to write in. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ code = Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ Tcl_DecrRefCount(valuePtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictPutString --
+ *
+ * Add a key,value pair to a dictionary, or update the value for a key if
+ * that key already has a mapping in the dictionary.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictPutString(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key, /* The key in a C string. */
+ const char *value) /* The value in a C string. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ Tcl_Obj *valuePtr = Tcl_NewStringObj(value, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ Tcl_IncrRefCount(valuePtr);
+ code = Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr);
+ Tcl_DecrRefCount(keyPtr);
+ Tcl_DecrRefCount(valuePtr);
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDictRemove --
+ *
+ * Remove the key,value pair with the given key from the dictionary; the
+ * key does not need to be present in the dictionary.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The object pointed to by dictPtr is converted to a dictionary if it is
+ * not already one, and any string representation that it has is
+ * invalidated.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclDictRemove(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr,
+ const char *key) /* The key in a C string. */
+{
+ Tcl_Obj *keyPtr = Tcl_NewStringObj(key, -1);
+ int code;
+
+ Tcl_IncrRefCount(keyPtr);
+ code = Tcl_DictObjRemove(interp, dictPtr, keyPtr);
+ Tcl_DecrRefCount(keyPtr);
+ return code;
+}
+
/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/
/*
@@ -1578,7 +1725,7 @@ DictGetCmd(
"key \"%s\" not known in dictionary",
TclGetString(objv[objc-1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(objv[objc-1]), NULL);
+ TclGetString(objv[objc-1]), (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valuePtr);
@@ -2370,7 +2517,7 @@ DictForNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
- Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", (char *)NULL);
return TCL_ERROR;
}
searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch));
@@ -2565,7 +2712,7 @@ DictMapNRCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
- Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", (char *)NULL);
return TCL_ERROR;
}
storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage));
@@ -3004,7 +3151,7 @@ DictFilterCmd(
if (varc != 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must have exactly two variable names", -1));
- Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", (char *)NULL);
return TCL_ERROR;
}
keyVarObj = varv[0];
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 9597beb..51e281b 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -5,7 +5,7 @@
* human-readable or Tcl-processable forms.
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
* Copyright (c) 2013-2016 Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
@@ -21,10 +21,8 @@
* Prototypes for procedures defined later in this file:
*/
-static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
-static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeObj(Tcl_Obj *objPtr);
static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
static void GetLocationInformation(Proc *procPtr,
@@ -107,7 +105,7 @@ GetLocationInformation(
/*
*----------------------------------------------------------------------
*
- * TclPrintByteCodeObj --
+ * TclDebugPrintByteCodeObj --
*
* This procedure prints ("disassembles") the instructions of a bytecode
* object to stdout.
@@ -122,14 +120,16 @@ GetLocationInformation(
*/
void
-TclPrintByteCodeObj(
- Tcl_Interp *interp, /* Used only for getting location info. */
+TclDebugPrintByteCodeObj(
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
+ if (tclTraceCompile == 2) {
+ Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr);
- fprintf(stdout, "\n%s", TclGetString(bufPtr));
- Tcl_DecrRefCount(bufPtr);
+ fprintf(stdout, "\n%s", TclGetString(bufPtr));
+ Tcl_DecrRefCount(bufPtr);
+ fflush(stdout);
+ }
}
/*
@@ -191,7 +191,7 @@ TclPrintObject(
char *bytes;
int length;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
@@ -242,14 +242,14 @@ TclPrintSource(
static Tcl_Obj *
DisassembleByteCodeObj(
- Tcl_Interp *interp,
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
ByteCode *codePtr = BYTECODE(objPtr);
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+ int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
+ int i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_Obj *bufferObj, *fileObj;
char ptrBuf1[20], ptrBuf2[20];
@@ -277,9 +277,9 @@ DisassembleByteCodeObj(
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
GetLocationInformation(codePtr->procPtr, &fileObj, &line);
- if (line > -1 && fileObj != NULL) {
+ if (line >= 0 && fileObj != NULL) {
Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
- Tcl_GetString(fileObj), line);
+ TclGetString(fileObj), line);
}
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
@@ -648,7 +648,7 @@ FormatInstruction(
int length;
Tcl_AppendToObj(bufferObj, "\t# ", -1);
- bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
} else if (suffixBuffer[0]) {
Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
@@ -683,7 +683,7 @@ TclGetInnerContext(
const unsigned char *pc,
Tcl_Obj **tosPtr)
{
- int objc = 0, off = 0;
+ int objc = 0;
Tcl_Obj *result;
Interp *iPtr = (Interp *) interp;
@@ -766,7 +766,7 @@ TclGetInnerContext(
for (; objc>0 ; objc--) {
Tcl_Obj *objPtr;
- objPtr = tosPtr[1 - objc + off];
+ objPtr = tosPtr[1 - objc];
if (!objPtr) {
Tcl_Panic("InnerContext: bad tos -- appending null object");
}
@@ -929,8 +929,6 @@ PrintSourceToObj(
static Tcl_Obj *
DisassembleByteCodeAsDicts(
- Tcl_Interp *interp, /* Used for looking up the CmdFrame for the
- * procedure, if one exists. */
Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
{
ByteCode *codePtr = BYTECODE(objPtr);
@@ -1113,7 +1111,7 @@ DisassembleByteCodeAsDicts(
Tcl_Obj *desc;
TclNewObj(desc);
- Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
+ TclDictPut(NULL, desc, "name", auxDesc);
auxDesc = desc;
auxData->type->disassembleProc(auxData->clientData, auxDesc,
codePtr, 0);
@@ -1180,23 +1178,21 @@ DisassembleByteCodeAsDicts(
sourceOffset += Decode(srcOffPtr);
sourceLength = Decode(srcLenPtr);
TclNewObj(cmd);
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
- Tcl_NewIntObj(codeOffset));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
- Tcl_NewIntObj(codeOffset + codeLength - 1));
+ TclDictPut(NULL, cmd, "codefrom", Tcl_NewIntObj(codeOffset));
+ TclDictPut(NULL, cmd, "codeto", Tcl_NewIntObj(
+ codeOffset + codeLength - 1));
/*
* Convert byte offsets to character offsets; important if multibyte
* characters are present in the source!
*/
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
- Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
- sourceOffset)));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
- Tcl_NewIntObj(Tcl_NumUtfChars(codePtr->source,
+ TclDictPut(NULL, cmd, "scriptfrom", Tcl_NewIntObj(
+ Tcl_NumUtfChars(codePtr->source, sourceOffset)));
+ TclDictPut(NULL, cmd, "scriptto", Tcl_NewIntObj(
+ Tcl_NumUtfChars(codePtr->source,
sourceOffset + sourceLength - 1)));
- Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
+ TclDictPut(NULL, cmd, "script",
Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
Tcl_ListObjAppendElement(NULL, commands, cmd);
}
@@ -1215,32 +1211,26 @@ DisassembleByteCodeAsDicts(
*/
TclNewObj(description);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
- literals);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
- variables);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
- instructions);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
- commands);
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
+ TclDictPut(NULL, description, "literals", literals);
+ TclDictPut(NULL, description, "variables", variables);
+ TclDictPut(NULL, description, "exception", exn);
+ TclDictPut(NULL, description, "instructions", instructions);
+ TclDictPut(NULL, description, "auxiliary", aux);
+ TclDictPut(NULL, description, "commands", commands);
+ TclDictPut(NULL, description, "script",
Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
+ TclDictPut(NULL, description, "namespace",
Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
+ TclDictPut(NULL, description, "stackdepth",
Tcl_NewIntObj(codePtr->maxStackDepth));
- Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
+ TclDictPut(NULL, description, "exceptdepth",
Tcl_NewIntObj(codePtr->maxExceptDepth));
if (line > -1) {
- Tcl_DictObjPut(NULL, description,
- Tcl_NewStringObj("initiallinenumber", -1),
+ TclDictPut(NULL, description, "initiallinenumber",
Tcl_NewIntObj(line));
}
if (file) {
- Tcl_DictObjPut(NULL, description,
- Tcl_NewStringObj("sourcefile", -1), file);
+ TclDictPut(NULL, description, "sourcefile", file);
}
return description;
}
@@ -1260,7 +1250,7 @@ DisassembleByteCodeAsDicts(
int
Tcl_DisassembleObjCmd(
- ClientData clientData, /* What type of operation. */
+ void *clientData, /* What type of operation. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1343,7 +1333,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't a procedure", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1392,7 +1382,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1402,7 +1392,7 @@ Tcl_DisassembleObjCmd(
"\"%s\" has no defined constructor",
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "CONSRUCTOR", NULL);
+ "CONSRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
@@ -1410,7 +1400,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of constructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
@@ -1457,7 +1447,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1467,7 +1457,7 @@ Tcl_DisassembleObjCmd(
"\"%s\" has no defined destructor",
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "DESRUCTOR", NULL);
+ "DESRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
@@ -1475,7 +1465,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of destructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
@@ -1522,11 +1512,11 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
- (char *) objv[3]);
+ (char *)objv[3]);
goto methodBody;
case DISAS_OBJECT_METHOD:
if (objc != 4) {
@@ -1545,7 +1535,7 @@ Tcl_DisassembleObjCmd(
if (oPtr->methodsPtr == NULL) {
goto unknownMethod;
}
- hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *)objv[3]);
/*
* Compile (if necessary) and disassemble a method body.
@@ -1557,7 +1547,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(objv[3])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[3]), NULL);
+ TclGetString(objv[3]), (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
@@ -1565,7 +1555,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
@@ -1600,15 +1590,15 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "BYTECODE", NULL);
+ "BYTECODE", (char *)NULL);
return TCL_ERROR;
}
- if (PTR2INT(clientData)) {
+ if (clientData) {
Tcl_SetObjResult(interp,
- DisassembleByteCodeAsDicts(interp, codeObjPtr));
+ DisassembleByteCodeAsDicts(codeObjPtr));
} else {
Tcl_SetObjResult(interp,
- DisassembleByteCodeObj(interp, codeObjPtr));
+ DisassembleByteCodeObj(codeObjPtr));
}
return TCL_OK;
}
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index ba9f811..e1f2536 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1494,8 +1494,7 @@ OpenEncodingFileChannel(
const char *name) /* The name of the encoding file on disk and
* also the name for new encoding. */
{
- Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1);
- Tcl_Obj *fileNameObj = Tcl_DuplicateObj(nameObj);
+ Tcl_Obj *fileNameObj = Tcl_NewStringObj(name, -1);
Tcl_Obj *searchPath = Tcl_DuplicateObj(Tcl_GetEncodingSearchPath());
Tcl_Obj *map = TclGetProcessGlobalValue(&encodingFileMap);
Tcl_Obj **dir, *path, *directory = NULL;
@@ -1503,10 +1502,9 @@ OpenEncodingFileChannel(
int i, numDirs;
TclListObjGetElements(NULL, searchPath, &numDirs, &dir);
- Tcl_IncrRefCount(nameObj);
Tcl_AppendToObj(fileNameObj, ".enc", -1);
Tcl_IncrRefCount(fileNameObj);
- Tcl_DictObjGet(NULL, map, nameObj, &directory);
+ TclDictGet(NULL, map, name, &directory);
/*
* Check that any cached directory is still on the encoding search path.
@@ -1535,7 +1533,7 @@ OpenEncodingFileChannel(
*/
map = Tcl_DuplicateObj(map);
- Tcl_DictObjRemove(NULL, map, nameObj);
+ TclDictRemove(NULL, map, name);
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
directory = NULL;
}
@@ -1569,7 +1567,7 @@ OpenEncodingFileChannel(
*/
map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
- Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
+ TclDictPut(NULL, map, name, dir[i]);
TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
}
}
@@ -1577,10 +1575,9 @@ OpenEncodingFileChannel(
if ((NULL == chan) && (interp != NULL)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown encoding \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
}
Tcl_DecrRefCount(fileNameObj);
- Tcl_DecrRefCount(nameObj);
Tcl_DecrRefCount(searchPath);
return chan;
@@ -1652,7 +1649,7 @@ LoadEncodingFile(
if ((encoding == NULL) && (interp != NULL)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invalid encoding file \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, (char *)NULL);
}
Tcl_Close(NULL, chan);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f1d7134..6e16a6a 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1586,17 +1586,16 @@ TclMakeEnsemble(
*/
if (ensemble != NULL) {
- Tcl_Obj *mapDict, *fromObj, *toObj;
+ Tcl_Obj *mapDict, *toObj;
Command *cmdPtr;
TclDStringAppendLiteral(&buf, "::");
TclNewObj(mapDict);
for (i=0 ; map[i].name != NULL ; i++) {
- fromObj = Tcl_NewStringObj(map[i].name, -1);
TclNewStringObj(toObj, Tcl_DStringValue(&buf),
Tcl_DStringLength(&buf));
Tcl_AppendToObj(toObj, map[i].name, -1);
- Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+ TclDictPut(NULL, mapDict, map[i].name, toObj);
if (map[i].proc || map[i].nreProc) {
/*
@@ -1616,6 +1615,8 @@ TclMakeEnsemble(
Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) {
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
+ /* don't compile unsafe subcommands in safe interp */
+ cmdPtr->compileProc = NULL;
} else {
/*
* Not hidden, so just create it. Yay!
@@ -1625,8 +1626,8 @@ TclMakeEnsemble(
Tcl_NRCreateCommand(interp, TclGetString(toObj),
map[i].proc, map[i].nreProc, map[i].clientData,
NULL);
+ cmdPtr->compileProc = map[i].compileProc;
}
- cmdPtr->compileProc = map[i].compileProc;
}
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
@@ -3108,7 +3109,7 @@ TclCompileEnsemble(
Tcl_IncrRefCount(targetCmdObj);
newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
TclDecrRefCount(targetCmdObj);
- if (newCmdPtr == NULL || Tcl_IsSafe(interp)
+ if (newCmdPtr == NULL || (Tcl_IsSafe(interp) && !cmdPtr->compileProc)
|| newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
|| newCmdPtr->flags & CMD_HAS_EXEC_TRACES
|| ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
@@ -3116,7 +3117,6 @@ TclCompileEnsemble(
* Maps to an undefined command or a command without a compiler.
* Cannot compile.
*/
-
goto cleanup;
}
cmdPtr = newCmdPtr;
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index c2e71ec..99d5e0a 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -263,13 +263,9 @@ HandleBgErrors(
if (errChannel != NULL) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr = NULL;
-
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ Tcl_Obj *valuePtr = NULL;
+ TclDictGet(NULL, options, "-errorinfo", &valuePtr);
Tcl_WriteChars(errChannel,
"error in background error handler:\n", -1);
if (valuePtr) {
@@ -313,7 +309,7 @@ TclDefaultBgErrorHandlerObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_Obj *valuePtr;
Tcl_Obj *tempObjv[2];
int result, code, level;
Tcl_InterpState saved;
@@ -327,27 +323,21 @@ TclDefaultBgErrorHandlerObjCmd(
* Check for a valid return options dictionary.
*/
- TclNewLiteralStringObj(keyPtr, "-level");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-level", &valuePtr);
if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-level\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
return TCL_ERROR;
}
- TclNewLiteralStringObj(keyPtr, "-code");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-code", &valuePtr);
if (result != TCL_OK || valuePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing return option \"-code\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
@@ -405,18 +395,12 @@ TclDefaultBgErrorHandlerObjCmd(
Tcl_SetObjResult(interp, tempObjv[1]);
}
- TclNewLiteralStringObj(keyPtr, "-errorcode");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-errorcode", &valuePtr);
if (result == TCL_OK && valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
}
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ result = TclDictGet(NULL, objv[2], "-errorinfo", &valuePtr);
if (result == TCL_OK && valuePtr != NULL) {
Tcl_AppendObjToErrorInfo(interp, valuePtr);
}
@@ -1441,7 +1425,7 @@ Tcl_VwaitObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't wait for variable \"%s\": would wait forever",
nameString));
- Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (char *)NULL);
return TCL_ERROR;
}
if (!done) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4072781..1c8f667 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1582,12 +1582,7 @@ CompileExprObj(
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile == 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
return codePtr;
}
@@ -1912,8 +1907,8 @@ TclIncrObj(
}
#ifndef TCL_WIDE_INT_IS_LONG
{
- Tcl_WideInt w1 = (Tcl_WideInt) augend;
- Tcl_WideInt w2 = (Tcl_WideInt) addend;
+ Tcl_WideInt w1 = (Tcl_WideInt)augend;
+ Tcl_WideInt w2 = (Tcl_WideInt)addend;
/*
* We know the sum value is outside the long range, so we use the
@@ -2519,7 +2514,7 @@ TEBCresume(
"yield can only be called in a coroutine", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2531,7 +2526,7 @@ TEBCresume(
} else {
fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
- Tcl_GetString(OBJ_AT_TOS));
+ TclGetString(OBJ_AT_TOS));
}
fflush(stdout);
}
@@ -2550,7 +2545,7 @@ TEBCresume(
"yieldto can only be called in a coroutine", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2561,7 +2556,7 @@ TEBCresume(
"yieldto called in deleted namespace", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2574,7 +2569,7 @@ TEBCresume(
/* FIXME: What is the right thing to trace? */
fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
- Tcl_GetString(valuePtr));
+ TclGetString(valuePtr));
}
fflush(stdout);
}
@@ -2622,7 +2617,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc or lambda", -1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4039,7 +4034,7 @@ TEBCresume(
arrayPtr = NULL;
part1Ptr = part2Ptr = NULL;
cleanup = 0;
- TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
+ TRACE(("%u %s => ", opnd, TclGetString(incrPtr)));
doIncrVar:
if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
@@ -4408,7 +4403,7 @@ TEBCresume(
TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
"variable isn't array", opnd);
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
@@ -4757,7 +4752,7 @@ TEBCresume(
TRACE_ERROR(interp);
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4785,7 +4780,7 @@ TEBCresume(
"invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
TRACE_APPEND(("ERROR: not command\n"));
goto gotError;
@@ -4820,7 +4815,7 @@ TEBCresume(
"self may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4848,7 +4843,7 @@ TEBCresume(
"nextto may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4869,7 +4864,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(valuePtr)));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4921,7 +4916,7 @@ TEBCresume(
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4929,7 +4924,7 @@ TEBCresume(
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4947,7 +4942,7 @@ TEBCresume(
"next may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4976,7 +4971,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
#ifdef TCL_COMPILE_DEBUG
@@ -6300,7 +6295,7 @@ TEBCresume(
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -6349,7 +6344,7 @@ TEBCresume(
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -6371,7 +6366,7 @@ TEBCresume(
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", NULL);
+ "integer value too large to represent", (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -6505,8 +6500,8 @@ TEBCresume(
switch (*pc) {
case INST_ADD:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
+ w1 = (Tcl_WideInt)l1;
+ w2 = (Tcl_WideInt)l2;
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2);
#ifdef TCL_WIDE_INT_IS_LONG
/*
@@ -6520,8 +6515,8 @@ TEBCresume(
goto wideResultOfArithmetic;
case INST_SUB:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
+ w1 = (Tcl_WideInt)l1;
+ w2 = (Tcl_WideInt)l2;
wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2);
#ifdef TCL_WIDE_INT_IS_LONG
/*
@@ -7325,7 +7320,7 @@ TEBCresume(
TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
@@ -7886,20 +7881,20 @@ TEBCresume(
#ifdef TCL_WIDE_CLICKS
wval = TclpGetWideClicks();
#else
- wval = (Tcl_WideInt) TclpGetClicks();
+ wval = TclpGetClicks();
#endif
break;
case 1: /* microseconds */
Tcl_GetTime(&now);
- wval = (Tcl_WideInt) now.sec * 1000000 + now.usec;
+ wval = (Tcl_WideInt)now.sec * 1000000 + now.usec;
break;
case 2: /* milliseconds */
Tcl_GetTime(&now);
- wval = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
+ wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000;
break;
case 3: /* seconds */
Tcl_GetTime(&now);
- wval = (Tcl_WideInt) now.sec;
+ wval = now.sec;
break;
default:
Tcl_Panic("clockRead instruction with unknown clock#");
@@ -8012,7 +8007,7 @@ TEBCresume(
divideByZero:
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -8026,7 +8021,7 @@ TEBCresume(
"exponentiation of zero by negative power", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
- "exponentiation of zero by negative power", NULL);
+ "exponentiation of zero by negative power", (char *)NULL);
CACHE_STACK_INFO();
/*
@@ -8538,12 +8533,12 @@ ExecuteExtendedBinaryMathOp(
* TODO: examine for logic simplification
*/
- if (((wQuotient < (Tcl_WideInt) 0)
- || ((wQuotient == (Tcl_WideInt) 0)
- && ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
- || (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
+ if (((wQuotient < 0)
+ || ((wQuotient == 0)
+ && ((w1 < 0 && w2 > 0)
+ || (w1 > 0 && w2 < 0))))
&& (wQuotient * w2 != w1)) {
- wQuotient -= (Tcl_WideInt) 1;
+ wQuotient--;
}
wRemainder = (Tcl_WideInt)((Tcl_WideUInt)w1 -
(Tcl_WideUInt)w2*(Tcl_WideUInt)wQuotient);
@@ -8552,8 +8547,7 @@ ExecuteExtendedBinaryMathOp(
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- /* TODO: internals intrusion */
- if ((w1 > ((Tcl_WideInt) 0)) ^ !mp_isneg(&big2)) {
+ if ((w1 > 0) ^ !mp_isneg(&big2)) {
/*
* Arguments are opposite sign; remainder is sum.
*/
@@ -8577,7 +8571,7 @@ ExecuteExtendedBinaryMathOp(
mp_init(&bigResult);
mp_init(&bigRemainder);
mp_div(&big1, &big2, &bigResult, &bigRemainder);
- if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
+ if (!mp_iszero(&bigRemainder) && (mp_isneg(&bigRemainder) != mp_isneg(&big2))) {
/*
* Convert to Tcl's integer division rules.
*/
@@ -8603,12 +8597,12 @@ ExecuteExtendedBinaryMathOp(
break;
#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
- invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
+ invalid = (*((const Tcl_WideInt *)ptr2) < 0);
break;
#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- invalid = (mp_cmp_d(&big2, 0) == MP_LT);
+ invalid = mp_isneg(&big2);
mp_clear(&big2);
break;
default:
@@ -8687,7 +8681,7 @@ ExecuteExtendedBinaryMathOp(
break;
#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
- zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
+ zero = (*(const Tcl_WideInt *)ptr1 > 0);
break;
#endif
case TCL_NUMBER_BIG:
@@ -8714,7 +8708,7 @@ ExecuteExtendedBinaryMathOp(
if (type1 == TCL_NUMBER_WIDE) {
w1 = *(const Tcl_WideInt *)ptr1;
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
- if (w1 >= (Tcl_WideInt)0) {
+ if (w1 >= 0) {
return constants[0];
}
LONG_RESULT(-1);
@@ -8858,7 +8852,7 @@ ExecuteExtendedBinaryMathOp(
#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+ negativeExponent = mp_isneg(&big2);
mp_mod_2d(&big2, 1, &big2);
oddExponent = !mp_iszero(&big2);
mp_clear(&big2);
@@ -8952,7 +8946,7 @@ ExecuteExtendedBinaryMathOp(
}
#if !defined(TCL_WIDE_INT_IS_LONG)
if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
- WIDE_RESULT(((Tcl_WideInt) 1) << l2);
+ WIDE_RESULT(((Tcl_WideInt)1) << l2);
}
#endif
goto overflowExpon;
@@ -8969,7 +8963,7 @@ ExecuteExtendedBinaryMathOp(
}
#if !defined(TCL_WIDE_INT_IS_LONG)
if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
- WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
+ WIDE_RESULT(signum * (((Tcl_WideInt)1) << l2));
}
#endif
goto overflowExpon;
@@ -9255,9 +9249,8 @@ ExecuteExtendedBinaryMathOp(
}
mp_init(&bigRemainder);
mp_div(&big1, &big2, &bigResult, &bigRemainder);
- /* TODO: internals intrusion */
if (!mp_iszero(&bigRemainder)
- && (bigRemainder.sign != big2.sign)) {
+ && (mp_isneg(&bigRemainder) != mp_isneg(&big2))) {
/*
* Convert to Tcl's integer division rules.
*/
@@ -9308,7 +9301,7 @@ ExecuteExtendedUnaryMathOp(
case TCL_NUMBER_DOUBLE:
DOUBLE_RESULT(-(*((const double *) ptr)));
case TCL_NUMBER_LONG:
- w = (Tcl_WideInt) (*((const long *) ptr));
+ w = (Tcl_WideInt)(*((const long *) ptr));
if (w != LLONG_MIN) {
WIDE_RESULT(-w);
}
@@ -9424,7 +9417,7 @@ TclCompareTwoNumbers(
goto longCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if (mp_cmp_d(&big2, 0) == MP_LT) {
+ if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
@@ -9450,7 +9443,7 @@ TclCompareTwoNumbers(
d2 = *((const double *)ptr2);
d1 = (double) w1;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
- || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
+ || w1 == (Tcl_WideInt)d1 || modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
if (d2 < (double)LLONG_MIN) {
@@ -9459,7 +9452,7 @@ TclCompareTwoNumbers(
if (d2 > (double)LLONG_MAX) {
return MP_LT;
}
- w2 = (Tcl_WideInt) d2;
+ w2 = (Tcl_WideInt)d2;
goto wideCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
@@ -9501,7 +9494,7 @@ TclCompareTwoNumbers(
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
- || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
+ || w2 == (Tcl_WideInt)d2 || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
if (d1 < (double)LLONG_MIN) {
@@ -9510,7 +9503,7 @@ TclCompareTwoNumbers(
if (d1 > (double)LLONG_MAX) {
return MP_GT;
}
- w1 = (Tcl_WideInt) d1;
+ w1 = (Tcl_WideInt)d1;
goto wideCompare;
#endif
case TCL_NUMBER_BIG:
@@ -9709,7 +9702,7 @@ ValidatePcAndStackTop(
TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
- fprintf(stderr,"%s\n", Tcl_GetString(message));
+ fprintf(stderr,"%s\n", TclGetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
@@ -9759,7 +9752,7 @@ IllegalExprOperandType(
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
int numBytes;
- const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
+ const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
if (numBytes == 0) {
description = "empty string";
@@ -9779,7 +9772,7 @@ IllegalExprOperandType(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't use %s as operand of \"%s\"", description, op));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
}
/*
@@ -10156,23 +10149,23 @@ TclExprFloatError(
if ((errno == EDOM) || TclIsNaN(value)) {
s = "domain error: argument not in valid range";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *)NULL);
} else if ((errno == ERANGE) || TclIsInfinite(value)) {
if (value == 0.0) {
s = "floating-point value too small to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *)NULL);
} else {
s = "floating-point value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *)NULL);
}
} else {
Tcl_Obj *objPtr = Tcl_ObjPrintf(
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
- Tcl_GetString(objPtr), NULL);
+ TclGetString(objPtr), (char *)NULL);
Tcl_SetObjResult(interp, objPtr);
}
}
@@ -10388,7 +10381,7 @@ EvalStatsCmd(
if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
numByteCodeLits++;
}
- (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ (void)TclGetStringFromObj(entryPtr->objPtr, &length);
refCountSum += entryPtr->refCount;
objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
strBytesIfUnshared += (entryPtr->refCount * (length+1));
@@ -10610,7 +10603,7 @@ EvalStatsCmd(
Tcl_SetObjResult(interp, objPtr);
} else {
Tcl_Channel outChan;
- char *str = Tcl_GetStringFromObj(objv[1], &length);
+ char *str = TclGetStringFromObj(objv[1], &length);
if (length) {
if (strcmp(str, "stdout") == 0) {
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 56445b6..e550882 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1080,7 +1080,7 @@ TclFileAttrsCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
+ Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
goto end;
}
@@ -1107,7 +1107,7 @@ TclFileAttrsCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\", there are no file attributes in this"
" filesystem", TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
+ Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", (char *)NULL);
goto end;
}
@@ -1123,7 +1123,7 @@ TclFileAttrsCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
- "NOVALUE", NULL);
+ "NOVALUE", (char *)NULL);
goto end;
}
if (Tcl_FSFileAttrsSet(interp, index, filePtr,
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index d6dac9c..1fc89dc 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -37,6 +37,9 @@ static Tcl_Obj * SplitUnixPath(const char *path);
static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
const char *separators, Tcl_Obj *pathPtr, int flags,
char *pattern, Tcl_GlobTypeData *types);
+static int TclGlob(Tcl_Interp *interp, char *pattern,
+ Tcl_Obj *pathPrefix, int globFlags,
+ Tcl_GlobTypeData *types);
/*
* When there is no support for getting the block size of a file in a stat()
@@ -387,7 +390,7 @@ TclpGetNativePathType(
{
Tcl_PathType type = TCL_PATH_ABSOLUTE;
int pathLen;
- const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = TclGetStringFromObj(pathPtr, &pathLen);
if (path[0] == '~') {
/*
@@ -493,11 +496,11 @@ TclpNativeSplitPath(
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
- resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
+ resultPtr = SplitUnixPath(TclGetString(pathPtr));
break;
case TCL_PLATFORM_WINDOWS:
- resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
+ resultPtr = SplitWinPath(TclGetString(pathPtr));
break;
}
@@ -567,7 +570,7 @@ Tcl_SplitPath(
size = 1;
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- Tcl_GetStringFromObj(eltPtr, &len);
+ TclGetStringFromObj(eltPtr, &len);
size += len + 1;
}
@@ -587,7 +590,7 @@ Tcl_SplitPath(
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- str = Tcl_GetStringFromObj(eltPtr, &len);
+ str = TclGetStringFromObj(eltPtr, &len);
memcpy(p, str, len + 1);
p += len+1;
}
@@ -838,7 +841,7 @@ TclpNativeJoinPath(
const char *p;
const char *start;
- start = Tcl_GetStringFromObj(prefix, &length);
+ start = TclGetStringFromObj(prefix, &length);
/*
* Remove the ./ from tilde prefixed elements, and drive-letter prefixed
@@ -866,7 +869,7 @@ TclpNativeJoinPath(
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- Tcl_GetStringFromObj(prefix, &length);
+ TclGetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -876,7 +879,7 @@ TclpNativeJoinPath(
Tcl_SetObjLength(prefix, length + (int) strlen(p));
- dest = Tcl_GetString(prefix) + length;
+ dest = TclGetString(prefix) + length;
for (; *p != '\0'; p++) {
if (*p == '/') {
while (p[1] == '/') {
@@ -890,7 +893,7 @@ TclpNativeJoinPath(
needsSep = 1;
}
}
- length = dest - Tcl_GetString(prefix);
+ length = dest - TclGetString(prefix);
Tcl_SetObjLength(prefix, length);
break;
@@ -902,7 +905,7 @@ TclpNativeJoinPath(
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- Tcl_GetStringFromObj(prefix, &length);
+ TclGetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -911,7 +914,7 @@ TclpNativeJoinPath(
*/
Tcl_SetObjLength(prefix, length + (int) strlen(p));
- dest = Tcl_GetString(prefix) + length;
+ dest = TclGetString(prefix) + length;
for (; *p != '\0'; p++) {
if ((*p == '/') || (*p == '\\')) {
while ((p[1] == '/') || (p[1] == '\\')) {
@@ -925,7 +928,7 @@ TclpNativeJoinPath(
needsSep = 1;
}
}
- length = dest - Tcl_GetString(prefix);
+ length = dest - TclGetString(prefix);
Tcl_SetObjLength(prefix, length);
break;
}
@@ -985,7 +988,7 @@ Tcl_JoinPath(
* Store the result.
*/
- resultStr = Tcl_GetStringFromObj(resultObj, &len);
+ resultStr = TclGetStringFromObj(resultObj, &len);
Tcl_DStringAppend(resultPtr, resultStr, len);
Tcl_DecrRefCount(resultObj);
@@ -1164,7 +1167,7 @@ DoTildeSubst(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"couldn't find HOME environment "
"variable to expand path", -1));
- Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", (char *)NULL);
}
return NULL;
}
@@ -1175,7 +1178,7 @@ DoTildeSubst(
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"user \"%s\" doesn't exist", user));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, (char *)NULL);
}
return NULL;
}
@@ -1231,7 +1234,7 @@ Tcl_GlobObjCmd(
for (i = 1; i < objc; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&index) != TCL_OK) {
- string = Tcl_GetStringFromObj(objv[i], &length);
+ string = TclGetStringFromObj(objv[i], &length);
if (string[0] == '-') {
/*
* It looks like the command contains an option so signal an
@@ -1258,7 +1261,7 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-directory\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
@@ -1268,7 +1271,7 @@ Tcl_GlobObjCmd(
: "\"-directory\" cannot be used with \"-path\"",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", NULL);
+ "BADOPTIONCOMBINATION", (char *)NULL);
return TCL_ERROR;
}
dir = PATH_DIR;
@@ -1286,7 +1289,7 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-path\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL);
return TCL_ERROR;
}
if (dir != PATH_NONE) {
@@ -1296,7 +1299,7 @@ Tcl_GlobObjCmd(
: "\"-path\" cannot be used with \"-dictionary\"",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", NULL);
+ "BADOPTIONCOMBINATION", (char *)NULL);
return TCL_ERROR;
}
dir = PATH_GENERAL;
@@ -1307,7 +1310,7 @@ Tcl_GlobObjCmd(
if (i == (objc-1)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"missing argument to \"-types\"", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", (char *)NULL);
return TCL_ERROR;
}
typePtr = objv[i+1];
@@ -1328,7 +1331,7 @@ Tcl_GlobObjCmd(
"\"-tails\" must be used with either "
"\"-directory\" or \"-path\"", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
- "BADOPTIONCOMBINATION", NULL);
+ "BADOPTIONCOMBINATION", (char *)NULL);
return TCL_ERROR;
}
@@ -1345,7 +1348,7 @@ Tcl_GlobObjCmd(
if (dir == PATH_GENERAL) {
int pathlength;
const char *last;
- const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+ const char *first = TclGetStringFromObj(pathOrDir,&pathlength);
/*
* Find the last path separator in the path
@@ -1395,7 +1398,7 @@ Tcl_GlobObjCmd(
* there are none presently in the prefix.
*/
- if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
+ if (strpbrk(TclGetString(pathOrDir), "\\/") == NULL) {
Tcl_AppendToObj(pathOrDir, last-1, 1);
}
}
@@ -1448,7 +1451,7 @@ Tcl_GlobObjCmd(
const char *str;
Tcl_ListObjIndex(interp, typePtr, length, &look);
- str = Tcl_GetStringFromObj(look, &len);
+ str = TclGetStringFromObj(look, &len);
if (strcmp("readonly", str) == 0) {
globTypes->perm |= TCL_GLOB_PERM_RONLY;
} else if (strcmp("hidden", str) == 0) {
@@ -1506,9 +1509,9 @@ Tcl_GlobObjCmd(
if ((TclListObjLength(NULL, look, &len) == TCL_OK)
&& (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
- if (!strcmp("macintosh", Tcl_GetString(item))) {
+ if (!strcmp("macintosh", TclGetString(item))) {
Tcl_ListObjIndex(interp, look, 1, &item);
- if (!strcmp("type", Tcl_GetString(item))) {
+ if (!strcmp("type", TclGetString(item))) {
Tcl_ListObjIndex(interp, look, 2, &item);
if (globTypes->macType != NULL) {
goto badMacTypesArg;
@@ -1516,7 +1519,7 @@ Tcl_GlobObjCmd(
globTypes->macType = item;
Tcl_IncrRefCount(item);
continue;
- } else if (!strcmp("creator", Tcl_GetString(item))) {
+ } else if (!strcmp("creator", TclGetString(item))) {
Tcl_ListObjIndex(interp, look, 2, &item);
if (globTypes->macCreator != NULL) {
goto badMacTypesArg;
@@ -1537,7 +1540,7 @@ Tcl_GlobObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad argument to \"-types\": %s",
Tcl_GetString(look)));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
result = TCL_ERROR;
join = 0;
goto endOfGlob;
@@ -1547,7 +1550,7 @@ Tcl_GlobObjCmd(
"only one MacOS type or creator argument"
" to \"-types\" allowed", -1));
result = TCL_ERROR;
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", (char *)NULL);
join = 0;
goto endOfGlob;
}
@@ -1600,7 +1603,7 @@ Tcl_GlobObjCmd(
Tcl_DStringFree(&str);
} else {
for (i = 0; i < objc; i++) {
- string = Tcl_GetString(objv[i]);
+ string = TclGetString(objv[i]);
if (TclGlob(interp, string, pathOrDir, globFlags,
globTypes) != TCL_OK) {
result = TCL_ERROR;
@@ -1632,14 +1635,14 @@ Tcl_GlobObjCmd(
for (i = 0; i < objc; i++) {
Tcl_AppendPrintfToObj(errorMsg, "%s%s",
- sep, Tcl_GetString(objv[i]));
+ sep, TclGetString(objv[i]));
sep = " ";
}
}
Tcl_AppendToObj(errorMsg, "\"", -1);
Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
- NULL);
+ (char *)NULL);
result = TCL_ERROR;
}
}
@@ -1692,7 +1695,7 @@ Tcl_GlobObjCmd(
*----------------------------------------------------------------------
*/
-int
+static int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
* appending list of matching file names. */
@@ -1766,7 +1769,6 @@ TclGlob(
if (c != '\0') {
tail++;
}
- Tcl_DStringFree(&buffer);
} else {
tail = pattern;
}
@@ -1833,7 +1835,7 @@ TclGlob(
Tcl_DecrRefCount(temp);
return TCL_ERROR;
}
- pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3);
+ pathPrefix = Tcl_NewStringObj(TclGetString(cwd), 3);
Tcl_DecrRefCount(cwd);
if (tail[0] == '/') {
tail++;
@@ -1982,7 +1984,7 @@ TclGlob(
Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
}
- pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
+ pre = TclGetStringFromObj(pathPrefix, &prefixLen);
if (prefixLen > 0
&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
/*
@@ -2000,7 +2002,7 @@ TclGlob(
TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
- const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+ const char *oldStr = TclGetStringFromObj(objv[i], &len);
Tcl_Obj *elem;
if (len == prefixLen) {
@@ -2209,14 +2211,14 @@ DoGlob(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unmatched open-brace in file name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
} else if (*p == '}') {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unmatched close-brace in file name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
}
@@ -2329,7 +2331,7 @@ DoGlob(
for (i=0; result==TCL_OK && i<subdirc; i++) {
Tcl_Obj *copy = NULL;
- if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
+ if (pathPtr == NULL && TclGetString(subdirv[i])[0] == '~') {
TclListObjLength(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
@@ -2350,7 +2352,7 @@ DoGlob(
Tcl_Obj *fixme, *newObj;
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
- bytes = Tcl_GetStringFromObj(fixme, &numBytes);
+ bytes = TclGetStringFromObj(fixme, &numBytes);
newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
1, &newObj);
@@ -2388,7 +2390,7 @@ DoGlob(
Tcl_DStringAppend(&append, pattern, p-pattern);
if (pathPtr != NULL) {
- (void) Tcl_GetStringFromObj(pathPtr, &length);
+ (void)TclGetStringFromObj(pathPtr, &length);
} else {
length = 0;
}
@@ -2434,7 +2436,7 @@ DoGlob(
*/
int len;
- const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = TclGetStringFromObj(joinedPtr, &len);
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
Tcl_AppendToObj(joinedPtr, "/", 1);
@@ -2471,7 +2473,7 @@ DoGlob(
*/
int len;
- const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = TclGetStringFromObj(joinedPtr,&len);
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
@@ -2536,21 +2538,21 @@ unsigned
Tcl_GetFSDeviceFromStat(
const Tcl_StatBuf *statPtr)
{
- return (unsigned) statPtr->st_dev;
+ return (unsigned)statPtr->st_dev;
}
unsigned
Tcl_GetFSInodeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (unsigned) statPtr->st_ino;
+ return (unsigned)statPtr->st_ino;
}
unsigned
Tcl_GetModeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (unsigned) statPtr->st_mode;
+ return (unsigned)statPtr->st_mode;
}
int
@@ -2564,7 +2566,7 @@ int
Tcl_GetUserIdFromStat(
const Tcl_StatBuf *statPtr)
{
- return (int) statPtr->st_uid;
+ return (int)statPtr->st_uid;
}
int
@@ -2585,28 +2587,28 @@ Tcl_WideInt
Tcl_GetAccessTimeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (Tcl_WideInt) statPtr->st_atime;
+ return statPtr->st_atime;
}
Tcl_WideInt
Tcl_GetModificationTimeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (Tcl_WideInt) statPtr->st_mtime;
+ return statPtr->st_mtime;
}
Tcl_WideInt
Tcl_GetChangeTimeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (Tcl_WideInt) statPtr->st_ctime;
+ return statPtr->st_ctime;
}
Tcl_WideUInt
Tcl_GetSizeFromStat(
const Tcl_StatBuf *statPtr)
{
- return (Tcl_WideUInt) statPtr->st_size;
+ return (Tcl_WideUInt)statPtr->st_size;
}
Tcl_WideUInt
@@ -2614,11 +2616,11 @@ Tcl_GetBlocksFromStat(
const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
- return (Tcl_WideUInt) statPtr->st_blocks;
+ return (Tcl_WideUInt)statPtr->st_blocks;
#else
unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
- return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
+ return ((Tcl_WideUInt)statPtr->st_size + blksize - 1) / blksize;
#endif
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index a8b9801..3a55b8e 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -979,7 +979,7 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
- yyInput = Tcl_GetString( objv[1] );
+ yyInput = TclGetString(objv[1]);
dateInfo.dateStart = yyInput;
yyHaveDate = 0;
@@ -1013,12 +1013,12 @@ TclClockOldscanObjCmd(
if (status == 1) {
Tcl_SetObjResult(interp, dateInfo.messages);
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
return TCL_ERROR;
} else if (status != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
@@ -1026,7 +1026,7 @@ TclClockOldscanObjCmd(
"report this error as a "
"bug in Tcl.", -1));
Tcl_DecrRefCount(dateInfo.messages);
- Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL);
return TCL_ERROR;
}
Tcl_DecrRefCount(dateInfo.messages);
@@ -1034,31 +1034,31 @@ TclClockOldscanObjCmd(
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one date in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveTime > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time of day in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveZone > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one time zone in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveDay > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one weekday in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
if (yyHaveOrdinalMonth > 1) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("more than one ordinal month in string", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL);
return TCL_ERROR;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 165a07e..1cb3bbd 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -477,7 +477,7 @@ ChanSeek(
if ((offset >= LONG_MIN) && (offset <= LONG_MAX)) {
return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
- offset, mode, errnoPtr);
+ (long)offset, mode, errnoPtr);
}
*errnoPtr = EOVERFLOW;
return -1;
@@ -2965,7 +2965,7 @@ FreeChannelState(
ReleaseChannelBuffer(statePtr->curOutPtr);
}
DiscardOutputQueued(statePtr);
-
+
DeleteTimerHandler(statePtr);
if (statePtr->chanMsg) {
@@ -6143,7 +6143,7 @@ ReadChars(
if (dstLimit <= 0) {
dstLimit = INT_MAX; /* avoid overflow */
}
- (void) TclGetStringFromObj(objPtr, &numBytes);
+ (void)TclGetStringFromObj(objPtr, &numBytes);
TclAppendUtfToUtf(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
unsigned int size;
@@ -8140,8 +8140,7 @@ Tcl_SetChannelOption(
} else if (HaveOpt(2, "-eofchar")) {
if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
- }
- if (argc == 0) {
+ } else if (argc == 0) {
statePtr->inEofChar = 0;
statePtr->outEofChar = 0;
} else if (argc == 1 || argc == 2) {
@@ -9194,7 +9193,7 @@ TclCopyChannelOld(
int toRead, /* Amount of data to copy, or -1 for all. */
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
{
- return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
+ return TclCopyChannel(interp, inChan, outChan, toRead,
cmdPtr);
}
@@ -9288,7 +9287,7 @@ TclCopyChannel(
csPtr->readFlags = readFlags;
csPtr->writeFlags = writeFlags;
csPtr->toRead = toRead;
- csPtr->total = (Tcl_WideInt) 0;
+ csPtr->total = 0;
csPtr->interp = interp;
if (cmdPtr) {
Tcl_IncrRefCount(cmdPtr);
@@ -9613,7 +9612,7 @@ CopyData(
Tcl_IncrRefCount(bufObj);
}
- while (csPtr->toRead != (Tcl_WideInt) 0) {
+ while (csPtr->toRead != 0) {
/*
* Check for unreported background errors.
*/
@@ -9644,8 +9643,8 @@ CopyData(
* Read up to bufSize bytes.
*/
- if ((csPtr->toRead == (Tcl_WideInt) -1)
- || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
+ if ((csPtr->toRead == -1)
+ || (csPtr->toRead > (Tcl_WideInt)csPtr->bufSize)) {
sizeb = csPtr->bufSize;
} else {
sizeb = (int) csPtr->toRead;
@@ -9832,8 +9831,8 @@ CopyData(
}
/*
- * Make the callback or return the number of bytes transferred. The
- * local total is used because StopCopy frees csPtr.
+ * Make the callback or return the number of bytes transferred. The local
+ * total is used because StopCopy frees csPtr.
*/
total = csPtr->total;
@@ -10662,8 +10661,7 @@ Tcl_ChannelVersion(
* Side effects:
* None.
*
- *----------------------------------------------------------------------
- */
+ *---------------------------------------------------------------------- */
Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(
@@ -11063,7 +11061,7 @@ Tcl_SetChannelError(
Tcl_Channel chan, /* Channel to store the data into. */
Tcl_Obj *msg) /* Error message to store. */
{
- ChannelState *statePtr = ((Channel *) chan)->state;
+ ChannelState *statePtr = ((Channel *)chan)->state;
if (statePtr->chanMsg != NULL) {
TclDecrRefCount(statePtr->chanMsg);
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 5127b99..0c8af09 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -450,7 +450,7 @@ Tcl_ReadObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected non-negative integer but got \"%s\"",
TclGetString(objv[i])));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (char *)NULL);
return TCL_ERROR;
}
newline = 1;
@@ -1386,7 +1386,7 @@ AcceptCallbackProc(
Tcl_RegisterChannel(NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
- " ", address, " ", portBuf, NULL);
+ " ", address, " ", portBuf, (char *)NULL);
if (result != TCL_OK) {
Tcl_BackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
@@ -2005,8 +2005,7 @@ TclInitChanCmd(
* Can assume that reference counts are all incremented.
*/
- Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj(extras[i], -1),
- Tcl_NewStringObj(extras[i+1], -1));
+ TclDictPutString(NULL, mapObj, extras[i], extras[i + 1]);
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
return ensemble;
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index f2bb186..dfc6dac 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2216,7 +2216,7 @@ CleanRefChannelInstance(
ReflectedChannel *rcPtr)
{
if (rcPtr->name) {
- /*
+ /*
* Reset obj-type (channel is deleted or dead anyway) to avoid leakage
* by cyclic references (see bug [79474c58800cdf94]).
*/
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 8b87a51..e630702 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -290,10 +290,10 @@ Tcl_Stat(
* Tcl_WideInt.
*/
- tmp1 = (Tcl_WideInt) buf.st_ino;
- tmp2 = (Tcl_WideInt) buf.st_size;
+ tmp1 = buf.st_ino;
+ tmp2 = buf.st_size;
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
- tmp3 = (Tcl_WideInt) buf.st_blocks;
+ tmp3 = buf.st_blocks;
#endif
if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
@@ -2267,8 +2267,7 @@ Tcl_FSOpenFileChannel(
* Apply appropriate flags parsed out above.
*/
- if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
- < (Tcl_WideInt) 0) {
+ if (seekFlag && (Tcl_Seek(retVal, 0, SEEK_END) < 0)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not seek to end of file while opening \"%s\": %s",
@@ -3304,7 +3303,7 @@ Tcl_LoadFile(
* Tcl_Read takes an int: check that file size isn't wide.
*/
- if (size != (Tcl_WideInt) statBuf.st_size) {
+ if (size != (Tcl_WideInt)statBuf.st_size) {
goto mustCopyToTempAnyway;
}
data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 5890bcb..f8e665b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2918,6 +2918,14 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
+MODULE_SCOPE int TclDictGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, Tcl_Obj **valuePtrPtr);
+MODULE_SCOPE int TclDictPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, Tcl_Obj *valuePtr);
+MODULE_SCOPE int TclDictPutString(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key, const char *value);
+MODULE_SCOPE int TclDictRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr,
+ const char *key);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
@@ -2994,9 +3002,6 @@ MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
unsigned int *sizePtr);
-MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
- Tcl_Obj *unquotedPrefix, int globFlags,
- Tcl_GlobTypeData *types);
MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index b0f6207..c34cbbf 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -3118,7 +3118,7 @@ ChildMarkTrusted(
"permission denied: safe interpreter cannot mark trusted",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
((Interp *) childInterp)->flags &= ~SAFE_INTERP;
@@ -4428,8 +4428,7 @@ ChildCommandLimitCmd(
if (hPtr != NULL) {
limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
- limitCBPtr->scriptObj);
+ TclDictPut(NULL, dictPtr, options[0], limitCBPtr->scriptObj);
} else {
goto putEmptyCommandInDict;
}
@@ -4438,22 +4437,19 @@ ChildCommandLimitCmd(
putEmptyCommandInDict:
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[0], -1), empty);
+ TclDictPut(NULL, dictPtr, options[0], empty);
}
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp,
- TCL_LIMIT_COMMANDS)));
+ TclDictPut(NULL, dictPtr, options[1], Tcl_NewIntObj(
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS)));
if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewIntObj(Tcl_LimitGetCommands(childInterp)));
+ TclDictPut(NULL, dictPtr, options[2], Tcl_NewIntObj(
+ Tcl_LimitGetCommands(childInterp)));
} else {
Tcl_Obj *empty;
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[2], -1), empty);
+ TclDictPut(NULL, dictPtr, options[2], empty);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
@@ -4616,8 +4612,7 @@ ChildTimeLimitCmd(
if (hPtr != NULL) {
limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
- limitCBPtr->scriptObj);
+ TclDictPut(NULL, dictPtr, options[0], limitCBPtr->scriptObj);
} else {
goto putEmptyCommandInDict;
}
@@ -4625,29 +4620,25 @@ ChildTimeLimitCmd(
Tcl_Obj *empty;
putEmptyCommandInDict:
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[0], -1), empty);
+ TclDictPut(NULL, dictPtr, options[0], empty);
}
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(childInterp,
- TCL_LIMIT_TIME)));
+ TclDictPut(NULL, dictPtr, options[1], Tcl_NewIntObj(
+ Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME)));
if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
Tcl_Time limitMoment;
Tcl_LimitGetTime(childInterp, &limitMoment);
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewLongObj(limitMoment.usec/1000));
- Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
+ TclDictPut(NULL, dictPtr, options[2],
+ Tcl_NewLongObj(limitMoment.usec / 1000));
+ TclDictPut(NULL, dictPtr, options[3],
Tcl_NewLongObj(limitMoment.sec));
} else {
Tcl_Obj *empty;
TclNewObj(empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[2], -1), empty);
- Tcl_DictObjPut(NULL, dictPtr,
- Tcl_NewStringObj(options[3], -1), empty);
+ TclDictPut(NULL, dictPtr, options[2], empty);
+ TclDictPut(NULL, dictPtr, options[3], empty);
}
Tcl_SetObjResult(interp, dictPtr);
return TCL_OK;
diff --git a/generic/tclLink.c b/generic/tclLink.c
index d93e4cb..6c5d0d2 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -513,7 +513,7 @@ LinkTraceProc(
case TCL_LINK_ULONG:
if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
- || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
+ || valueWide < 0 || (Tcl_WideUInt)valueWide > ULONG_MAX) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned long value";
@@ -612,13 +612,13 @@ ObjValue(
return Tcl_NewIntObj(linkPtr->lastValue.us);
case TCL_LINK_UINT:
linkPtr->lastValue.ui = LinkedVar(unsigned int);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.ui);
case TCL_LINK_LONG:
linkPtr->lastValue.l = LinkedVar(long);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.l);
case TCL_LINK_ULONG:
linkPtr->lastValue.ul = LinkedVar(unsigned long);
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.ul);
case TCL_LINK_FLOAT:
linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
@@ -627,7 +627,7 @@ ObjValue(
/*
* FIXME: represent as a bignum.
*/
- return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
+ return Tcl_NewWideIntObj(linkPtr->lastValue.uw);
case TCL_LINK_STRING:
p = LinkedVar(char *);
if (p == NULL) {
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index b2d6228..f063599 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -168,7 +168,7 @@ AttemptNewList(
"list creation failed: unable to alloc %u bytes",
LIST_SIZE(objc)));
}
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
}
return listRepPtr;
}
@@ -582,7 +582,7 @@ Tcl_ListObjAppendElement(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"max length of a Tcl list (%d elements) exceeded",
LIST_MAX));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
}
return TCL_ERROR;
}
@@ -1447,7 +1447,7 @@ TclLsetFlat(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
- "BADINDEX", NULL);
+ "BADINDEX", (char *)NULL);
}
result = TCL_ERROR;
break;
@@ -1637,7 +1637,7 @@ TclListObjSetElement(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
- "BADINDEX", NULL);
+ "BADINDEX", (char *)NULL);
}
return TCL_ERROR;
}
@@ -1659,7 +1659,7 @@ TclListObjSetElement(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 28117f5..df9ef7d 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -185,7 +185,7 @@ Tcl_LoadObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must specify either file name or package name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -253,7 +253,7 @@ Tcl_LoadObjCmd(
"file \"%s\" is already loaded for package \"%s\"",
fullFileName, pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
- "SPLITPERSONALITY", NULL);
+ "SPLITPERSONALITY", (char *)NULL);
code = TCL_ERROR;
Tcl_MutexUnlock(&packageMutex);
goto done;
@@ -290,7 +290,7 @@ Tcl_LoadObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"package \"%s\" isn't loaded statically", packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -349,7 +349,7 @@ Tcl_LoadObjCmd(
"couldn't figure out package name for %s",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
- "WHATPACKAGE", NULL);
+ "WHATPACKAGE", (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -446,7 +446,7 @@ Tcl_LoadObjCmd(
"can't use package in a safe interpreter: no"
" %s_SafeInit procedure", pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -457,7 +457,7 @@ Tcl_LoadObjCmd(
"can't attach package to interpreter: no %s_Init procedure",
pkgPtr->packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -608,7 +608,7 @@ Tcl_UnloadObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"must specify either file name or package name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -682,7 +682,7 @@ Tcl_UnloadObjCmd(
"package \"%s\" is loaded statically and cannot be unloaded",
packageName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -694,7 +694,7 @@ Tcl_UnloadObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"file \"%s\" has never been loaded", fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -724,7 +724,7 @@ Tcl_UnloadObjCmd(
"file \"%s\" has never been loaded in this interpreter",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -741,7 +741,7 @@ Tcl_UnloadObjCmd(
"file \"%s\" cannot be unloaded under a safe interpreter",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -752,7 +752,7 @@ Tcl_UnloadObjCmd(
"file \"%s\" cannot be unloaded under a trusted interpreter",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
goto done;
}
@@ -893,7 +893,7 @@ Tcl_UnloadObjCmd(
"file \"%s\" cannot be unloaded: unloading disabled",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
- NULL);
+ (char *)NULL);
code = TCL_ERROR;
#endif
}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 4f31924..d2ab04a 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -405,13 +405,9 @@ Tcl_MainEx(
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
- Tcl_Obj *keyPtr, *valuePtr;
-
- TclNewLiteralStringObj(keyPtr, "-errorinfo");
- Tcl_IncrRefCount(keyPtr);
- Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
- Tcl_DecrRefCount(keyPtr);
+ Tcl_Obj *valuePtr = NULL;
+ TclDictGet(NULL, options, "-errorinfo", &valuePtr);
if (valuePtr) {
Tcl_WriteObj(chan, valuePtr);
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 1580abd..2765676 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1782,7 +1782,7 @@ TclNewObjectInstanceCommon(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create object \"%s\": command already exists with"
" that name", nameStr));
- Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", (char *)NULL);
return NULL;
}
}
@@ -1839,7 +1839,7 @@ FinalizeAlloc(
if (result != TCL_ERROR && Destructing(oPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object deleted in constructor", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", (char *)NULL);
result = TCL_ERROR;
}
if (result != TCL_OK) {
@@ -1908,7 +1908,7 @@ Tcl_CopyObjectInstance(
if (IsRootClass(oPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not clone the class of classes", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", (char *)NULL);
return NULL;
}
@@ -2599,7 +2599,7 @@ TclOOObjectCmdCore(
"impossible to invoke method \"%s\": no defined method or"
" unknown method", TclGetString(methodNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
- TclGetString(methodNamePtr), NULL);
+ TclGetString(methodNamePtr), (char *)NULL);
return TCL_ERROR;
}
} else {
@@ -2615,7 +2615,7 @@ TclOOObjectCmdCore(
"impossible to invoke method \"%s\": no defined method or"
" unknown method", TclGetString(methodNamePtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(methodNamePtr), NULL);
+ TclGetString(methodNamePtr), (char *)NULL);
return TCL_ERROR;
}
}
@@ -2642,7 +2642,7 @@ TclOOObjectCmdCore(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"no valid method implementation", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(methodNamePtr), NULL);
+ TclGetString(methodNamePtr), (char *)NULL);
TclOODeleteContext(contextPtr);
return TCL_ERROR;
}
@@ -2723,7 +2723,7 @@ Tcl_ObjectContextInvokeNext(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
return TCL_ERROR;
}
@@ -2792,7 +2792,7 @@ TclNRObjectContextInvokeNext(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
- Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
return TCL_ERROR;
}
@@ -2871,7 +2871,7 @@ Tcl_GetObjectFromObj(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s does not refer to an object", TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
- NULL);
+ (char *)NULL);
return NULL;
}
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index e746b64..13749b2 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -169,7 +169,7 @@ TclOO_Class_Create(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -187,7 +187,7 @@ TclOO_Class_Create(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
@@ -234,7 +234,7 @@ TclOO_Class_CreateNs(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -252,7 +252,7 @@ TclOO_Class_CreateNs(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
nsName = Tcl_GetStringFromObj(
@@ -260,7 +260,7 @@ TclOO_Class_CreateNs(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"namespace name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
@@ -305,7 +305,7 @@ TclOO_Class_New(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -415,7 +415,8 @@ TclOO_Object_Eval(
*/
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
- Tcl_GetObjectNamespace(object), 0);
+ Tcl_GetObjectNamespace(object), FRAME_IS_METHOD);
+ framePtr->clientData = context;
framePtr->objc = objc;
framePtr->objv = objv; /* Reference counts do not need to be
* incremented here. */
@@ -538,7 +539,7 @@ TclOO_Object_Unknown(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" has no %s", TclGetString(tmpBuf), piece));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[skip]), NULL);
+ TclGetString(objv[skip]), (char *)NULL);
return TCL_ERROR;
}
@@ -557,7 +558,7 @@ TclOO_Object_Unknown(
ckfree(methodNames);
Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[skip]), NULL);
+ TclGetString(objv[skip]), (char *)NULL);
return TCL_ERROR;
}
@@ -614,7 +615,7 @@ TclOO_Object_LinkVar(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"variable name \"%s\" illegal: must not contain namespace"
" separator", varName));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);
return TCL_ERROR;
}
@@ -643,7 +644,7 @@ TclOO_Object_LinkVar(
TclVarErrMsg(interp, varName, NULL, "define",
"name refers to an element in an array");
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (char *)NULL);
return TCL_ERROR;
}
@@ -718,11 +719,16 @@ TclOO_Object_VarName(
TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
Tcl_DecrRefCount(varNamePtr);
if (varPtr == NULL) {
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, (char *)NULL);
return TCL_ERROR;
}
/*
+ * The variable reference must not disappear too soon. [Bug 74b6110204]
+ */
+ TclSetVarNamespaceVar(varPtr);
+
+ /*
* Now that we've pinned down what variable we're really talking about
* (including traversing variable links), convert back to a name.
*/
@@ -789,7 +795,7 @@ TclOONextObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
context = framePtr->clientData;
@@ -829,7 +835,7 @@ TclOONextToObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
contextPtr = framePtr->clientData;
@@ -850,7 +856,7 @@ TclOONextToObjCmd(
if (classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[1])));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
@@ -899,14 +905,14 @@ TclOONextToObjCmd(
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(objv[1])));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
return TCL_ERROR;
}
@@ -969,7 +975,7 @@ TclOOSelfObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
@@ -1004,7 +1010,7 @@ TclOOSelfObjCmd(
if (clsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method not defined by a class", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
}
@@ -1025,7 +1031,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
} else {
struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
@@ -1051,7 +1057,7 @@ TclOOSelfObjCmd(
!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"caller is not an object", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
} else {
CallContext *callerPtr = framePtr->callerVarPtr->clientData;
@@ -1119,7 +1125,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
} else {
Method *mPtr;
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 081dd5b..8f544e1 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -116,10 +116,8 @@ TclOOInitInfo(
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
if (infoCmd) {
Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
- Tcl_NewStringObj("::oo::InfoObject", -1));
- Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
- Tcl_NewStringObj("::oo::InfoClass", -1));
+ TclDictPutString(NULL, mapDict, "object", "::oo::InfoObject");
+ TclDictPutString(NULL, mapDict, "class", "::oo::InfoClass");
Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
}
}
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 5cff201..5633130 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -845,7 +845,7 @@ PushMethodCallFrame(
pmPtr->procPtr->cmdPtr = &pmPtr->cmd;
if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
- ByteCode *codePtr =
+ ByteCode *codePtr = (ByteCode *)
pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
codePtr->nsPtr = nsPtr;
@@ -1356,7 +1356,7 @@ TclOONewForwardInstanceMethod(
if (prefixLen < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method forward prefix must be non-empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", (char *)NULL);
return NULL;
}
@@ -1395,7 +1395,7 @@ TclOONewForwardMethod(
if (prefixLen < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method forward prefix must be non-empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", (char *)NULL);
return NULL;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f7196c3..ec4655e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -5,9 +5,9 @@
* Tcl commands.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright (c) 1999 by Scriptics Corporation.
- * Copyright (c) 2001 by ActiveState Corporation.
- * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 1999 Scriptics Corporation.
+ * Copyright (c) 2001 ActiveState Corporation.
+ * Copyright (c) 2005 Kevin B. Kenny. All rights reserved.
* Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution of
@@ -78,20 +78,20 @@ typedef struct ObjData {
typedef struct ThreadSpecificData {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
- * generated by a call to the function
- * TclSubstTokens() from a literal text
- * where bs+nl sequences occurred in it, if
- * any. I.e. this table keeps track of
- * invisible and stripped continuation lines.
- * Its keys are Tcl_Obj pointers, the values
- * are ContLineLoc pointers. See the file
- * tclCompile.h for the definition of this
- * structure, and for references to all
- * related places in the core. */
+ * generated by a call to the function
+ * TclSubstTokens() from a literal text
+ * where bs+nl sequences occurred in it, if
+ * any. I.e. this table keeps track of
+ * invisible and stripped continuation lines.
+ * Its keys are Tcl_Obj pointers, the values
+ * are ContLineLoc pointers. See the file
+ * tclCompile.h for the definition of this
+ * structure, and for references to all
+ * related places in the core. */
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
- * that a Tcl_Obj was not allocated by some
- * other thread. */
+ * that a Tcl_Obj was not allocated by some
+ * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
@@ -169,7 +169,7 @@ static __thread PendingObjData pendingObjData;
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = \
- Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
+ (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
/*
@@ -187,7 +187,7 @@ static Tcl_ThreadDataKey pendingObjDataKey;
mp_shrink(&(bignum)); \
} \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \
- (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR((mp_isneg(&(bignum)) << 30) \
| ((bignum).alloc << 15) | ((bignum).used)); \
}
@@ -195,7 +195,7 @@ static Tcl_ThreadDataKey pendingObjDataKey;
if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
} else { \
- (bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
+ (bignum).dp = (mp_digit *)(objPtr)->internalRep.twoPtrValue.ptr1; \
(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
(bignum).alloc = \
(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7FFF; \
@@ -394,18 +394,18 @@ TclInitObjSubsystem(void)
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
+ Tcl_RegisterObjType(&tclArraySearchType);
Tcl_RegisterObjType(&tclByteArrayType);
+ Tcl_RegisterObjType(&tclByteCodeType);
+ Tcl_RegisterObjType(&tclCmdNameType);
+ Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclEndOffsetType);
Tcl_RegisterObjType(&tclIntType);
- Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
- Tcl_RegisterObjType(&tclDictType);
- Tcl_RegisterObjType(&tclByteCodeType);
- Tcl_RegisterObjType(&tclArraySearchType);
- Tcl_RegisterObjType(&tclCmdNameType);
- Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
+ Tcl_RegisterObjType(&tclRegexpType);
+ Tcl_RegisterObjType(&tclStringType);
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
@@ -457,7 +457,7 @@ TclFinalizeThreadObjects(void)
if (tablePtr != NULL) {
for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
- ObjData *objData = Tcl_GetHashValue(hPtr);
+ ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree(objData);
@@ -636,7 +636,8 @@ TclContinuationsEnterDerived(
int start,
int *clNext)
{
- int length, end, num;
+ int length;
+ int end, num;
int *wordCLLast = clNext;
/*
@@ -730,10 +731,10 @@ TclContinuationsCopy(
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
if (hPtr) {
- ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
+ ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr);
TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
}
@@ -764,12 +765,12 @@ TclContinuationsGet(
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (!hPtr) {
- return NULL;
+ return NULL;
}
- return Tcl_GetHashValue(hPtr);
+ return (ContLineLoc *)Tcl_GetHashValue(hPtr);
}
/*
@@ -897,7 +898,7 @@ Tcl_AppendAllObjTypes(
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
+ Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1));
}
Tcl_MutexUnlock(&tableMutex);
return TCL_OK;
@@ -930,7 +931,7 @@ Tcl_GetObjType(
Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
if (hPtr != NULL) {
- typePtr = Tcl_GetHashValue(hPtr);
+ typePtr = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr);
}
Tcl_MutexUnlock(&tableMutex);
return typePtr;
@@ -976,7 +977,7 @@ Tcl_ConvertToType(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't convert value to type %s", typePtr->name));
- Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", (char *)NULL);
}
return TCL_ERROR;
}
@@ -1017,7 +1018,7 @@ TclDbDumpActiveObjects(
fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
- ObjData *objData = Tcl_GetHashValue(hPtr);
+ ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
if (objData != NULL) {
fprintf(outFile,
@@ -1317,13 +1318,13 @@ TclFreeObj(
if (!tablePtr) {
Tcl_Panic("TclFreeObj: object table not initialized");
}
- hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
+ hPtr = Tcl_FindHashEntry(tablePtr, (char *)objPtr);
if (hPtr) {
/*
* As the Tcl_Obj is going to be deleted we remove the entry.
*/
- ObjData *objData = Tcl_GetHashValue(hPtr);
+ ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
if (objData != NULL) {
ckfree(objData);
@@ -1401,10 +1402,10 @@ TclFreeObj(
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr;
if (tsdPtr->lineCLPtr) {
- hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
ckfree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
@@ -1492,10 +1493,10 @@ TclFreeObj(
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr;
if (tsdPtr->lineCLPtr) {
- hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
ckfree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
@@ -1996,7 +1997,7 @@ TclSetBooleanFromAny(
Tcl_AppendLimitedToObj(msg, str, length, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2005,14 +2006,15 @@ static int
ParseBoolean(
Tcl_Obj *objPtr) /* The object to parse/convert. */
{
- int i, length, newBool;
+ int newBool;
char lowerCase[6];
+ int i, length;
const char *str = TclGetStringFromObj(objPtr, &length);
if ((length < 1) || (length > 5)) {
/*
- * Longest valid boolean string rep. is "false".
- */
+ * Longest valid boolean string rep. is "false".
+ */
return TCL_ERROR;
}
@@ -2284,8 +2286,8 @@ Tcl_GetDoubleFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"floating point value is Not a Number", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
- NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -2508,7 +2510,7 @@ Tcl_GetIntFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"", Tcl_GetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2518,7 +2520,7 @@ Tcl_GetIntFromObj(
const char *s =
"integer value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
}
return TCL_ERROR;
}
@@ -2794,10 +2796,10 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected integer but got \"%s\"",
- TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2823,10 +2825,10 @@ Tcl_GetLongFromObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
- if (big.sign) {
- *longPtr = (long) (-value);
+ if (mp_isneg(&big)) {
+ *longPtr = (long)(-value);
} else {
- *longPtr = (long) value;
+ *longPtr = (long)value;
}
return TCL_OK;
}
@@ -2839,7 +2841,7 @@ Tcl_GetLongFromObj(
Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
}
return TCL_ERROR;
}
@@ -3041,8 +3043,8 @@ Tcl_SetWideIntObj(
}
#ifndef TCL_WIDE_INT_IS_LONG
- if ((wideValue < (Tcl_WideInt) LONG_MIN)
- || (wideValue > (Tcl_WideInt) LONG_MAX)) {
+ if ((wideValue < (Tcl_WideInt)LONG_MIN)
+ || (wideValue > (Tcl_WideInt)LONG_MAX)) {
TclSetWideIntObj(objPtr, wideValue);
} else
#endif
@@ -3085,15 +3087,15 @@ Tcl_GetWideIntFromObj(
}
#endif
if (objPtr->typePtr == &tclIntType) {
- *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
+ *wideIntPtr = (Tcl_WideInt)objPtr->internalRep.longValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected integer but got \"%s\"",
- TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3117,10 +3119,10 @@ Tcl_GetWideIntFromObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
- if (big.sign) {
- *wideIntPtr = (Tcl_WideInt) (-value);
+ if (mp_isneg(&big)) {
+ *wideIntPtr = (Tcl_WideInt)(-value);
} else {
- *wideIntPtr = (Tcl_WideInt) value;
+ *wideIntPtr = (Tcl_WideInt)value;
}
return TCL_OK;
}
@@ -3130,7 +3132,7 @@ Tcl_GetWideIntFromObj(
Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
}
return TCL_ERROR;
}
@@ -3398,7 +3400,7 @@ GetBignumFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"insufficient memory to unpack bignum", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3426,10 +3428,10 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "expected integer but got \"%s\"",
- TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3545,10 +3547,10 @@ Tcl_SetBignumObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
- if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
+ if (value > (((~(unsigned long)0) >> 1) + mp_isneg(bignumValue))) {
goto tooLargeForLong;
}
- if (bignumValue->sign) {
+ if (mp_isneg(bignumValue)) {
TclSetLongObj(objPtr, (long)(-value));
} else {
TclSetLongObj(objPtr, (long)value);
@@ -3571,10 +3573,10 @@ Tcl_SetBignumObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
- if (value > ((UWIDE_MAX >> 1) + bignumValue->sign)) {
+ if (value > ((UWIDE_MAX >> 1) + mp_isneg(bignumValue))) {
goto tooLargeForWide;
}
- if (bignumValue->sign) {
+ if (mp_isneg(bignumValue)) {
TclSetWideIntObj(objPtr, (Tcl_WideInt)(-value));
} else {
TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
@@ -3678,8 +3680,8 @@ TclGetNumberFromObj(
#endif
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
- mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
- (int) sizeof(mp_int));
+ mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
+ (int)sizeof(mp_int));
UNPACK_BIGNUM(objPtr, *bigPtr);
*typePtr = TCL_NUMBER_BIG;
@@ -3746,7 +3748,7 @@ Tcl_DbIncrRefCount(
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
- "incr ref count");
+ "incr ref count");
}
}
# endif /* TCL_THREADS */
@@ -3809,7 +3811,7 @@ Tcl_DbDecrRefCount(
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
- "decr ref count");
+ "decr ref count");
}
}
# endif /* TCL_THREADS */
@@ -3874,7 +3876,7 @@ Tcl_DbIsShared(
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
- "check shared status");
+ "check shared status");
}
}
# endif /* TCL_THREADS */
@@ -3976,8 +3978,8 @@ TclCompareObjKeys(
void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- Tcl_Obj *objPtr1 = keyPtr;
- Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
+ Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
+ Tcl_Obj *objPtr2 = (Tcl_Obj *)hPtr->key.oneWordValue;
const char *p1, *p2;
size_t l1, l2;
@@ -3985,7 +3987,9 @@ TclCompareObjKeys(
* If the object pointers are the same then they match.
* OPT: this comparison was moved to the caller
- if (objPtr1 == objPtr2) return 1;
+ if (objPtr1 == objPtr2) {
+ return 1;
+ }
*/
/*
@@ -4065,7 +4069,7 @@ TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{
- Tcl_Obj *objPtr = keyPtr;
+ Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
int length;
const char *string = TclGetStringFromObj(objPtr, &length);
unsigned int result = 0;
@@ -4163,24 +4167,24 @@ Tcl_GetCommandFromObj(
* to discard the old rep and create a new one.
*/
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
- Command *cmdPtr = resPtr->cmdPtr;
-
- if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
- && !(cmdPtr->flags & CMD_IS_DELETED)
- && (interp == cmdPtr->nsPtr->interp)
- && !(cmdPtr->nsPtr->flags & NS_DYING)) {
- Namespace *refNsPtr = (Namespace *)
- TclGetCurrentNamespace(interp);
-
- if ((resPtr->refNsPtr == NULL)
- || ((refNsPtr == resPtr->refNsPtr)
- && (resPtr->refNsId == refNsPtr->nsId)
- && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
- return (Tcl_Command) cmdPtr;
- }
- }
+ Command *cmdPtr = resPtr->cmdPtr;
+
+ if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
+ && !(cmdPtr->flags & CMD_IS_DELETED)
+ && (interp == cmdPtr->nsPtr->interp)
+ && !(cmdPtr->nsPtr->flags & NS_DYING)) {
+ Namespace *refNsPtr = (Namespace *)
+ TclGetCurrentNamespace(interp);
+
+ if ((resPtr->refNsPtr == NULL)
+ || ((refNsPtr == resPtr->refNsPtr)
+ && (resPtr->refNsId == refNsPtr->nsId)
+ && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
+ return (Tcl_Command) cmdPtr;
+ }
+ }
}
/*
@@ -4188,11 +4192,11 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- /* See [] why we cannot call SetCmdNameFromAny() directly here. */
+ /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
- return NULL;
+ return NULL;
}
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}
@@ -4225,13 +4229,13 @@ TclSetCmdNameObj(
Command *cmdPtr) /* Points to Command structure that the
* CmdName object should refer to. */
{
- Interp *iPtr = (Interp *) interp;
+ Interp *iPtr = (Interp *)interp;
ResolvedCmdName *resPtr;
Namespace *currNsPtr;
const char *name;
if (objPtr->typePtr == &tclCmdNameType) {
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
return;
}
@@ -4295,9 +4299,9 @@ FreeCmdNameInternalRep(
Tcl_Obj *objPtr) /* CmdName object with internal
* representation to free. */
{
- ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
- if (resPtr != NULL) {
+ if (resPtr != (ResolvedCmdName *)NULL) {
/*
* Decrement the reference count of the ResolvedCmdName structure. If
* there are no more uses, free the ResolvedCmdName structure.
@@ -4344,7 +4348,7 @@ DupCmdNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -4380,7 +4384,7 @@ SetCmdNameFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
- Interp *iPtr = (Interp *) interp;
+ Interp *iPtr = (Interp *)interp;
const char *name;
Command *cmdPtr;
Namespace *currNsPtr;
@@ -4410,7 +4414,7 @@ SetCmdNameFromAny(
if (cmdPtr) {
cmdPtr->refCount++;
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr == &tclCmdNameType)
&& resPtr && (resPtr->refCount == 1)) {
/*
@@ -4498,8 +4502,8 @@ Tcl_RepresentationCmd(
snprintf(ptrBuffer, sizeof(ptrBuffer), "%p", (void *) objv[1]);
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
- " object pointer at %s",
- objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ " object pointer at %s",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
objv[1]->refCount, ptrBuffer);
/*
@@ -4529,9 +4533,9 @@ Tcl_RepresentationCmd(
}
if (objv[1]->bytes) {
- Tcl_AppendToObj(descObj, ", string representation \"", -1);
+ Tcl_AppendToObj(descObj, ", string representation \"", -1);
Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
- 16, "...");
+ 16, "...");
Tcl_AppendToObj(descObj, "\"", -1);
} else {
Tcl_AppendToObj(descObj, ", no string representation", -1);
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index f5571e2..a17c343 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -1523,7 +1523,7 @@ MakePathFromNormalized(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can't find object string representation", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -2397,7 +2397,7 @@ SetFsPathFromAny(
"couldn't find HOME environment variable to"
" expand path", -1));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
- "HOMELESS", NULL);
+ "HOMELESS", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2422,7 +2422,7 @@ SetFsPathFromAny(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"user \"%s\" doesn't exist", expandedUser));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
- NULL);
+ (char *)NULL);
}
Tcl_DStringFree(&userName);
Tcl_DStringFree(&temp);
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 31e1143..676ee3a 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -4,7 +4,7 @@
* This file contains the generic portion of the command channel driver
* as well as various utility routines used in managing subprocesses.
*
- * Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -111,7 +111,7 @@ FileForRedirect(
Tcl_GetChannelName(chan),
((writing) ? "writing" : "reading")));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "BADCHAN", NULL);
+ "BADCHAN", (char *)NULL);
}
return NULL;
}
@@ -155,7 +155,7 @@ FileForRedirect(
badLastArg:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't specify \"%s\" as last word in command", arg));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", (char *)NULL);
return NULL;
}
@@ -188,7 +188,7 @@ Tcl_DetachPids(
Tcl_MutexLock(&pipeMutex);
for (i = 0; i < numPids; i++) {
- detPtr = ckalloc(sizeof(Detached));
+ detPtr = (Detached *)ckalloc(sizeof(Detached));
detPtr->pid = pidPtr[i];
detPtr->nextPtr = detList;
detList = detPtr;
@@ -327,7 +327,7 @@ TclCleanupChildren(
if (WIFEXITED(waitStatus)) {
if (interp != NULL) {
snprintf(msg2, sizeof(msg2), "%u", WEXITSTATUS(waitStatus));
- Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
+ Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, (char *)NULL);
}
abnormalExit = 1;
} else if (interp != NULL) {
@@ -336,20 +336,20 @@ TclCleanupChildren(
if (WIFSIGNALED(waitStatus)) {
p = Tcl_SignalMsg(WTERMSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
- Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
+ Tcl_SignalId(WTERMSIG(waitStatus)), p, (char *)NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"child killed: %s\n", p));
} else if (WIFSTOPPED(waitStatus)) {
p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
- Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
+ Tcl_SignalId(WSTOPSIG(waitStatus)), p, (char *)NULL);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"child suspended: %s\n", p));
} else {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"child wait status didn't make sense\n", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "ODDWAITRESULT", msg1, NULL);
+ "ODDWAITRESULT", msg1, (char *)NULL);
}
}
}
@@ -370,7 +370,7 @@ TclCleanupChildren(
int count;
Tcl_Obj *objPtr;
- Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
+ Tcl_Seek(errorChan, 0, SEEK_SET);
TclNewObj(objPtr);
count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
if (count < 0) {
@@ -550,7 +550,7 @@ TclCreatePipeline(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal use of | or |& in command", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "PIPESYNTAX", NULL);
+ "PIPESYNTAX", (char *)NULL);
goto error;
}
}
@@ -579,7 +579,7 @@ TclCreatePipeline(
"can't specify \"%s\" as last word in command",
argv[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "PIPESYNTAX", NULL);
+ "PIPESYNTAX", (char *)NULL);
goto error;
}
skip = 2;
@@ -696,7 +696,7 @@ TclCreatePipeline(
"must specify \"%s\" as last word in command",
argv[i]));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "PIPESYNTAX", NULL);
+ "PIPESYNTAX", (char *)NULL);
goto error;
}
errorFile = outputFile;
@@ -738,7 +738,7 @@ TclCreatePipeline(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"illegal use of | or |& in command", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
- NULL);
+ (char *)NULL);
goto error;
}
@@ -861,7 +861,7 @@ TclCreatePipeline(
*/
Tcl_ReapDetachedProcs();
- pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
+ pidPtr = (Tcl_Pid *)ckalloc(cmdCount * sizeof(Tcl_Pid));
curInFile = inputFile;
@@ -1091,7 +1091,7 @@ Tcl_OpenCommandChannel(
"can't read output from command:"
" standard output was redirected", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "BADREDIRECT", NULL);
+ "BADREDIRECT", (char *)NULL);
goto error;
}
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
@@ -1099,7 +1099,7 @@ Tcl_OpenCommandChannel(
"can't write input to command:"
" standard input was redirected", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "BADREDIRECT", NULL);
+ "BADREDIRECT", (char *)NULL);
goto error;
}
}
@@ -1110,7 +1110,7 @@ Tcl_OpenCommandChannel(
if (channel == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"pipe for command could not be created", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", (char *)NULL);
goto error;
}
return channel;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 5e7f614..8bce8b5 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -174,7 +174,7 @@ Tcl_PkgProvideEx(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"conflicting versions provided for package \"%s\": %s, then %s",
name, TclGetString(pkgPtr->version), version));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", (char *)NULL);
return TCL_ERROR;
}
@@ -306,7 +306,7 @@ Tcl_PkgRequireEx(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Cannot load package \"%s\" in standalone executable:"
" This package is not compiled with stub support", name));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", (char *)NULL);
return NULL;
}
@@ -326,7 +326,7 @@ Tcl_PkgRequireEx(
}
ov = Tcl_NewStringObj(version, -1);
if (exact) {
- Tcl_AppendStringsToObj(ov, "-", version, NULL);
+ Tcl_AppendStringsToObj(ov, "-", version, (char *)NULL);
}
Tcl_IncrRefCount(ov);
if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
@@ -414,11 +414,7 @@ PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) {
AddRequirementsToDString(&command, reqc, reqv);
Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
- Tcl_NREvalObj(interp,
- Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)),
- TCL_EVAL_GLOBAL
- );
- Tcl_DStringFree(&command);
+ Tcl_NREvalObj(interp, TclDStringToObj(&command), TCL_EVAL_GLOBAL);
}
return TCL_OK;
} else {
@@ -436,7 +432,7 @@ PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) {
if ((result != TCL_OK) && (result != TCL_ERROR)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad return code: %d", result));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", (char *)NULL);
result = TCL_ERROR;
}
if (result == TCL_ERROR) {
@@ -462,7 +458,7 @@ PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
if (reqPtr->pkgPtr->version == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't find package %s", name));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", (char *)NULL);
AddRequirementsToResult(interp, reqc, reqv);
return TCL_ERROR;
}
@@ -483,7 +479,7 @@ PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
"version conflict for package \"%s\": have %s, need",
name, TclGetString(reqPtr->pkgPtr->version)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
- NULL);
+ (char *)NULL);
AddRequirementsToResult(interp, reqc, reqv);
return TCL_ERROR;
}
@@ -529,7 +525,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
" attempt to provide %s %s requires %s",
name, (char *) pkgPtr->clientData, name));
AddRequirementsToResult(interp, reqc, reqv);
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", (char *)NULL);
return TCL_ERROR;
}
@@ -689,7 +685,7 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
" no version of package %s provided",
name, versionToProvide, name));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
- NULL);
+ (char *)NULL);
} else {
char *pvi, *vi;
@@ -713,7 +709,7 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
name, versionToProvide,
name, TclGetString(reqPtr->pkgPtr->version)));
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
- "WRONGPROVIDE", NULL);
+ "WRONGPROVIDE", (char *)NULL);
}
}
}
@@ -725,7 +721,7 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
"attempt to provide package %s %s failed:"
" bad return code: %s",
name, versionToProvide, TclGetString(codePtr)));
- Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", (char *)NULL);
TclDecrRefCount(codePtr);
result = TCL_ERROR;
}
@@ -831,7 +827,7 @@ Tcl_PkgPresentEx(
if (foundVersion == NULL) {
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
- NULL);
+ (char *)NULL);
}
return foundVersion;
}
@@ -844,7 +840,7 @@ Tcl_PkgPresentEx(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"package %s is not present", name));
}
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, (char *)NULL);
return NULL;
}
@@ -1512,7 +1508,7 @@ CheckVersionAndConvert(
ckfree(ibuf);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected version number but got \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", (char *)NULL);
return TCL_ERROR;
}
@@ -1775,7 +1771,7 @@ CheckRequirement(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected versionMin-versionMax but got \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", (char *)NULL);
return TCL_ERROR;
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 80d4c32..70cfbda 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -148,14 +148,14 @@ Tcl_ProcObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
procName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
return TCL_ERROR;
}
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
procName));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
return TCL_ERROR;
}
@@ -463,7 +463,7 @@ TclCreateProc(
"precompiled header expects %d", procName, numArgs,
procPtr->numArgs));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", NULL);
+ "BYTECODELIES", (char *)NULL);
goto procError;
}
localPtr = procPtr->firstLocalPtr;
@@ -493,14 +493,14 @@ TclCreateProc(
Tcl_AppendToObj(errorObj, "\"", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", NULL);
+ "FORMALARGUMENTFORMAT", (char *)NULL);
goto procError;
}
if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", NULL);
+ "FORMALARGUMENTFORMAT", (char *)NULL);
goto procError;
}
@@ -517,7 +517,7 @@ TclCreateProc(
"formal parameter \"%s\" is an array element",
TclGetString(fieldValues[0])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", NULL);
+ "FORMALARGUMENTFORMAT", (char *)NULL);
goto procError;
}
} else if (p[0] == ':' && p[1] == ':') {
@@ -527,7 +527,7 @@ TclCreateProc(
Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "FORMALARGUMENTFORMAT", NULL);
+ "FORMALARGUMENTFORMAT", (char *)NULL);
goto procError;
}
p++;
@@ -555,7 +555,7 @@ TclCreateProc(
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", NULL);
+ "BYTECODELIES", (char *)NULL);
goto procError;
}
@@ -580,7 +580,7 @@ TclCreateProc(
"default value inconsistent with precompiled body", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "BYTECODELIES", NULL);
+ "BYTECODELIES", (char *)NULL);
goto procError;
}
}
@@ -731,7 +731,7 @@ TclGetFrame(
levelError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", (char *)NULL);
return -1;
}
@@ -833,7 +833,7 @@ TclObjGetFrame(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (char *)NULL);
return -1;
}
@@ -1087,7 +1087,7 @@ ProcWrongNumArgs(
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
- Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+ Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (char *)NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
@@ -1859,7 +1859,7 @@ InterpProcNR2(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invoked \"%s\" outside of a loop",
((result == TCL_BREAK) ? "break" : "continue")));
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (char *)NULL);
result = TCL_ERROR;
/* FALLTHRU */
@@ -1941,7 +1941,7 @@ TclProcCompileProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"a precompiled script jumped interps", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
- "CROSSINTERPBYTECODE", NULL);
+ "CROSSINTERPBYTECODE", (char *)NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
@@ -2446,7 +2446,7 @@ SetLambdaFromAny(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
TclGetString(objPtr)));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
return TCL_ERROR;
}
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 3259b48..9620bb9 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -732,7 +732,7 @@ TclRegError(
snprintf(cbuf, sizeof(cbuf), "%d", status);
(void) TclReError(REG_ITOA, cbuf, sizeof(cbuf));
- Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
+ Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, (char *)NULL);
}
/*
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 4b8775a..7364f3f 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1334,7 +1334,7 @@ TclProcessReturn(
if (valuePtr != NULL) {
Tcl_SetObjErrorCode(interp, valuePtr);
} else {
- Tcl_SetErrorCode(interp, "NONE", NULL);
+ Tcl_SetErrorCode(interp, "NONE", (char *)NULL);
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
@@ -1416,7 +1416,7 @@ TclMergeReturnOptions(
"bad %s value: expected dictionary but got \"%s\"",
compare, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
- NULL);
+ (char *)NULL);
goto error;
}
@@ -1465,7 +1465,7 @@ TclMergeReturnOptions(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad -level value: expected non-negative integer but got"
" \"%s\"", TclGetString(valuePtr)));
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", (char *)NULL);
goto error;
}
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
@@ -1488,7 +1488,7 @@ TclMergeReturnOptions(
"bad -errorcode value: expected a list but got \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
- NULL);
+ (char *)NULL);
goto error;
}
}
@@ -1510,7 +1510,7 @@ TclMergeReturnOptions(
"bad -errorstack value: expected a list but got \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
- NULL);
+ (char *)NULL);
goto error;
}
if (length % 2) {
@@ -1522,7 +1522,7 @@ TclMergeReturnOptions(
"forbidden odd-sized list for -errorstack: \"%s\"",
TclGetString(valuePtr)));
Tcl_SetErrorCode(interp, "TCL", "RESULT",
- "ODDSIZEDLIST_ERRORSTACK", NULL);
+ "ODDSIZEDLIST_ERRORSTACK", (char *)NULL);
goto error;
}
}
@@ -1675,7 +1675,7 @@ Tcl_SetReturnOptions(
|| (objc % 2)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected dict but got \"%s\"", TclGetString(options)));
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", (char *)NULL);
code = TCL_ERROR;
} else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
&mergedOpts, &code, &level)) {
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 2861e0b..80f0f77 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -425,7 +425,7 @@ ValidateFormat(
if (flags & SCAN_BIG) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"unsigned bignum scans are invalid", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED", (char *)NULL);
goto error;
}
break;
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 12fe4ee..432d11b 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1311,10 +1311,10 @@ TclParseNumber(
objPtr->typePtr = &tclWideIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) (-octalSignificandWide);
+ (Tcl_WideInt)(-octalSignificandWide);
} else {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) octalSignificandWide;
+ (Tcl_WideInt)octalSignificandWide;
}
break;
}
@@ -1358,10 +1358,10 @@ TclParseNumber(
objPtr->typePtr = &tclWideIntType;
if (signum) {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) (-significandWide);
+ (Tcl_WideInt)(-significandWide);
} else {
objPtr->internalRep.wideValue =
- (Tcl_WideInt) significandWide;
+ (Tcl_WideInt)significandWide;
}
break;
}
@@ -1481,7 +1481,7 @@ TclParseNumber(
Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
}
Tcl_SetObjResult(interp, msg);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (char *)NULL);
}
}
@@ -2067,7 +2067,7 @@ RefineApproximation(
*/
if (roundToEven) {
rteSignificand = frexp(approxResult, &rteExponent);
- rteSigWide = (Tcl_WideInt) ldexp(rteSignificand, FP_PRECISION);
+ rteSigWide = ldexp(rteSignificand, FP_PRECISION);
if ((rteSigWide & 1) == 0) {
mp_clear(&twoMd);
mp_clear(&twoMv);
@@ -4693,7 +4693,7 @@ Tcl_InitBignumFromDouble(
const char *s = "integer value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, (char *)NULL);
}
return TCL_ERROR;
}
@@ -4703,7 +4703,7 @@ Tcl_InitBignumFromDouble(
mp_init(b);
mp_zero(b);
} else {
- Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
+ Tcl_WideInt w = ldexp(fract, mantBits);
int shift = expt - mantBits;
TclBNInitBignumFromWideInt(b, w);
@@ -4852,7 +4852,7 @@ TclCeil(
mp_int b;
mp_init(&b);
- if (mp_cmp_d(a, 0) == MP_LT) {
+ if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclFloor(&b);
} else {
@@ -4909,7 +4909,7 @@ TclFloor(
mp_int b;
mp_init(&b);
- if (mp_cmp_d(a, 0) == MP_LT) {
+ if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclCeil(&b);
} else {
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index dcff811..c7812b6 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1,34 +1,32 @@
/*
* tclStringObj.c --
*
- * This file contains functions that implement string operations on Tcl
- * objects. Some string operations work with UTF strings and others
- * require Unicode format. Functions that require knowledge of the width
- * of each character, such as indexing, operate on Unicode data.
- *
- * A Unicode string is an internationalized string. Conceptually, a
- * Unicode string is an array of 16-bit quantities organized as a
- * sequence of properly formed UTF-8 characters. There is a one-to-one
- * map between Unicode and UTF characters. Because Unicode characters
- * have a fixed width, operations such as indexing operate on Unicode
- * data. The String object is optimized for the case where each UTF char
+ * This file contains functions that implement string operations on Tcl
+ * objects. Some string operations work with UTF-8 encoding forms.
+ * Functions that require knowledge of the width of each character,
+ * such as indexing, operate on fixed width encoding forms such as UTF-16.
+ *
+ * Conceptually, a string is a sequence of Unicode code points. Internally
+ * it may be stored in an encoding form such as a modified version of
+ * UTF-8 or UTF-16.
+ *
+ * The String object is optimized for the case where each UTF char
* in a string is only one byte. In this case, we store the value of
- * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
- * is explicitly called).
+ * numChars, but we don't store the fixed form encoding (unless
+ * Tcl_GetUnicode is explicitly called).
*
- * The String object type stores one or both formats. The default
- * behavior is to store UTF. Once Unicode is calculated by a function, it
- * is stored in the internal rep for future access (without an additional
- * O(n) cost).
+ * The String object type stores one or both formats. The default
+ * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is
+ * stored in the internal rep for future access (without an additional
+ * O(n) cost).
*
* To allow many appends to be done to an object without constantly
- * reallocating the space for the string or Unicode representation, we
- * allocate double the space for the string or Unicode and use the
+ * reallocating space, we allocate double the space and use the
* internal representation to keep track of how much space is used vs.
* allocated.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright (c) 1999 by Scriptics Corporation.
+ * Copyright (c) 1999 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -121,8 +119,8 @@ const Tcl_ObjType tclStringType = {
static void
GrowStringBuffer(
Tcl_Obj *objPtr,
- int needed,
- int flag)
+ int needed, /* Not including terminating nul */
+ int flag) /* If 0, try to overallocate */
{
/*
* Preconditions:
@@ -238,7 +236,7 @@ GrowUnicodeBuffer(
*
* Side effects:
* The new object's internal string representation will be set to a copy
- * of the length bytes starting at "bytes". If "length" is negative, use
+ * of the length bytes starting at "bytes". If "length" is -1, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
@@ -252,9 +250,9 @@ Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- int length) /* The number of bytes to copy from "bytes"
+ int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
- * negative, use bytes up to the first NUL
+ * -1, use bytes up to the first NUL
* byte. */
{
return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
@@ -265,7 +263,7 @@ Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length) /* The number of bytes to copy from "bytes"
- * when initializing the new object. If negative,
+ * when initializing the new object. If -1,
* use bytes up to the first NUL byte. */
{
Tcl_Obj *objPtr;
@@ -299,7 +297,7 @@ Tcl_NewStringObj(
*
* Side effects:
* The new object's internal string representation will be set to a copy
- * of the length bytes starting at "bytes". If "length" is negative, use
+ * of the length bytes starting at "bytes". If "length" is -1, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
@@ -313,7 +311,7 @@ Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length, /* The number of bytes to copy from "bytes"
- * when initializing the new object. If negative,
+ * when initializing the new object. If -1,
* use bytes up to the first NUL byte. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
@@ -334,10 +332,9 @@ Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
- int length, /* The number of bytes to copy from "bytes"
- * when initializing the new object. If
- * negative, use bytes up to the first NUL
- * byte. */
+ int length, /* The number of bytes to copy from "bytes"
+ * when initializing the new object. If -1,
+ * use bytes up to the first NUL byte. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
@@ -415,7 +412,7 @@ Tcl_GetCharLength(
}
/*
- * Optimize the case where we're really dealing with a ByteArray object;
+ * Optimize the case where we're really dealing with a bytearray object;
* we don't need to convert to a string to perform the get-length operation.
*
* NOTE that we do not need the ByteArray to be "pure". A ByteArray value
@@ -468,7 +465,7 @@ Tcl_GetCharLength(
*----------------------------------------------------------------------
*/
int
-TclCheckEmptyString (
+TclCheckEmptyString(
Tcl_Obj *objPtr)
{
int length = -1;
@@ -723,9 +720,9 @@ Tcl_GetUnicodeFromObj(
*
* Create a Tcl Object that contains the chars between first and last of
* the object indicated by "objPtr". If the object is not already a
- * String object, convert it to one. If first is negative, the
+ * String object, convert it to one. If first is -1, the
* returned string start at the beginning of objPtr. If last is
- * negative, the returned string ends at the end of objPtr.
+ * -1, the returned string ends at the end of objPtr.
*
* Results:
* Returns a new Tcl Object of the String type.
@@ -751,7 +748,7 @@ Tcl_GetRange(
}
/*
- * Optimize the case where we're really dealing with a ByteArray object
+ * Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
*/
@@ -805,7 +802,6 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
-
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
@@ -841,7 +837,7 @@ Tcl_GetRange(
*
* Side effects:
* The object's string representation will be set to a copy of the
- * "length" bytes starting at "bytes". If "length" is negative, use bytes
+ * "length" bytes starting at "bytes". If "length" is -1, use bytes
* up to the first NUL byte; i.e., assume "bytes" points to a C-style
* NUL-terminated string. The object's old string and internal
* representations are freed and the object's type is set NULL.
@@ -854,8 +850,8 @@ Tcl_SetStringObj(
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
- int length) /* The number of bytes to copy from "bytes"
- * when initializing the object. If negative,
+ int length) /* The number of bytes to copy from "bytes"
+ * when initializing the object. If -1,
* use bytes up to the first NUL byte.*/
{
if (Tcl_IsShared(objPtr)) {
@@ -891,12 +887,11 @@ Tcl_SetStringObj(
* None.
*
* Side effects:
- * If the size of objPtr's string representation is greater than length,
- * then it is reduced to length and a new terminating null byte is stored
- * in the strength. If the length of the string representation is greater
- * than length, the storage space is reallocated to the given length; a
- * null byte is stored at the end, but other bytes past the end of the
- * original string representation are undefined.
+ * If the size of objPtr's string representation is greater than length, a
+ * new terminating null byte is stored in objPtr->bytes at length, and
+ * bytes at positions past length have no meaning. If the length of the
+ * string representation is greater than length, the storage space is
+ * reallocated to length+1.
*
* The object's internal representation is changed to &tclStringType.
*
@@ -907,7 +902,7 @@ void
Tcl_SetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
- int length) /* Number of bytes desired for string
+ int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
@@ -1007,7 +1002,7 @@ int
Tcl_AttemptSetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
- int length) /* Number of bytes desired for string
+ int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
@@ -1195,10 +1190,10 @@ Tcl_AppendLimitedToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
- int length, /* The number of bytes available to be
- * appended from "bytes". If < 0, then all
- * bytes up to a NUL byte are available. */
- int limit, /* The maximum number of bytes to append to
+ int length, /* The number of bytes available to be
+ * appended from "bytes". If -1, then
+ * all bytes up to a NUL byte are available. */
+ int limit, /* The maximum number of bytes to append to
* the object. */
const char *ellipsis) /* Ellipsis marker string, appended to the
* object to indicate not all available bytes
@@ -1507,7 +1502,7 @@ static void
AppendUnicodeToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
- int appendNumChars) /* Number of chars of "unicode" to append. */
+ int appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
int numChars;
@@ -1596,7 +1591,7 @@ static void
AppendUnicodeToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to convert to UTF. */
- int numChars) /* Number of chars of unicode to convert. */
+ int numChars) /* Number of chars of Unicode to convert. */
{
String *stringPtr = GET_STRING(objPtr);
@@ -1876,7 +1871,7 @@ Tcl_AppendFormatToObj(
if (Tcl_IsShared(appendObj)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
}
- TclGetStringFromObj(appendObj, &originalLength);
+ (void)TclGetStringFromObj(appendObj, &originalLength);
limit = INT_MAX - originalLength;
/*
@@ -2164,7 +2159,7 @@ Tcl_AppendFormatToObj(
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
- isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ isNegative = mp_isneg(&big);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
@@ -2179,7 +2174,7 @@ Tcl_AppendFormatToObj(
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
Tcl_DecrRefCount(objPtr);
}
- isNegative = (w < (Tcl_WideInt) 0);
+ isNegative = (w < 0);
#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
@@ -2332,14 +2327,14 @@ Tcl_AppendFormatToObj(
if (useShort) {
unsigned short us = (unsigned short) s;
- bits = (Tcl_WideUInt) us;
+ bits = (Tcl_WideUInt)us;
while (us) {
numDigits++;
us /= base;
}
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
- Tcl_WideUInt uw = (Tcl_WideUInt) w;
+ Tcl_WideUInt uw = (Tcl_WideUInt)w;
bits = uw;
while (uw) {
@@ -2347,12 +2342,12 @@ Tcl_AppendFormatToObj(
uw /= base;
}
#endif
- } else if (useBig && big.used) {
+ } else if (useBig && !mp_iszero(&big)) {
int leftover = (big.used * MP_DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover);
numDigits = 1 +
- (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits);
+ (((Tcl_WideInt)big.used * MP_DIGIT_BIT) / numBits);
while ((mask & big.dp[big.used-1]) == 0) {
numDigits--;
mask >>= numBits;
@@ -2365,7 +2360,7 @@ Tcl_AppendFormatToObj(
} else if (!useBig) {
unsigned long ul = (unsigned long) l;
- bits = (Tcl_WideUInt) ul;
+ bits = (Tcl_WideUInt)ul;
while (ul) {
numDigits++;
ul /= base;
@@ -2380,16 +2375,16 @@ Tcl_AppendFormatToObj(
numDigits = 1;
}
TclNewObj(pure);
- Tcl_SetObjLength(pure, numDigits);
+ Tcl_SetObjLength(pure, (int)numDigits);
bytes = TclGetString(pure);
toAppend = length = numDigits;
while (numDigits--) {
int digitOffset;
- if (useBig && big.used) {
+ if (useBig && !mp_iszero(&big)) {
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
- bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
+ bits |= ((Tcl_WideUInt)big.dp[index++]) << shift;
shift += MP_DIGIT_BIT;
}
shift -= numBits;
@@ -2535,7 +2530,7 @@ Tcl_AppendFormatToObj(
}
}
- TclGetStringFromObj(segment, &segmentNumBytes);
+ (void)TclGetStringFromObj(segment, &segmentNumBytes);
if (segmentNumBytes > limit) {
if (allocSegment) {
Tcl_DecrRefCount(segment);
@@ -2640,7 +2635,7 @@ NewLongObj(
mp_init_u64(&bignumValue, (unsigned long)value);
return Tcl_NewBignumObj(&bignumValue);
#else
- return Tcl_NewWideIntObj((unsigned long)value | ~(unsigned long)LONG_MAX);
+ return Tcl_NewWideIntObj((unsigned long)value);
#endif
}
return Tcl_NewLongObj(value);
@@ -2878,9 +2873,9 @@ TclGetStringStorage(
* Implements the [string reverse] operation.
*
* Results:
- * An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be the
- * argument with modifications done in place.
+ * A Tcl value which is the [string reverse] of the argument supplied.
+ * When sharing rules permit and the caller requests, the returned value
+ * might be the argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -2892,7 +2887,7 @@ static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
- int count) /* Until this many are copied, */
+ int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
@@ -3109,7 +3104,7 @@ ExtendUnicodeRepWithString(
} else {
numAppendChars = 0;
}
- for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
+ for (dst = stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
bytes += TclUtfToUniChar(bytes, &unichar);
*dst = unichar;
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 21c6d65..491fea0 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1397,7 +1397,7 @@ CreatedCommandProc(
&info);
if (!found) {
Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "CreatedCommandProc in ",
@@ -1418,7 +1418,7 @@ CreatedCommandProc2(
found = Tcl_GetCommandInfo(interp, "value:at:", &info);
if (!found) {
Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
@@ -1769,7 +1769,7 @@ TestdstringCmd(
} else {
Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
"\": must be staticsmall, staticlarge, free, or special",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
Tcl_DStringGetResult(interp, &dstring);
@@ -2906,7 +2906,7 @@ TestgetplatformCmd(
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
@@ -3295,7 +3295,7 @@ TestlinkCmd(
return TCL_ERROR;
}
Tcl_DecrRefCount(tmp);
- uwideVar = (Tcl_WideUInt) w;
+ uwideVar = (Tcl_WideUInt)w;
}
} else if (strcmp(argv[1], "update") == 0) {
int v;
@@ -3412,7 +3412,7 @@ TestlinkCmd(
return TCL_ERROR;
}
Tcl_DecrRefCount(tmp);
- uwideVar = (Tcl_WideUInt) w;
+ uwideVar = (Tcl_WideUInt)w;
Tcl_UpdateLinkedVar(interp, "uwide");
}
} else {
@@ -4639,23 +4639,23 @@ TestseterrorcodeCmd(
}
switch (argc) {
case 1:
- Tcl_SetErrorCode(interp, "NONE", NULL);
+ Tcl_SetErrorCode(interp, "NONE", (char *)NULL);
break;
case 2:
- Tcl_SetErrorCode(interp, argv[1], NULL);
+ Tcl_SetErrorCode(interp, argv[1], (char *)NULL);
break;
case 3:
- Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
+ Tcl_SetErrorCode(interp, argv[1], argv[2], (char *)NULL);
break;
case 4:
- Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], (char *)NULL);
break;
case 5:
- Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
+ Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], (char *)NULL);
break;
case 6:
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
- argv[5], NULL);
+ argv[5], (char *)NULL);
}
return TCL_ERROR;
}
@@ -4735,7 +4735,7 @@ TestfeventCmd(
} else {
Tcl_AppendResult(interp,
"called \"testfevent code\" before \"testfevent create\"",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
} else if (strcmp(argv[1], "create") == 0) {
@@ -5983,7 +5983,7 @@ TestChannelCmd(
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
- (Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
+ (Tcl_WideInt)(size_t)Tcl_GetChannelThread(chan)));
return TCL_OK;
}
@@ -7614,7 +7614,7 @@ TestconcatobjCmd(
if (concatPtr == tmpPtr) {
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ",
- NULL);
+ (char *)NULL);
switch (tmpPtr->refCount) {
case 0:
Tcl_AppendResult(interp, "(no new refCount)", NULL);
@@ -7641,7 +7641,7 @@ TestconcatobjCmd(
if (concatPtr == tmpPtr) {
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ",
- NULL);
+ (char *)NULL);
switch (tmpPtr->refCount) {
case 0:
Tcl_AppendResult(interp, "(refCount removed?)", NULL);
@@ -7770,7 +7770,7 @@ TestconcatobjCmd(
if (concatPtr == tmpPtr) {
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
- NULL);
+ (char *)NULL);
(void) Tcl_ListObjLength(NULL, concatPtr, &len);
switch (tmpPtr->refCount) {
@@ -7801,7 +7801,7 @@ TestconcatobjCmd(
if (concatPtr == tmpPtr) {
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
- NULL);
+ (char *)NULL);
(void) Tcl_ListObjLength(NULL, concatPtr, &len);
switch (tmpPtr->refCount) {
@@ -8165,7 +8165,7 @@ TestInterpResolverCmd(
case 0: /*down*/
if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) {
Tcl_AppendResult(interp, "could not remove the resolver scheme",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
}
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 914c6f0..4d89a7e 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -290,9 +290,9 @@ TestbignumobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
+ Tcl_SetBooleanObj(varPtr[varIndex], mp_iszero(&bignumValue));
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue)));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(mp_iszero(&bignumValue)));
}
mp_clear(&bignumValue);
break;
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 1302b4e..0040d75 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -917,7 +917,7 @@ ThreadSend(
if (resultPtr->code != TCL_OK) {
if (resultPtr->errorCode) {
- Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
+ Tcl_SetErrorCode(interp, resultPtr->errorCode, (char *)NULL);
ckfree(resultPtr->errorCode);
}
if (resultPtr->errorInfo) {
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 3b8bcd6..2a71717 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -833,7 +833,7 @@ Tcl_AfterObjCmd(
"bad argument \"%s\": must be"
" cancel, idle, info, or an integer", arg));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
- arg, NULL);
+ arg, (char *)NULL);
return TCL_ERROR;
}
}
@@ -972,7 +972,7 @@ Tcl_AfterObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"event \"%s\" doesn't exist", eventStr));
- Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
+ Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, (char *)NULL);
return TCL_ERROR;
} else {
Tcl_Obj *resultListPtr;
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 8b5f2c3..11f3af4 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -372,7 +372,7 @@ Tcl_TraceObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad operations \"%s\": should be one or more of rwua",
flagOps));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", (char *)NULL);
return TCL_ERROR;
#endif
}
@@ -443,7 +443,7 @@ TraceExecutionObjCmd(
"bad operation list \"\": must be one or more of"
" enter, leave, enterstep, or leavestep", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
for (i = 0; i < listLen; i++) {
@@ -684,7 +684,7 @@ TraceCommandObjCmd(
"bad operation list \"\": must be one or more of"
" delete or rename", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
@@ -883,7 +883,7 @@ TraceVariableObjCmd(
"bad operation list \"\": must be one or more of"
" array, read, unset, or write", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
for (i = 0; i < listLen ; i++) {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 9cf594f..0d2df75 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -652,7 +652,7 @@ FindElement(
"%s element in braces followed by \"%.*s\" "
"instead of space", typeStr, (int) (p2-p), p));
Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -704,7 +704,7 @@ FindElement(
"%s element in quotes followed by \"%.*s\" "
"instead of space", typeStr, (int) (p2-p), p));
Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -737,7 +737,7 @@ FindElement(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unmatched open brace in %s", typeStr));
Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
} else if (inQuotes) {
@@ -745,7 +745,7 @@ FindElement(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unmatched open quote in %s", typeStr));
Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -892,7 +892,7 @@ Tcl_SplitList(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"internal error in Tcl_SplitList", -1));
Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -3698,7 +3698,7 @@ TclGetIntForIndex(
bytes += 4;
}
TclCheckBadOctal(interp, bytes);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
}
return TCL_ERROR;
@@ -3822,7 +3822,7 @@ SetEndOffsetFromAny(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be end?[+-]integer?", bytes));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3858,7 +3858,7 @@ SetEndOffsetFromAny(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be end?[+-]integer?", bytes));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", (char *)NULL);
}
return TCL_ERROR;
}
@@ -4212,6 +4212,7 @@ TclSetProcessGlobalValue(
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
int dummy;
+ Tcl_DString ds;
Tcl_MutexLock(&pgvPtr->mutex);
@@ -4226,8 +4227,11 @@ TclSetProcessGlobalValue(
Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
bytes = TclGetStringFromObj(newValue, &pgvPtr->numBytes);
+ Tcl_UtfToExternalDString(encoding, bytes, pgvPtr->numBytes, &ds);
+ pgvPtr->numBytes = Tcl_DStringLength(&ds);
pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1);
- memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
+ memcpy(pgvPtr->value, Tcl_DStringValue(&ds), pgvPtr->numBytes + 1);
+ Tcl_DStringFree(&ds);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
@@ -4269,6 +4273,7 @@ TclGetProcessGlobalValue(
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
int epoch = pgvPtr->epoch;
+ Tcl_DString newValue;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
@@ -4280,7 +4285,7 @@ TclGetProcessGlobalValue(
* system encoding.
*/
- Tcl_DString native, newValue;
+ Tcl_DString native;
Tcl_MutexLock(&pgvPtr->mutex);
epoch = ++pgvPtr->epoch;
@@ -4330,10 +4335,12 @@ TclGetProcessGlobalValue(
}
/*
- * Store a copy of the shared value in our epoch-indexed cache.
+ * Store a copy of the shared value (but then in utf-8)
+ * in our epoch-indexed cache.
*/
- value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
+ Tcl_ExternalToUtfDString(NULL, pgvPtr->value, pgvPtr->numBytes, &newValue);
+ value = TclDStringToObj(&newValue);
hPtr = Tcl_CreateHashEntry(cacheMap,
INT2PTR(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
@@ -4694,7 +4701,7 @@ TclReToGlob(
invalidGlob:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
- Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, (char *)NULL);
}
Tcl_DStringFree(dsPtr);
return TCL_ERROR;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 5cc1f3a..428cc0c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -302,7 +302,7 @@ NotArrayError(
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL);
return TCL_ERROR;
}
@@ -611,7 +611,7 @@ TclObjLookupVarEx(
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
NOSUCHVAR, -1);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", (char *)NULL);
}
return NULL;
}
@@ -647,7 +647,7 @@ TclObjLookupVarEx(
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
NEEDARRAY, -1);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
- NULL);
+ (char *)NULL);
}
return NULL;
}
@@ -713,7 +713,7 @@ TclObjLookupVarEx(
if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- TclGetString(part1Ptr), NULL);
+ TclGetString(part1Ptr), (char *)NULL);
}
if (newPart2) {
Tcl_DecrRefCount(part2Ptr);
@@ -1086,7 +1086,7 @@ TclLookupArrayElement(
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
NOSUCHVAR, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
}
return NULL;
}
@@ -1101,7 +1101,7 @@ TclLookupArrayElement(
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
DANGLINGVAR, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
}
return NULL;
}
@@ -1121,7 +1121,7 @@ TclLookupArrayElement(
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+ arrayNamePtr?TclGetString(arrayNamePtr):NULL, (char *)NULL);
}
return NULL;
}
@@ -1142,7 +1142,7 @@ TclLookupArrayElement(
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
NOSUCHELEMENT, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
- TclGetString(elNamePtr), NULL);
+ TclGetString(elNamePtr), (char *)NULL);
}
}
}
@@ -1481,7 +1481,7 @@ TclPtrGetVarIdx(
*/
errorReturn:
- Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", (char *)NULL);
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
}
@@ -1884,11 +1884,11 @@ TclPtrSetVarIdx(
if (TclIsVarArrayElement(varPtr)) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
DANGLINGELEMENT, index);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", (char *)NULL);
} else {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
DANGLINGVAR, index);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", (char *)NULL);
}
}
goto earlyError;
@@ -1901,7 +1901,7 @@ TclPtrSetVarIdx(
if (TclIsVarArray(varPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
}
goto earlyError;
}
@@ -2025,7 +2025,7 @@ TclPtrSetVarIdx(
cleanup:
if (resultPtr == NULL) {
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", (char *)NULL);
}
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
@@ -2498,7 +2498,7 @@ TclPtrUnsetVarIdx(
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
- Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", (char *)NULL);
}
}
@@ -3683,7 +3683,7 @@ ArraySetCmd(
CleanupVar(varPtr, arrayPtr);
TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- TclGetString(arrayNameObj), NULL);
+ TclGetString(arrayNameObj), (char *)NULL);
return TCL_ERROR;
}
@@ -3750,7 +3750,7 @@ ArraySetCmd(
if (elemLen & 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"list must have an even number of elements", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", (char *)NULL);
return TCL_ERROR;
}
if (elemLen == 0) {
@@ -3801,7 +3801,7 @@ ArraySetCmd(
TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
NEEDARRAY, -1);
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
return TCL_ERROR;
}
}
@@ -4185,7 +4185,7 @@ ObjMakeUpvar(
"bad variable name \"%s\": can't create namespace "
"variable that refers to procedure variable",
TclGetString(myNamePtr)));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);
return TCL_ERROR;
}
}
@@ -4301,7 +4301,7 @@ TclPtrObjMakeUpvarIdx(
"bad variable name \"%s\": can't create a scalar "
"variable that looks like an array element", myName));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
- NULL);
+ (char *)NULL);
return TCL_ERROR;
}
}
@@ -4320,7 +4320,7 @@ TclPtrObjMakeUpvarIdx(
if (varPtr == NULL) {
TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- TclGetString(myNamePtr), NULL);
+ TclGetString(myNamePtr), (char *)NULL);
return TCL_ERROR;
}
}
@@ -4328,14 +4328,14 @@ TclPtrObjMakeUpvarIdx(
if (varPtr == otherPtr) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
"can't upvar from variable to itself", -1));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", (char *)NULL);
return TCL_ERROR;
}
if (TclIsVarTraced(varPtr)) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"variable \"%s\" has traces: can't use for upvar", myName));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", (char *)NULL);
return TCL_ERROR;
} else if (!TclIsVarUndefined(varPtr)) {
Var *linkPtr;
@@ -4350,7 +4350,7 @@ TclPtrObjMakeUpvarIdx(
if (!TclIsVarLink(varPtr)) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"variable \"%s\" already exists", myName));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", (char *)NULL);
return TCL_ERROR;
}
@@ -4700,7 +4700,7 @@ Tcl_VariableObjCmd(
TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
ISARRAYELEMENT, -1);
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (char *)NULL);
return TCL_ERROR;
}
@@ -4851,7 +4851,7 @@ Tcl_UpvarObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(levelObj)));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
- TclGetString(levelObj), NULL);
+ TclGetString(levelObj), (char *)NULL);
return TCL_ERROR;
}
@@ -4943,7 +4943,7 @@ SetArraySearchObj(
syntax:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"illegal search identifier \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, (char *)NULL);
return TCL_ERROR;
}
@@ -5037,7 +5037,7 @@ ParseSearchId(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't find search \"%s\"", string));
badLookup:
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, (char *)NULL);
return NULL;
}
@@ -5742,7 +5742,7 @@ ObjFindNamespaceVar(
if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown variable \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, (char *)NULL);
}
return (Tcl_Var) varPtr;
}
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 4b0332b..0ecc0cf 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -385,7 +385,7 @@ ConvertErrorToList(
* GenerateHeader --
*
* Function for creating a gzip header from the contents of a dictionary
- * (as described in the documentation). GetValue is a helper function.
+ * (as described in the documentation).
*
* Results:
* A Tcl result code.
@@ -398,20 +398,6 @@ ConvertErrorToList(
*----------------------------------------------------------------------
*/
-static inline int
-GetValue(
- Tcl_Interp *interp,
- Tcl_Obj *dictObj,
- const char *nameStr,
- Tcl_Obj **valuePtrPtr)
-{
- Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
- int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);
-
- TclDecrRefCount(name);
- return result;
-}
-
static int
GenerateHeader(
Tcl_Interp *interp, /* Where to put error messages. */
@@ -438,7 +424,7 @@ GenerateHeader(
Tcl_Panic("no latin-1 encoding");
}
- if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "comment", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
Tcl_EncodingState state;
@@ -465,14 +451,14 @@ GenerateHeader(
}
}
- if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "crc", &value) != TCL_OK) {
goto error;
} else if (value != NULL &&
Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
goto error;
}
- if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "filename", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
Tcl_EncodingState state;
@@ -499,7 +485,7 @@ GenerateHeader(
}
}
- if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "os", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetIntFromObj(interp, value,
&headerPtr->header.os) != TCL_OK) {
@@ -511,14 +497,14 @@ GenerateHeader(
* input data.
*/
- if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "time", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetLongFromObj(interp, value,
(long *) &headerPtr->header.time) != TCL_OK) {
goto error;
}
- if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
+ if (TclDictGet(interp, dictObj, "type", &value) != TCL_OK) {
goto error;
} else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
"type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
@@ -548,9 +534,6 @@ GenerateHeader(
*----------------------------------------------------------------------
*/
-#define SetValue(dictObj, key, value) \
- Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))
-
static void
ExtractHeader(
gz_header *headerPtr, /* The gzip header to extract from. */
@@ -573,9 +556,9 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
&tmp);
- SetValue(dictObj, "comment", TclDStringToObj(&tmp));
+ TclDictPut(NULL, dictObj, "comment", TclDStringToObj(&tmp));
}
- SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
+ TclDictPut(NULL, dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
if (headerPtr->name != Z_NULL) {
if (latin1enc == NULL) {
/*
@@ -590,17 +573,18 @@ ExtractHeader(
Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
&tmp);
- SetValue(dictObj, "filename", TclDStringToObj(&tmp));
+ TclDictPut(NULL, dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
- SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ TclDictPut(NULL, dictObj, "os", Tcl_NewIntObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
- SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
+ TclDictPut(NULL, dictObj, "time",
+ Tcl_NewLongObj((long) headerPtr->time));
}
if (headerPtr->text != Z_UNKNOWN) {
- SetValue(dictObj, "type",
- Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
+ TclDictPutString(NULL, dictObj, "type",
+ headerPtr->text ? "text" : "binary");
}
if (latin1enc != NULL) {
@@ -1889,7 +1873,7 @@ Tcl_ZlibInflate(
Tcl_SetByteArrayLength(obj, stream.total_out);
if (headerPtr != NULL) {
ExtractHeader(&header, gzipHeaderDictObj);
- SetValue(gzipHeaderDictObj, "size",
+ TclDictPut(NULL, gzipHeaderDictObj, "size",
Tcl_NewLongObj(stream.total_out));
ckfree(nameBuf);
ckfree(commentBuf);
@@ -1996,7 +1980,7 @@ ZlibCmd(
start = Tcl_ZlibAdler32(0, NULL, 0);
}
data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(uLong) Tcl_ZlibAdler32(start, data, dlen)));
return TCL_OK;
case CMD_CRC: /* crc32 str ?startvalue?
@@ -2013,7 +1997,7 @@ ZlibCmd(
start = Tcl_ZlibCRC32(0, NULL, 0);
}
data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(uLong) Tcl_ZlibCRC32(start, data, dlen)));
return TCL_OK;
case CMD_DEFLATE: /* deflate data ?level?
@@ -2659,7 +2643,7 @@ ZlibStreamCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(uLong) Tcl_ZlibStreamChecksum(zstream)));
return TCL_OK;
case zs_reset: /* $strm reset */
diff --git a/library/history.tcl b/library/history.tcl
index f06ffc9..79b7604 100644
--- a/library/history.tcl
+++ b/library/history.tcl
@@ -197,7 +197,7 @@ proc ::tcl::HistInfo {{count {}}} {
if {![info exists history($i)]} {
continue
}
- set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
+ set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
append result $newline[format "%6d %s" $i $cmd]
set newline \n
}
diff --git a/library/http/http.tcl b/library/http/http.tcl
index fb256a3..5dcd76c 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -281,9 +281,8 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
# 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)] && ("close" in $state(connection)))
+ } elseif {([info exists state(-keepalive)] && !$state(-keepalive))
+ || ([info exists state(connection)] && ("close" in $state(connection)))
} {
set closeQueue 1
set connId $state(socketinfo)
@@ -772,7 +771,7 @@ proc http::geturl {url args} {
if {[regexp -- $pat $flag]} {
# Validate numbers
if { [info exists type($flag)]
- && (![string is $type($flag) -strict $value])
+ && (![string is $type($flag) -strict $value])
} {
unset $token
return -code error \
@@ -1697,9 +1696,9 @@ proc http::ReceiveResponse {token} {
coroutine ${token}EventCoroutine http::Event $sock $token
if {[info exists state(-handler)] || [info exists state(-progress)]} {
- fileevent $sock readable [list http::EventGateway $sock $token]
+ fileevent $sock readable [list http::EventGateway $sock $token]
} else {
- fileevent $sock readable ${token}EventCoroutine
+ fileevent $sock readable ${token}EventCoroutine
}
return
}
@@ -1725,15 +1724,15 @@ proc http::EventGateway {sock token} {
fileevent $sock readable {}
catch {${token}EventCoroutine} res opts
if {[info commands ${token}EventCoroutine] ne {}} {
- # The coroutine can be deleted by completion (a non-yield return), by
- # http::Finish (when there is a premature end to the transaction), by
- # http::reset or http::cleanup, or if the caller set option -channel
- # but not option -handler: in the last case reading from the socket is
- # now managed by commands ::http::Copy*, http::ReceiveChunked, and
- # http::make-transformation-chunked.
- #
- # Catch in case the coroutine has closed the socket.
- catch {fileevent $sock readable [list http::EventGateway $sock $token]}
+ # The coroutine can be deleted by completion (a non-yield return), by
+ # http::Finish (when there is a premature end to the transaction), by
+ # http::reset or http::cleanup, or if the caller set option -channel
+ # but not option -handler: in the last case reading from the socket is
+ # now managed by commands ::http::Copy*, http::ReceiveChunked, and
+ # http::make-transformation-chunked.
+ #
+ # Catch in case the coroutine has closed the socket.
+ catch {fileevent $sock readable [list http::EventGateway $sock $token]}
}
# If there was an error, re-throw it.
@@ -3379,10 +3378,10 @@ proc http::wait {token} {
proc http::formatQuery {args} {
if {[llength $args] % 2} {
- return \
- -code error \
- -errorcode [list HTTP BADARGCNT $args] \
- {Incorrect number of arguments, must be an even number.}
+ return \
+ -code error \
+ -errorcode [list HTTP BADARGCNT $args] \
+ {Incorrect number of arguments, must be an even number.}
}
set result ""
set sep ""
diff --git a/library/http1.0/http.tcl b/library/http1.0/http.tcl
index 8329de4..ce112d8 100644
--- a/library/http1.0/http.tcl
+++ b/library/http1.0/http.tcl
@@ -94,8 +94,8 @@ proc http_get { url args } {
meta {}
currentsize 0
totalsize 0
- type text/html
- body {}
+ type text/html
+ body {}
status ""
}
set options {-blocksize -channel -command -handler -headers \
diff --git a/library/init.tcl b/library/init.tcl
index a6745ab..e4e184f 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -611,12 +611,12 @@ proc auto_import {pattern} {
auto_load_index
foreach pattern $patternList {
- foreach name [array names auto_index $pattern] {
- if {([namespace which -command $name] eq "")
+ foreach name [array names auto_index $pattern] {
+ if {([namespace which -command $name] eq "")
&& ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {
- namespace inscope :: $auto_index($name)
- }
- }
+ namespace inscope :: $auto_index($name)
+ }
+ }
}
}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 851ad77..e112470 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -18,7 +18,7 @@ package provide msgcat 1.6.1
namespace eval msgcat {
namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
- mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
+ mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
mcpackageconfig mcpackagelocale
# Records the list of locales to search
@@ -460,7 +460,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
return -code error "wrong # args: should be\
\"[lrange [info level 0] 0 1]\""
}
- set locale [string tolower $locale]
+ set locale [string tolower $locale]
}
set ns [uplevel 1 {::namespace current}]
@@ -631,7 +631,7 @@ proc msgcat::mcpackageconfig {subcommand option {value ""}} {
\"[lrange [info level 0] 0 2] value\""
}
} elseif {$subcommand eq "set"} {
- return -code error\
+ return -code error\
"wrong # args: should be \"[lrange [info level 0] 0 2]\""
}
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 0a6cdfa..1aec83b 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -785,7 +785,7 @@ proc ::tcl::OptCheckType {arg type {typeArgs ""}} {
if {[regexp {^-(.+)$} $arg1 x type]} {
# flags/optValue as they are optional, need a "value",
# on the contrary, for a variable (non optional),
- # default value is pointless, 'cept for choices :
+ # default value is pointless, 'cept for choices :
if {$isflag || $isopt || ($type == "choice")} {
return [OptNewInst $state $varname $type $arg2 ""]
} else {
diff --git a/library/package.tcl b/library/package.tcl
index 33ee7aa..7b2b2e9 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -31,16 +31,16 @@ proc tcl::Pkg::CompareExtension {fileName {ext {}}} {
global tcl_platform
if {$ext eq ""} {set ext [info sharedlibextension]}
if {$tcl_platform(platform) eq "windows"} {
- return [string equal -nocase [file extension $fileName] $ext]
+ return [string equal -nocase [file extension $fileName] $ext]
} else {
- # Some unices add trailing numbers after the .so, so
- # we could have something like '.so.1.2'.
- set root $fileName
- while {1} {
- set currExt [file extension $root]
- if {$currExt eq $ext} {
- return 1
- }
+ # Some unices add trailing numbers after the .so, so
+ # we could have something like '.so.1.2'.
+ set root $fileName
+ while {1} {
+ set currExt [file extension $root]
+ if {$currExt eq $ext} {
+ return 1
+ }
# The current extension does not match; if it is not a numeric
# value, quit, as we are only looking to ignore version number
@@ -51,7 +51,7 @@ proc tcl::Pkg::CompareExtension {fileName {ext {}}} {
if {![string is integer -strict [string range $currExt 1 end]]} {
return 0
}
- set root [file rootname $root]
+ set root [file rootname $root]
}
}
}
diff --git a/library/platform/shell.tcl b/library/platform/shell.tcl
index 60d5b37..053ce53 100644
--- a/library/platform/shell.tcl
+++ b/library/platform/shell.tcl
@@ -131,7 +131,7 @@ proc ::platform::shell::RUN {shell code} {
set e [TEMP]
set code [catch {
- exec $shell $c 2> $e
+ exec $shell $c 2> $e
} res]
file delete $c
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 6603e3e..3b430b1 100644
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -2,8 +2,8 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.5 \
- [list load [file join $dir tclreg13g.dll] Registry]
+ [list load [file join $dir tclreg13g.dll] Registry]
} else {
package ifneeded registry 1.3.5 \
- [list load [file join $dir tclreg13.dll] Registry]
+ [list load [file join $dir tclreg13.dll] Registry]
}
diff --git a/library/safe.tcl b/library/safe.tcl
index 71c1e67..7a8fcdb 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -376,7 +376,7 @@ proc ::safe::InterpSetConfig {child access_path staticsok nestedok deletehook} {
# Prevent the addition of dirs on the tm list to the
# result if they are already known.
if {[dict exists $remap_access_path $dir]} {
- if {$firstpass} {
+ if {$firstpass} {
# $dir is in [::tcl::tm::list] and belongs in the slave_tm_path.
# Later passes handle subdirectories, which belong in the
# access path but not in the module path.
@@ -596,9 +596,9 @@ proc ::safe::interpDelete {child} {
# Safe Base sub-interpreter, so each one is deleted cleanly and not by
# the automatic mechanism built into [interp delete].
foreach sub [interp children $child] {
- if {[info exists ::safe::[VarName [list $child $sub]]]} {
- ::safe::interpDelete [list $child $sub]
- }
+ if {[info exists ::safe::[VarName [list $child $sub]]]} {
+ ::safe::interpDelete [list $child $sub]
+ }
}
# If the child has a cleanup hook registered, call it. Check the
@@ -991,6 +991,10 @@ proc ::safe::AliasSource {child args} {
::interp eval $child [list info script $file]
} msg opt]
if {$code == 0} {
+ # See [Bug 1d26e580cf]
+ if {[string index $contents 0] eq "\uFEFF"} {
+ set contents [string range $contents 1 end]
+ }
set code [catch {::interp eval $child $contents} msg opt]
set replacementMsg $msg
}
@@ -1192,14 +1196,14 @@ proc ::safe::AliasExeName {child} {
proc ::safe::RejectExcessColons {child} {
set stripped [regsub -all -- {:::*} $child ::]
if {[string range $stripped end-1 end] eq {::}} {
- return -code error {interpreter name must not end in "::"}
+ return -code error {interpreter name must not end in "::"}
}
if {$stripped ne $child} {
- set msg {interpreter name has excess colons in namespace separators}
- return -code error $msg
+ set msg {interpreter name has excess colons in namespace separators}
+ return -code error $msg
}
if {[string range $stripped 0 1] eq {::}} {
- return -code error {interpreter name must not begin "::"}
+ return -code error {interpreter name must not begin "::"}
}
return
}
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 2fc5838..168f521 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1158,15 +1158,15 @@ proc tcltest::SafeFetch {n1 n2 op} {
proc tcltest::Asciify {s} {
set print ""
foreach c [split $s ""] {
- if {(($c < "\x7F") && [string is print $c]) || ($c eq "\n")} {
- append print $c
- } elseif {$c < "\u0100"} {
- append print \\x[format %02X [scan $c %c]]
- } elseif {$c > "\uFFFF"} {
- append print \\U[format %08X [scan $c %c]]
- } else {
- append print \\u[format %04X [scan $c %c]]
- }
+ if {(($c < "\x7F") && [string is print $c]) || ($c eq "\n")} {
+ append print $c
+ } elseif {$c < "\u0100"} {
+ append print \\x[format %02X [scan $c %c]]
+ } elseif {$c > "\uFFFF"} {
+ append print \\U[format %08X [scan $c %c]]
+ } else {
+ append print \\u[format %04X [scan $c %c]]
+ }
}
return $print
}
diff --git a/library/tm.tcl b/library/tm.tcl
index ca68ce1..796d09f 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -335,7 +335,7 @@ proc ::tcl::tm::Defaults {} {
foreach ev [::list \
TCL${major}.${n}_TM_PATH \
TCL${major}_${n}_TM_PATH \
- ] {
+ ] {
if {![info exists env($ev)]} continue
foreach p [split $env($ev) $sep] {
path add $p
diff --git a/tests-perf/chan.perf.tcl b/tests-perf/chan.perf.tcl
index 56acccf..6bc9204 100644
--- a/tests-perf/chan.perf.tcl
+++ b/tests-perf/chan.perf.tcl
@@ -27,12 +27,12 @@ namespace path {::tclTestPerf}
proc _get_test_chan {{bufSize 4096}} {
lassign [chan pipe] ch wch;
- fconfigure $ch -translation binary -encoding utf-8 -buffersize $bufSize -buffering full
- fconfigure $wch -translation binary -encoding utf-8 -buffersize $bufSize -buffering full
+ fconfigure $ch -translation lf -encoding utf-8 -buffersize $bufSize -buffering full
+ fconfigure $wch -translation lf -encoding utf-8 -buffersize $bufSize -buffering full
exec [info nameofexecutable] -- $bufSize >@$wch << {
set bufSize [lindex $::argv end]
- fconfigure stdout -translation binary -encoding utf-8 -buffersize $bufSize -buffering full
+ fconfigure stdout -translation lf -encoding utf-8 -buffersize $bufSize -buffering full
set buf [string repeat test 1000]; # 4K
# write ~ 10*1M + 10*2M + 10*10M + 1*20M:
set i 0; while {$i < int((10*1e6 + 10*2e6 + 10*10e6 + 1*20e6)/4e3)} {
diff --git a/tests/chanio.test b/tests/chanio.test
index 0766c35..fb566d4 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -6649,7 +6649,7 @@ test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
set s0 [chan copy $f1 $f2]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
@@ -6680,8 +6680,8 @@ test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
- chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
+ chan configure $f2 -translation binary -blocking 0
chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6696,8 +6696,8 @@ test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
- chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
+ chan configure $f2 -translation binary -blocking 0
chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6712,8 +6712,8 @@ test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
- chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
+ chan configure $f2 -translation binary -blocking 0
chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6728,8 +6728,8 @@ test chan-io-52.6 {TclCopyChannel} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
- chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
+ chan configure $f2 -translation binary -blocking 0
set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6746,8 +6746,8 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
- chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
+ chan configure $f2 -translation binary -blocking 0
chan copy $f1 $f2
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
if {[file size $thisScript] == [file size $path(test1)]} {
@@ -6864,7 +6864,7 @@ test chan-io-53.2 {CopyData} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f1 -translation binary -blocking 0
chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
chan copy $f1 $f2 -command [namespace code {set s0}]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
diff --git a/tests/clock.test b/tests/clock.test
index b54d9f0..70d527e 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -36113,6 +36113,25 @@ test clock-46.4 {regression test - month thirteen} \
clock scan 20041301
} -result [clock scan 2005-01-01 -format %Y-%m-%d]
+test clock-46.5 {regression test - good time} \
+ -body {
+ # 12:01 apm are valid input strings...
+ list [clock scan "12:01 am" -base 0 -gmt 1] \
+ [clock scan "12:01 pm" -base 0 -gmt 1]
+ } -result {60 43260}
+test clock-46.6 {freescan: regression test - bad time} \
+ -body {
+ # 13:00 am/pm are invalid input strings...
+ list [clock scan "13:00 am" -base 0 -gmt 1] \
+ [clock scan "13:00 pm" -base 0 -gmt 1]
+ } -result {-1 -1}
+
+test clock-46.7 {regression test - switch day by large not-valid time, see bug [3ee8f1c2a785f4d8]} {
+ list [clock scan 23:59:59 -base 0 -gmt 1 -format %H:%M:%S] \
+ [clock scan 24:00:00 -base 0 -gmt 1 -format %H:%M:%S] \
+ [clock scan 48:00:00 -base 0 -gmt 1 -format %H:%M:%S]
+} {86399 86400 172800}
+
test clock-47.1 {regression test - four-digit time} {
clock scan 0012
} [clock scan 0012 -format %H%M]
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 526c261..614ec0f 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -22,8 +22,24 @@ testConstraint testchmod [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint time64bit [expr {
- $::tcl_platform(pointerSize) >= 8 ||
- [llength [info command testsize]] && [testsize st_mtime] >= 8
+ ([llength [info command testsize]] ?
+ [testsize st_mtime] : $::tcl_platform(pointerSize)) >= 8
+}]
+testConstraint filetime64bit [expr {
+ [testConstraint time64bit] && (
+ ![testConstraint unix] || [apply {{} {
+ # check whether disk may have 2038 problem, see [fd91b0ca09cb171f]:
+ set fn [makeFile "" foo.text]
+ if {[catch {
+ exec sh -c "TZ=:UTC LC_TIME=en_US touch -ma -t '207006290000' '$fn' && TZ=:UTC LC_TIME=en_US ls -l '$fn'"
+ } res]} {
+ #puts "Check constraint failed:\t$res"
+ set res {}
+ }
+ removeFile $fn
+ regexp {\mJun\s+29\s+2070\M} $res
+ }}]
+ )
}]
testConstraint linkDirectory [expr {
![testConstraint win] ||
@@ -1296,14 +1312,14 @@ test cmdAH-24.14.1 {
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error
# 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070:
-test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
+test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit filetime64bit} -setup {
set filename [makeFile "" foo.text]
} -body {
list [file atime $filename 3155760000] [file atime $filename]
} -cleanup {
removeFile $filename
} -result {3155760000 3155760000}
-test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
+test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit filetime64bit} -setup {
set filename [makeFile "" foo.text]
} -body {
list [file mtime $filename 3155760000] [file mtime $filename]
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index ff6efaa..cf63b9f 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -324,11 +324,15 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# todo: rewrite this if monotonic clock is provided resp. command "after"
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
proc _nrt_sleep {msec} {
- set usec [expr {$msec * 1000}]
set stime [clock microseconds]
- while {abs([clock microseconds] - $stime) < $usec} {
- # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise):
- # after 0
+ set usec [expr {$msec * 1000}]
+ set etime [expr {$stime + $usec}]
+ while {[set tm [clock microseconds]] < $etime} {
+ # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise):
+ # after 0
+ if {$tm < $stime} { # avoid too long delays by backwards time jumps, simply skip test
+ tcltest::Skip "time-jump?"
+ }
}
}
_nrt_sleep 0; # warm up (clock, compile, etc)
@@ -408,6 +412,9 @@ test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} {
test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measurement} -body {
set m1 [timerate {_nrt_sleep 0.01} 50]
set m2 [timerate {_nrt_sleep 1.00} 50]
+ if {[testConstraint valgrind] && ([lindex $m1 0] >= 100 || [lindex $m1 2] <= 500)} {
+ tcltest::Skip "too-slow-by-valgrind"
+ }
list [list \
[expr {[lindex $m1 0] < [lindex $m2 0]}] \
[expr {[lindex $m1 0] < 100}] \
diff --git a/tests/encoding.test b/tests/encoding.test
index 3feaa55..93a52aa 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -183,11 +183,11 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
test encoding-8.1 {Tcl_ExternalToUtf} {
set f [open [file join [temporaryDirectory] dummy] w]
- fconfigure $f -translation binary -encoding iso8859-1
+ fconfigure $f -translation binary
puts -nonewline $f "ab\x8C\xC1g"
close $f
set f [open [file join [temporaryDirectory] dummy] r]
- fconfigure $f -translation binary -encoding shiftjis
+ fconfigure $f -translation lf -encoding shiftjis
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
@@ -211,11 +211,11 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
test encoding-10.1 {Tcl_UtfToExternal} {
set f [open [file join [temporaryDirectory] dummy] w]
- fconfigure $f -translation binary -encoding shiftjis
+ fconfigure $f -translation lf -encoding shiftjis
puts -nonewline $f "ab\u4E4Eg"
close $f
set f [open [file join [temporaryDirectory] dummy] r]
- fconfigure $f -translation binary -encoding iso8859-1
+ fconfigure $f -translation binary
set x [read $f]
close $f
file delete [file join [temporaryDirectory] dummy]
diff --git a/tests/info.test b/tests/info.test
index 69be6a3..140a7bb 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1841,7 +1841,7 @@ test info-30.48 {Bug 2850901} testevalex {
# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089
-test info-40.1 {location information not confused by literal sharing, bug 2933089} -setup {
+test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
set result {}
proc print_one {} {}
@@ -2398,6 +2398,28 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
# -------------------------------------------------------------------------
unset -nocomplain res
+test info-19.7 {info vars: before TIP #278 - global vars resolved in namespace} -setup {
+ catch {namespace delete x}
+} -body {
+ expr { [llength [namespace eval x {info vars}]] > 0 }
+} -cleanup {
+ namespace delete x
+} -result 1
+test info-19.8 {info vars: before TIP #278 - global vars resolved in namespace} -setup {
+ catch {namespace delete x}
+} -body {
+ namespace eval x {info vars tcl_platform}
+} -cleanup {
+ namespace delete x
+} -result {tcl_platform}
+test info-19.9 {info vars: global vars resolved by pattern} -setup {
+ catch {namespace delete x}
+} -body {
+ namespace eval x {info vars ::tcl_platform}
+} -cleanup {
+ namespace delete x
+} -result {::tcl_platform}
+
test info-39.2 {Bug 4b61afd660} -setup {
proc probe {} {
return [dict get [info frame -1] line]
@@ -2415,6 +2437,20 @@ test info-39.2 {Bug 4b61afd660} -setup {
rename probe {}
} -result 3
+test info-41.0 {Bug 0de6c1d79c crash} -setup {
+ interp create child
+ child hide info
+} -body {
+ list [child invokehidden info frame] \
+ [child invokehidden info frame 0] \
+ [child invokehidden info frame 1] \
+ [catch {child invokehidden info frame -1} msg] $msg \
+ [catch {child invokehidden info frame 2} msg] $msg
+} -cleanup {
+ interp delete child
+ unset -nocomplain msg
+} -result {1 {type precompiled} {type precompiled} 1 {bad level "-1"} 1 {bad level "2"}}
+
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
diff --git a/tests/interp.test b/tests/interp.test
index d742484..24ffb1b 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -22,6 +22,12 @@ testConstraint testinterpdelete [llength [info commands testinterpdelete]]
set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
+proc _ms_limit_args {ms {t0 {}}} {
+ if {$t0 eq {}} { set t0 [clock milliseconds] }
+ incr t0 $ms
+ list -seconds [expr {$t0 / 1000}] -milliseconds [expr {$t0 % 1000}]
+}
+
foreach i [interp children] {
interp delete $i
}
@@ -3155,7 +3161,7 @@ test interp-34.3 {basic test of limits - pure bytecode loop} -body {
}
}
# We use a time limit here; command limits don't trap this case
- $i limit time -seconds [expr {[clock seconds]+2}]
+ $i limit time {*}[_ms_limit_args 50]
$i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
interp delete $i
@@ -3171,7 +3177,7 @@ test interp-34.3.1 {basic test of limits - pure inside-command loop} -body {
}
}
# We use a time limit here; command limits don't trap this case
- $i limit time -seconds [expr {[clock seconds] + 2}]
+ $i limit time {*}[_ms_limit_args 50]
$i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
interp delete $i
@@ -3304,7 +3310,7 @@ test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
# Bug 1085023
test interp-34.8 {time limits trigger in vwaits} -body {
set i [interp create]
- interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1
+ interp limit $i time {*}[_ms_limit_args 50] -granularity 1
$i eval {
set x {}
vwait x
@@ -3314,21 +3320,20 @@ test interp-34.8 {time limits trigger in vwaits} -body {
} -returnCodes error -result {limit exceeded}
test interp-34.9 {time limits trigger in blocking after} {
set i [interp create]
- set t0 [clock seconds]
- interp limit $i time -seconds [expr {$t0 + 1}] -granularity 1
+ set t0 [clock milliseconds]
+ interp limit $i time {*}[_ms_limit_args 50 $t0] -granularity 1
set code [catch {
$i eval {after 10000}
} msg]
- set t1 [clock seconds]
+ set t1 [clock milliseconds]
interp delete $i
- list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
+ list $code $msg [expr {($t1-$t0) < 1000 ? "OK" : $t1-$t0}]
} {1 {time limit exceeded} OK}
test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
set i [interp create]
- # Assume someone hasn't set the clock to early 1970!
- $i limit time -seconds 1 -granularity 4
interp alias $i log {} lappend result
set result {}
+ $i limit time {*}[_ms_limit_args 50] -granularity 4
catch {
$i eval {
log 1
@@ -3340,10 +3345,10 @@ test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
lappend result $msg
} -result {1 {time limit exceeded}}
test interp-34.11 {time limit extension in callbacks} -setup {
- proc cb1 {i t} {
+ proc cb1 {i args} {
global result
lappend result cb1
- $i limit time -seconds $t -command cb2
+ $i limit time {*}[_ms_limit_args {*}$args] -command cb2
}
proc cb2 {} {
global result
@@ -3351,9 +3356,9 @@ test interp-34.11 {time limit extension in callbacks} -setup {
}
} -body {
set i [interp create]
- set t0 [clock seconds]
- $i limit time -seconds [expr {$t0 + 1}] -granularity 1 \
- -command "cb1 $i [expr {$t0 + 2}]"
+ set t0 [clock milliseconds]
+ $i limit time {*}[_ms_limit_args 50 $t0] \
+ -command "cb1 $i 100 $t0"
set ::result {}
lappend ::result [catch {
$i eval {
@@ -3362,8 +3367,8 @@ test interp-34.11 {time limit extension in callbacks} -setup {
}
}
} msg] $msg
- set t1 [clock seconds]
- lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ set t1 [clock milliseconds]
+ lappend ::result [expr {$t1-$t0>=100 ? "ok" : "$t0,$t1"}]
interp delete $i
return $::result
} -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup {
@@ -3371,27 +3376,27 @@ test interp-34.11 {time limit extension in callbacks} -setup {
rename cb2 {}
}
test interp-34.12 {time limit extension in callbacks} -setup {
- proc cb1 {i} {
+ proc cb1 {i t0} {
global result times
lappend result cb1
set times [lassign $times t]
- $i limit time -seconds $t
+ $i limit time {*}[_ms_limit_args $t $t0]
}
} -body {
set i [interp create]
- set t0 [clock seconds]
- set ::times "[expr {$t0 + 2}] [expr {$t0 + 100}]"
- $i limit time -seconds [expr {$t0 + 1}] -granularity 1 -command "cb1 $i"
+ set t0 [clock milliseconds]
+ set ::times {100 10000}
+ $i limit time {*}[_ms_limit_args 50] -granularity 1 -command "cb1 $i $t0"
set ::result {}
lappend ::result [catch {
$i eval {
- for {set i 0} {$i<30} {incr i} {
- after 100
+ for {set i 0} {$i<5} {incr i} {
+ after 50
}
}
} msg] $msg
- set t1 [clock seconds]
- lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+ set t1 [clock milliseconds]
+ lappend ::result [expr {$t1-$t0>=100 ? "ok" : "$t0,$t1"}]
interp delete $i
return $::result
} -result {cb1 cb1 0 {} ok} -cleanup {
@@ -3400,7 +3405,7 @@ test interp-34.12 {time limit extension in callbacks} -setup {
test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup {
set i [interp create -safe]
} -body {
- $i limit time -seconds [clock add [clock seconds] 1 second]
+ $i limit time {*}[_ms_limit_args 50]
$i eval {
after 2000 set x timeout
vwait x
@@ -3409,6 +3414,20 @@ test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup {
} -cleanup {
interp delete $i
} -returnCodes error -result {limit exceeded}
+test interp-34.14 {[Bug e3f4a8b78d]: interp limit and interp eval} -setup {
+ set i [interp create]
+ set result {}
+} -body {
+ $i limit command -value [$i eval {info cmdcount}] -granularity 1
+ lappend result [catch {$i eval [list expr 1+3]} msg] $msg
+ lappend result [catch {$i eval [list expr 1+3]} msg] $msg
+ lappend result [catch {$i eval {set cmd expr; $cmd 1+3}} msg] $msg
+ lappend result [catch {$i eval {expr 1+3}} msg] $msg
+ lappend result [catch {$i eval expr 1+3} msg] $msg
+ lappend result [catch {interp eval $i [list expr 1+3]} msg] $msg
+} -cleanup {
+ interp delete $i
+} -result [lrepeat 6 1 {command count limit exceeded}]
test interp-35.1 {interp limit syntax} -body {
interp limit
@@ -3670,6 +3689,7 @@ unset -nocomplain hidden_cmds
foreach i [interp children] {
interp delete $i
}
+rename _ms_limit_args {}
::tcltest::cleanupTests
return
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 74fabe7..b167475 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -61,7 +61,7 @@ test iocmd-1.7 {puts command} {
} 7
test iocmd-1.8 {puts command} {
set f [open $path(test1) w]
- fconfigure $f -translation lf -eofchar {} -encoding iso8859-1
+ fconfigure $f -translation binary
puts -nonewline $f [binary format a4a5 foo bar]
close $f
file size $path(test1)
@@ -249,8 +249,7 @@ test iocmd-8.8 {fconfigure command} {
test iocmd-8.9 {fconfigure command} {
file delete $path(test1)
set f1 [open $path(test1) w]
- fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
- -eofchar {} -encoding binary
+ fconfigure $f1 -translation binary -buffering none -buffersize 4040
set x [fconfigure $f1]
close $f1
set x
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 4eafb6b..47006aa 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -2096,8 +2096,6 @@ test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
thread::release $tidb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
-
test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
#puts <<$tcltest::mainThread>>main
set tida [thread::create -preserved]; #puts <<$tida>>
diff --git a/tests/namespace.test b/tests/namespace.test
index 08531e4..17c9438 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3294,6 +3294,22 @@ test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a0
info class [format %s constructor] oo::object
} ""
+test namespace-55.2 {compiled ensembles inside safe interpreters (for safe sub-commands), bug [1095bf7f756f9aed]} -setup {
+ interp create -safe si
+ set code {
+ proc test_comp_dict d { dict for {k v} $d {expr $v} }
+ regexp -inline {Command 1:(?:[^\n]*\n){1,5}} [::tcl::unsupported::disassemble proc test_comp_dict]
+ }
+} -body {
+ set a [ eval $code]
+ set b [si eval $code]
+ list [expr {$a eq $b}] [regexp { dictFirst } $a] [regexp { dictFirst } $b] $a $b
+} -cleanup {
+ rename test_comp_dict {}
+ unset -nocomplain code a b
+ interp delete si
+} -match glob -result {1 1 1 *}
+
test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
namespace eval ::testing {
proc abc {} {}
diff --git a/tests/oo.test b/tests/oo.test
index c940011..6bf9c70 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -13,6 +13,20 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
+# A helper for intercepting background errors
+proc ::bgerrorIntercept {varName body} {
+ set old [interp bgerror {}]
+ interp bgerror {} [list apply {{var msg args} {
+ upvar #0 $var v
+ lappend v $msg
+ }} $varName]
+ try {
+ uplevel 1 $body
+ } finally {
+ interp bgerror {} $old
+ }
+}
+
# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
@@ -668,28 +682,30 @@ test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {
} -result {1 foo {}}
test oo-3.7 {basic test of OO functionality: errors in destructor} -setup {
oo::class create cls
- set result {}
- proc bgerror msg {lappend ::result $msg}
} -cleanup {
cls destroy
- rename bgerror {}
} -body {
oo::define cls destructor {error foo}
- list [rename [cls create obj] {}] \
- [update idletasks] $result [info commands obj]
-} -result {{} {} foo {}}
+ bgerrorIntercept result {
+ set result [cls create obj]
+ lappend result [rename obj {}]
+ update idletasks
+ lappend result [info commands obj]
+ }
+} -result {::obj {} foo {}}
test oo-3.8 {basic test of OO functionality: errors in destructor} -setup {
oo::class create cls
- set result {}
- proc bgerror msg {lappend ::result $msg}
} -cleanup {
cls destroy
- rename bgerror {}
} -body {
oo::define cls destructor {error foo}
- list [namespace delete [info object namespace [cls create obj]]] \
- [update idletasks] $result [info commands obj]
-} -result {{} {} foo {}}
+ bgerrorIntercept result {
+ set result [cls create obj]
+ lappend result [namespace delete [info object namespace obj]]
+ update idletasks
+ lappend result [info commands obj]
+ }
+} -result {::obj {} foo {}}
test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup {
oo::class create cls
set result {}
@@ -2854,6 +2870,16 @@ test oo-18.11 {OO: define/self command support} -setup {
(in definition script for class "::foo" line 1)
invoked from within
"oo::define foo {rename ::foo {}; self {error foobar}}"}
+test oo-18.12 {OO: self callable via eval method} -setup {
+ oo::class create parent {
+ export eval
+ }
+ parent create ::foo
+} -body {
+ foo eval { self }
+} -cleanup {
+ parent destroy
+} -result ::foo
test oo-19.1 {OO: varname method} -setup {
oo::object create inst
@@ -2907,6 +2933,20 @@ test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup {
} -cleanup {
testClass destroy
} -result 0
+test oo-19.4 {OO: varname ghosts [Bug 74b6110204]} -setup {
+ oo::class create testClass {
+ export varname
+ self export createWithNamespace
+ }
+ set obj [testClass createWithNamespace testoo19_4 testoo19_4]
+ set ns [info object namespace $obj]
+} -body {
+ set v [$obj varname foo]
+ list [namespace which -variable $v] \
+ [info exists $v] [namespace which -variable $v]
+} -cleanup {
+ testClass destroy
+} -result {::testoo19_4::foo 0 ::testoo19_4::foo}
test oo-20.1 {OO: variable method} -body {
oo::class create testClass {
@@ -3324,7 +3364,7 @@ oo::class create WorkerSupport {
return [uplevel 1 $script]
} finally {
foreach worker $workers {$worker destroy}
- }
+ }
}
method run {nworkers} {
set result {}
@@ -4332,13 +4372,20 @@ test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
}
set ::result {}
} -body {
- set FH [RpcClient new]
- $FH create_bug
- $FH destroy
+ # In this case, sub-objects are deleted during major object NS cleanup and
+ # are trying to call back into the major object (which is mostky gone at
+ # this point). Things are messy; error is reported via bgerror as the
+ # avenue most likely to reach a user.
+ bgerrorIntercept ::result {
+ set FH [RpcClient new]
+ $FH create_bug
+ $FH destroy
+ update
+ }
join $result \n
} -cleanup {
base destroy
-} -result {}
+} -result {impossible to invoke method "write": no defined method or unknown method}
test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
oo::class create base
oo::class create RpcClient {
@@ -4366,13 +4413,21 @@ test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
}
set ::result {}
} -body {
- set FH [RpcClient new]
- $FH create_bug
- $FH destroy
+ # In this case, sub-objects are deleted during major object NS cleanup, and
+ # we've a destructor on the major class to monitor when it happens. Things
+ # are still messy, but the order is clear; error is reported via bgerror as
+ # the avenue most likely to reach a user.
+ bgerrorIntercept ::result {
+ set FH [RpcClient new]
+ $FH create_bug
+ $FH destroy
+ update
+ }
join $result \n
} -cleanup {
base destroy
-} -result {Destroyed}
+} -result {Destroyed
+impossible to invoke method "write": no defined method or unknown method}
test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
oo::class create base
oo::class create RpcClient {
@@ -4407,14 +4462,20 @@ test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup {
}
set ::result {}
} -body {
- set FH [RpcClient new]
- $FH create_bug
- $FH destroy
+ # In this case, sub-objects are deleted while the destructor is running and
+ # the destroy is neat, so things work sanely. Error follows standard Tcl
+ # error flow route; bgerror is not used.
+ bgerrorIntercept ::result {
+ set FH [RpcClient new]
+ $FH create_bug
+ $FH destroy
+ update
+ }
join $result \n
} -cleanup {
base destroy
} -result "Destroyed\nRpcClient -> otto-111"
-
+rename bgerrorIntercept {}
cleanupTests
return
diff --git a/tests/remote.tcl b/tests/remote.tcl
index 2b975c6..6a39b47 100644
--- a/tests/remote.tcl
+++ b/tests/remote.tcl
@@ -40,9 +40,9 @@ proc __readAndExecute__ {s} {
set l [gets $s]
if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
- puts $s [__doCommands__ $command($s) $s]
+ puts $s [__doCommands__ $command($s) $s]
puts $s "--Marker--Marker--Marker--"
- set command($s) ""
+ set command($s) ""
return
}
if {[string compare $l ""] == 0} {
@@ -59,8 +59,8 @@ proc __readAndExecute__ {s} {
puts "Server closing $s, eof from client"
}
close $s
- unset command($s)
- return
+ unset command($s)
+ return
}
append command($s) $l "\n"
}
diff --git a/tests/socket.test b/tests/socket.test
index 7251bfa..31d41ba 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1079,6 +1079,25 @@ test socket_$af-7.5 {testing socket specific options} -setup {
close $s
close $s1
} -result [list $localhost 1 3]
+test socket_$af-7.6 {testing socket specific options - bug e589d9bdab} -setup {
+ set timer [after 10000 "set x timed_out"]
+ set l ""
+} -constraints [list socket supported_$af unixOrWin] -body {
+ set s [socket -server accept 0]
+ proc accept {s a p} {
+ global x
+ set x [fconfigure $s -sockname]
+ close $s
+ }
+ set listen [lindex [fconfigure $s -sockname] 2]
+ set s1 [socket $localhost $listen]
+ vwait x
+ lsort [dict keys [fconfigure $s1]]
+} -cleanup {
+ after cancel $timer
+ close $s
+ close $s1
+} -result {-blocking -buffering -buffersize -encoding -eofchar -peername -sockname -translation}
test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body {
# NOTE: This test may fail on some Solaris 2.4 systems. If it does, check
diff --git a/tests/zlib.test b/tests/zlib.test
index 5312d2b..61bddd9 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -1117,6 +1117,40 @@ if {$zlibbinf ne ""} {
unset zlibbinf
rename _zlibbinf {}
+test zlib-14.1 {Bug 9ee9f4d7be: compression header added to source channel} -setup {
+ set data hello
+ set src [file tempfile]
+ puts -nonewline $src $data
+ flush $src
+ chan configure $src -translation binary
+ set dst [file tempfile]
+ chan configure $dst -translation binary
+ set result {}
+} -constraints knownBug -body {
+ for {set i 0} {$i < 3} {incr i} {
+ # Determine size of src channel
+ seek $src 0 end
+ set size [chan tell $src]
+ seek $src 0 start
+ # Determine size of content in src channel
+ set data [read $src]
+ set size2 [string length $data]
+ seek $src 0 start
+ # Copy src over to dst, keep dst empty
+ zlib push deflate $src -level 6
+ chan truncate $dst 0
+ chan copy $src $dst
+ set size3 [chan tell $dst]
+ chan pop $src
+ # Show sizes
+ lappend result $size $size2 ->$size3
+ }
+ return $result
+} -cleanup {
+ chan close $src
+ chan close $dst
+} -result {5 5 ->5 5 5 ->5 5 5 ->5}
+
::tcltest::cleanupTests
return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 463d153..53826c4 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -888,7 +888,7 @@ install-libraries: libraries
@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
echo "Customizing tcl module path"; \
echo "if {![interp issafe]} { ::tcl::tm::roots [list $(TCL_MODULE_PATH)] }" >> \
- "$(SCRIPT_INSTALL_DIR)/tm.tcl"; \
+ "$(SCRIPT_INSTALL_DIR)/tm.tcl"; \
fi
install-tzdata:
diff --git a/unix/installManPage b/unix/installManPage
index 1e29bb0..3cb266d 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -12,8 +12,8 @@ Suffix=""
while true; do
case $1 in
- -s | --symlinks ) Sym="-s " ;;
- -z | --compress ) Gzip=$2; shift ;;
+ -s | --symlinks ) Sym="-s " ;;
+ -z | --compress ) Gzip=$2; shift ;;
-e | --extension ) Gz=$2; shift ;;
-x | --suffix ) Suffix=$2; shift ;;
-*) cat <<EOF
@@ -61,20 +61,35 @@ test -z "$Sym" && Loc="$Dir/"
#
Names=`sed -n '
# Look for a line that starts with .SH NAME
- /^\.SH NAME/{
-# Read next line
- n
-# Remove all commas ...
- s/,//g
-# ... and backslash-escaped spaces.
- s/\\\ //g
-# Delete from \- to the end of line
- s/ \\\-.*//
-# Convert all non-space non-alphanum sequences
-# to single underscores.
- s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
-# print the result and exit
- p;q
+ /^\.SH NAME/,/^\./{
+
+
+ /^\./!{
+
+ # Remove all commas...
+ s/,//g
+
+ # ... and backslash-escaped spaces.
+ s/\\\ //g
+
+ /\\\-.*/{
+ # Delete from \- to the end of line
+ s/ \\\-.*//
+ h
+ s/.*/./
+ x
+ }
+
+ # Convert all non-space non-alphanum sequences
+ # to single underscores.
+ s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
+ p
+ g
+ /^\./{
+ q
+ }
+ }
+
}' $ManPage`
if test -z "$Names" ; then
diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c
index aec071c..9ea88ff 100644
--- a/unix/tclLoadDl.c
+++ b/unix/tclLoadDl.c
@@ -199,7 +199,7 @@ FindSymbol(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot find symbol \"%s\": %s", symbol, errorStr));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
- NULL);
+ (char *)NULL);
}
}
return proc;
diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c
index 7d462da..c0178c7 100644
--- a/unix/tclLoadDyld.c
+++ b/unix/tclLoadDyld.c
@@ -410,7 +410,7 @@ FindSymbol(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot find symbol \"%s\": %s", symbol, errMsg));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
- NULL);
+ (char *)NULL);
}
return proc;
}
diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c
index eb0affa..0fd8b5f 100644
--- a/unix/tclLoadNext.c
+++ b/unix/tclLoadNext.c
@@ -146,7 +146,7 @@ FindSymbol(
if (proc == NULL && interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot find symbol \"%s\"", symbol));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL);
}
return proc;
}
diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c
index 377ed28..511182d 100644
--- a/unix/tclLoadOSF.c
+++ b/unix/tclLoadOSF.c
@@ -124,7 +124,7 @@ TclpDlopen(
*/
if ((pkg = strrchr(fileName, '/')) == NULL) {
- pkg = fileName;
+ pkg = fileName;
} else {
pkg++;
}
@@ -164,7 +164,7 @@ FindSymbol(
if (retval == NULL && interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"cannot find symbol \"%s\"", symbol));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL);
}
return retval;
}
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index 5e39cfc..1844a23 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -83,7 +83,7 @@ typedef struct TtyAttrs {
int stop;
} TtyAttrs;
-#endif /* !SUPPORTS_TTY */
+#endif /* SUPPORTS_TTY */
#define UNSUPPORTED_OPTION(detail) \
if (interp) { \
@@ -137,22 +137,22 @@ static int TtySetOptionProc(ClientData instanceData,
static const Tcl_ChannelType fileChannelType = {
"file", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- FileCloseProc, /* Close proc. */
- FileInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
- FileSeekProc, /* Seek proc. */
+ TCL_CHANNEL_VERSION_5,
+ FileCloseProc,
+ FileInputProc,
+ FileOutputProc,
+ FileSeekProc,
NULL, /* Set option proc. */
NULL, /* Get option proc. */
- FileWatchProc, /* Initialize notifier. */
- FileGetHandleProc, /* Get OS handles out of channel. */
- FileClose2Proc, /* close2proc. */
- FileBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- FileWideSeekProc, /* wide seek proc. */
- NULL,
- FileTruncateProc /* truncate proc. */
+ FileWatchProc,
+ FileGetHandleProc,
+ FileClose2Proc,
+ FileBlockModeProc,
+ NULL, /* Flush proc. */
+ NULL, /* Bubbled event handler proc. */
+ FileWideSeekProc,
+ NULL, /* Thread action proc. */
+ FileTruncateProc
};
#ifdef SUPPORTS_TTY
@@ -162,23 +162,23 @@ static const Tcl_ChannelType fileChannelType = {
*/
static const Tcl_ChannelType ttyChannelType = {
- "tty", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- FileCloseProc, /* Close proc. */
- FileInputProc, /* Input proc. */
- FileOutputProc, /* Output proc. */
+ "tty",
+ TCL_CHANNEL_VERSION_5,
+ FileCloseProc,
+ FileInputProc,
+ FileOutputProc,
+ NULL, /* Seek proc. */
+ TtySetOptionProc,
+ TtyGetOptionProc,
+ FileWatchProc,
+ FileGetHandleProc,
+ FileClose2Proc,
+ FileBlockModeProc,
+ NULL, /* Flush proc. */
+ NULL, /* Bubbled event handler proc. */
NULL, /* Seek proc. */
- TtySetOptionProc, /* Set option proc. */
- TtyGetOptionProc, /* Get option proc. */
- FileWatchProc, /* Initialize notifier. */
- FileGetHandleProc, /* Get OS handles out of channel. */
- FileClose2Proc, /* close2proc. */
- FileBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc. */
- NULL, /* thread action proc. */
- NULL /* truncate proc. */
+ NULL, /* Thread action proc. */
+ NULL /* Truncate proc. */
};
#endif /* SUPPORTS_TTY */
@@ -390,7 +390,7 @@ FileSeekProc(
* one of SEEK_START, SEEK_SET or SEEK_END. */
int *errorCodePtr) /* To store error code. */
{
- FileState *fsPtr = instanceData;
+ FileState *fsPtr = (FileState *)instanceData;
Tcl_WideInt oldLoc, newLoc;
/*
@@ -871,11 +871,11 @@ TtyGetOptionProc(
tcgetattr(fsPtr->fd, &iostate);
Tcl_DStringInit(&ds);
- Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
+ Tcl_ExternalToUtfDString(NULL, (char *)&iostate.c_cc[VSTART], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
TclDStringClear(&ds);
- Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
+ Tcl_ExternalToUtfDString(NULL, (char *)&iostate.c_cc[VSTOP], 1, &ds);
Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
}
@@ -1284,22 +1284,18 @@ TtyParseMode(
* not allow preprocessor directives in their arguments.
*/
- if (
-#if defined(PAREXT)
- strchr("noems", parity)
+#ifdef PAREXT
+#define PARITY_CHARS "noems"
+#define PARITY_MSG "n, o, e, m, or s"
#else
- strchr("noe", parity)
+#define PARITY_CHARS "noe"
+#define PARITY_MSG "n, o, or e"
#endif /* PAREXT */
- == NULL) {
+
+ if (strchr(PARITY_CHARS, parity) == NULL) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%s parity: should be %s", bad,
-#if defined(PAREXT)
- "n, o, e, m, or s"
-#else
- "n, o, or e"
-#endif /* PAREXT */
- ));
+ "%s parity: should be %s", bad, PARITY_MSG));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL);
}
return TCL_ERROR;
@@ -1598,12 +1594,11 @@ TclpGetDefaultStdChannel(
* Some #def's to make the code a little clearer!
*/
-#define ZERO_OFFSET ((Tcl_SeekOffset) 0)
#define ERROR_OFFSET ((Tcl_SeekOffset) -1)
switch (type) {
case TCL_STDIN:
- if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ if ((TclOSseek(0, 0, SEEK_CUR) == ERROR_OFFSET)
&& (errno == EBADF)) {
return NULL;
}
@@ -1612,7 +1607,7 @@ TclpGetDefaultStdChannel(
bufMode = "line";
break;
case TCL_STDOUT:
- if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ if ((TclOSseek(1, 0, SEEK_CUR) == ERROR_OFFSET)
&& (errno == EBADF)) {
return NULL;
}
@@ -1621,7 +1616,7 @@ TclpGetDefaultStdChannel(
bufMode = "line";
break;
case TCL_STDERR:
- if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
+ if ((TclOSseek(2, 0, SEEK_CUR) == ERROR_OFFSET)
&& (errno == EBADF)) {
return NULL;
}
@@ -1634,7 +1629,6 @@ TclpGetDefaultStdChannel(
break;
}
-#undef ZERO_OFFSET
#undef ERROR_OFFSET
channel = Tcl_MakeFileChannel(INT2PTR(fd), mode);
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 853e93a..5d118db 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -999,17 +999,17 @@ TclWinCPUID(
#if defined(HAVE_CPUID)
#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64)
__asm__ __volatile__("movq %%rbx, %%rsi \n\t" /* save %rbx */
- "cpuid \n\t"
- "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */
- : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
- : "a"(index));
+ "cpuid \n\t"
+ "xchgq %%rsi, %%rbx \n\t" /* restore the old %rbx */
+ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+ : "a"(index));
status = TCL_OK;
#elif defined(__i386__) || defined(_M_IX86)
__asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */
- "cpuid \n\t"
- "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */
- : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
- : "a"(index));
+ "cpuid \n\t"
+ "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */
+ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
+ : "a"(index));
status = TCL_OK;
#endif
#endif
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 26429df..3d44124 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -789,8 +789,7 @@ TclpObjCopyDirectory(
Tcl_DStringFree(&dstString);
if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
+ *errorPtr = TclDStringToObj(&ds);
Tcl_IncrRefCount(*errorPtr);
}
return ret;
@@ -843,8 +842,7 @@ TclpObjRemoveDirectory(
Tcl_DStringFree(&pathString);
if (ret != TCL_OK) {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
- Tcl_DStringFree(&ds);
+ *errorPtr = TclDStringToObj(&ds);
Tcl_IncrRefCount(*errorPtr);
}
return ret;
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 1d1d729..c39e7b6 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -54,10 +54,10 @@ TclpFindExecutable(
TclSetObjNameOfExecutable(
Tcl_NewStringObj(name, length), NULL);
#else
- Tcl_Encoding encoding;
const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
+ Tcl_Obj *obj;
if (argv0 == NULL) {
return;
@@ -125,15 +125,16 @@ TclpFindExecutable(
&& S_ISREG(statBuf.st_mode)) {
goto gotName;
}
- if (*p == '\0') {
+ if (p[0] == '\0') {
break;
- } else if (*(p+1) == 0) {
+ } else if (p[1] == 0) {
p = "./";
} else {
p++;
}
}
- TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
+ TclNewObj(obj);
+ TclSetObjNameOfExecutable(obj, NULL);
goto done;
/*
@@ -147,16 +148,14 @@ TclpFindExecutable(
if (name[0] == '/')
#endif
{
- encoding = Tcl_GetEncoding(NULL, NULL);
- Tcl_ExternalToUtfDString(encoding, name, -1, &utfName);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
- Tcl_DStringFree(&utfName);
+ Tcl_ExternalToUtfDString(NULL, name, -1, &utfName);
+ TclSetObjNameOfExecutable(TclDStringToObj(&utfName), NULL);
goto done;
}
if (TclpGetCwd(NULL, &cwd) == NULL) {
- TclSetObjNameOfExecutable(Tcl_NewObj(), NULL);
+ TclNewObj(obj);
+ TclSetObjNameOfExecutable(obj, NULL);
goto done;
}
@@ -183,12 +182,8 @@ TclpFindExecutable(
TclDStringAppendDString(&buffer, &nameString);
Tcl_DStringFree(&nameString);
- encoding = Tcl_GetEncoding(NULL, NULL);
- Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
- &utfName);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
- Tcl_DStringFree(&utfName);
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &utfName);
+ TclSetObjNameOfExecutable(TclDStringToObj(&utfName), NULL);
done:
Tcl_DStringFree(&buffer);
@@ -269,7 +264,7 @@ TclpMatchInDirectory(
Tcl_DString dsOrig; /* utf-8 encoding of dir */
Tcl_DStringInit(&dsOrig);
- dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
/*
@@ -363,8 +358,7 @@ TclpMatchInDirectory(
* and pattern. If so, add the file to the result.
*/
- utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1,
- &utfDs);
+ utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
int typeOk = 1;
@@ -621,7 +615,7 @@ TclpObjAccess(
Tcl_Obj *pathPtr, /* Path of file to access */
int mode) /* Permission setting. */
{
- const char *path = Tcl_FSGetNativePath(pathPtr);
+ const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
if (path == NULL) {
return -1;
@@ -702,9 +696,9 @@ TclpObjLstat(
*----------------------------------------------------------------------
*/
-ClientData
+void *
TclpGetNativeCwd(
- ClientData clientData)
+ void *clientData)
{
char buffer[MAXPATHLEN+1];
@@ -719,7 +713,7 @@ TclpGetNativeCwd(
#endif /* USEGETWD */
if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
- char *newCd = (char*)ckalloc(strlen(buffer) + 1);
+ char *newCd = (char *)ckalloc(strlen(buffer) + 1);
strcpy(newCd, buffer);
return newCd;
@@ -937,9 +931,9 @@ TclpObjLink(
*/
if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
- int targetLen;
Tcl_DString ds;
Tcl_Obj *transPtr;
+ int length;
/*
* Now we don't want to link to the absolute, normalized path.
@@ -951,8 +945,8 @@ TclpObjLink(
if (transPtr == NULL) {
return NULL;
}
- target = Tcl_GetStringFromObj(transPtr, &targetLen);
- target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
+ target = Tcl_GetStringFromObj(transPtr, &length);
+ target = Tcl_UtfToExternalDString(NULL, target, length, &ds);
Tcl_DecrRefCount(transPtr);
if (symlink(target, src) != 0) {
@@ -1048,7 +1042,7 @@ TclpFilesystemPathType(
Tcl_Obj *
TclpNativeToNormalized(
- ClientData clientData)
+ void *clientData)
{
Tcl_DString ds;
@@ -1072,7 +1066,7 @@ TclpNativeToNormalized(
*---------------------------------------------------------------------------
*/
-ClientData
+void *
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
@@ -1139,9 +1133,9 @@ TclNativeCreateNativeRep(
*---------------------------------------------------------------------------
*/
-ClientData
+void *
TclNativeDupInternalRep(
- ClientData clientData)
+ void *clientData)
{
char *copy;
size_t len;
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 5a27359..c7b2efe 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -55,31 +55,31 @@ static const char *const processors[NUMPROCESSORS] = {
};
typedef struct {
- union {
- unsigned int dwOemId;
- struct {
- int wProcessorArchitecture;
- int wReserved;
+ union {
+ unsigned int dwOemId;
+ struct {
+ int wProcessorArchitecture;
+ int wReserved;
+ };
};
- };
- unsigned int dwPageSize;
- void *lpMinimumApplicationAddress;
- void *lpMaximumApplicationAddress;
- void *dwActiveProcessorMask;
- unsigned int dwNumberOfProcessors;
- unsigned int dwProcessorType;
- unsigned int dwAllocationGranularity;
- int wProcessorLevel;
- int wProcessorRevision;
+ unsigned int dwPageSize;
+ void *lpMinimumApplicationAddress;
+ void *lpMaximumApplicationAddress;
+ void *dwActiveProcessorMask;
+ unsigned int dwNumberOfProcessors;
+ unsigned int dwProcessorType;
+ unsigned int dwAllocationGranularity;
+ int wProcessorLevel;
+ int wProcessorRevision;
} SYSTEM_INFO;
typedef struct {
- unsigned int dwOSVersionInfoSize;
- unsigned int dwMajorVersion;
- unsigned int dwMinorVersion;
- unsigned int dwBuildNumber;
- unsigned int dwPlatformId;
- wchar_t szCSDVersion[128];
+ unsigned int dwOSVersionInfoSize;
+ unsigned int dwMajorVersion;
+ unsigned int dwMinorVersion;
+ unsigned int dwBuildNumber;
+ unsigned int dwPlatformId;
+ wchar_t szCSDVersion[128];
} OSVERSIONINFOW;
#endif
@@ -337,7 +337,6 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp,
MODULE_SCOPE long tclMacOSXDarwinRelease;
long tclMacOSXDarwinRelease = 0;
#endif
-
/*
*---------------------------------------------------------------------------
@@ -600,17 +599,21 @@ SearchKnownEncodings(
int left = 0;
int right = sizeof(localeTable)/sizeof(LocaleTable);
+ /* Here, search for i in the interval left <= i < right. */
while (left < right) {
int test = (left + right)/2;
int code = strcmp(localeTable[test].lang, encoding);
if (code == 0) {
+ /* Found it at i == test. */
return localeTable[test].encoding;
}
if (code < 0) {
+ /* Restrict the search to the interval test < i < right. */
left = test+1;
} else {
- right = test-1;
+ /* Restrict the search to the interval left <= i < test. */
+ right = test;
}
}
return NULL;
@@ -853,15 +856,15 @@ TclpSetVariables(
}
}
#endif /* HAVE_COREFOUNDATION */
- p = pkgPath;
- while ((q = strchr(p, ':')) != NULL) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
- p = q+1;
- }
- if (*p) {
- Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
- }
- Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY);
+ p = pkgPath;
+ while ((q = strchr(p, ':')) != NULL) {
+ Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, q-p));
+ p = q+1;
+ }
+ if (*p) {
+ Tcl_ListObjAppendElement(NULL, pkgListObj, Tcl_NewStringObj(p, -1));
+ }
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_pkgPath", -1), NULL, pkgListObj, TCL_GLOBAL_ONLY);
#ifdef DJGPP
Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 1a2129d..2ad72c3 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -78,23 +78,23 @@ static int SetupStdFile(TclFile file, int type);
*/
static const Tcl_ChannelType pipeChannelType = {
- "pipe", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
+ "pipe",
+ TCL_CHANNEL_VERSION_5,
TCL_CLOSE2PROC, /* Close proc. */
- PipeInputProc, /* Input proc. */
- PipeOutputProc, /* Output proc. */
+ PipeInputProc,
+ PipeOutputProc,
NULL, /* Seek proc. */
NULL, /* Set option proc. */
NULL, /* Get option proc. */
- PipeWatchProc, /* Initialize notifier. */
- PipeGetHandleProc, /* Get OS handles out of channel. */
- PipeClose2Proc, /* close2proc. */
- PipeBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc */
- NULL, /* thread action proc */
- NULL /* truncation */
+ PipeWatchProc,
+ PipeGetHandleProc,
+ PipeClose2Proc,
+ PipeBlockModeProc,
+ NULL, /* Flush proc. */
+ NULL, /* Bubbled event handler proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Thread action proc. */
+ NULL /* Truncation proc. */
};
/*
@@ -283,6 +283,7 @@ TclpTempFileNameForLibrary(
Tcl_Obj *path) /* Path name of the library in the VFS. */
{
Tcl_Obj *retval = TclpTempFileName();
+ (void)path;
if (retval == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -827,7 +828,7 @@ TclpCreateCommandChannel(
* background exec). */
{
char channelName[16 + TCL_INTEGER_SPACE];
- int channelId;
+ int fd;
PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState));
int mode;
@@ -851,13 +852,13 @@ TclpCreateCommandChannel(
*/
if (readFile) {
- channelId = GetFd(readFile);
+ fd = GetFd(readFile);
} else if (writeFile) {
- channelId = GetFd(writeFile);
+ fd = GetFd(writeFile);
} else if (errorFile) {
- channelId = GetFd(errorFile);
+ fd = GetFd(errorFile);
} else {
- channelId = 0;
+ fd = 0;
}
/*
@@ -866,7 +867,7 @@ TclpCreateCommandChannel(
* natural to use "pipe%d".
*/
- snprintf(channelName, sizeof(channelName), "file%d", channelId);
+ snprintf(channelName, sizeof(channelName), "file%d", fd);
statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
statePtr, mode);
return statePtr->channel;
@@ -897,6 +898,7 @@ Tcl_CreatePipe(
int flags) /* Reserved for future use. */
{
int fileNums[2];
+ (void)flags;
if (pipe(fileNums) < 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
@@ -1359,6 +1361,7 @@ Tcl_PidObjCmd(
PipeState *pipePtr;
int i;
Tcl_Obj *resultPtr;
+ (void)dummy;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 441f75b..3c14984 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -62,8 +62,7 @@ struct TcpState {
* Only needed for server sockets
*/
- Tcl_TcpAcceptProc *acceptProc;
- /* Proc to call on accept. */
+ Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
void *acceptProcData; /* The data for the accept proc. */
/*
@@ -146,23 +145,23 @@ static Tcl_FileProc WrapNotify;
*/
static const Tcl_ChannelType tcpChannelType = {
- "tcp", /* Type name. */
- TCL_CHANNEL_VERSION_5, /* v5 channel */
- TcpCloseProc, /* Close proc. */
- TcpInputProc, /* Input proc. */
- TcpOutputProc, /* Output proc. */
+ "tcp",
+ TCL_CHANNEL_VERSION_5,
+ TcpCloseProc,
+ TcpInputProc,
+ TcpOutputProc,
NULL, /* Seek proc. */
NULL, /* Set option proc. */
- TcpGetOptionProc, /* Get option proc. */
- TcpWatchProc, /* Initialize notifier. */
- TcpGetHandleProc, /* Get OS handles out of channel. */
- TcpClose2Proc, /* Close2 proc. */
- TcpBlockModeProc, /* Set blocking or non-blocking mode.*/
- NULL, /* flush proc. */
- NULL, /* handler proc. */
- NULL, /* wide seek proc. */
- TcpThreadActionProc, /* thread action proc. */
- NULL /* truncate proc. */
+ TcpGetOptionProc,
+ TcpWatchProc,
+ TcpGetHandleProc,
+ TcpClose2Proc,
+ TcpBlockModeProc,
+ NULL, /* Flush proc. */
+ NULL, /* Bubbled event handler proc. */
+ NULL, /* Seek proc. */
+ TcpThreadActionProc,
+ NULL /* Truncate proc. */
};
/*
@@ -196,8 +195,8 @@ printaddrinfo(
*
* InitializeHostName --
*
- * This routine sets the process global value of the name of the local
- * host on which the process is running.
+ * This routine sets the process global value of the name of the local
+ * host on which the process is running.
*
* Results:
* None.
@@ -219,7 +218,7 @@ InitializeHostName(
memset(&u, (int) 0, sizeof(struct utsname));
if (uname(&u) >= 0) { /* INTL: Native. */
- hp = TclpGetHostByName(u.nodename); /* INTL: Native. */
+ hp = TclpGetHostByName(u.nodename); /* INTL: Native. */
if (hp == NULL) {
/*
* Sometimes the nodename is fully qualified, but gets truncated
@@ -238,11 +237,11 @@ InitializeHostName(
ckfree(node);
}
}
- if (hp != NULL) {
+ if (hp != NULL) {
native = hp->h_name;
- } else {
+ } else {
native = u.nodename;
- }
+ }
}
if (native == NULL) {
native = tclEmptyStringRep;
@@ -383,8 +382,8 @@ TcpBlockModeProc(
SET_BITS(statePtr->flags, TCP_NONBLOCKING);
}
if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
- statePtr->cachedBlocking = mode;
- return 0;
+ statePtr->cachedBlocking = mode;
+ return 0;
}
if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) {
return errno;
@@ -413,8 +412,8 @@ TcpBlockModeProc(
* return any error code.
*
* Results:
- * 0 if the connection has completed, -1 if still in progress or there is
- * an error.
+ * 0 if the connection has completed, -1 if still in progress or there is
+ * an error.
*
* Side effects:
* Processes socket events off the system queue. May process
@@ -449,30 +448,30 @@ WaitForConnect(
}
if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
- timeout = 0;
+ timeout = 0;
} else {
- timeout = -1;
+ timeout = -1;
}
do {
- if (TclUnixWaitForFile(statePtr->fds.fd,
- TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) {
- TcpConnect(NULL, statePtr);
- }
-
- /*
- * Do this only once in the nonblocking case and repeat it until the
- * socket is final when blocking.
- */
+ if (TclUnixWaitForFile(statePtr->fds.fd,
+ TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) {
+ TcpConnect(NULL, statePtr);
+ }
+
+ /*
+ * Do this only once in the nonblocking case and repeat it until the
+ * socket is final when blocking.
+ */
} while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT));
if (errorCodePtr != NULL) {
- if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
- *errorCodePtr = EAGAIN;
- return -1;
- } else if (statePtr->connectError != 0) {
- *errorCodePtr = ENOTCONN;
- return -1;
- }
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
+ *errorCodePtr = EAGAIN;
+ return -1;
+ } else if (statePtr->connectError != 0) {
+ *errorCodePtr = ENOTCONN;
+ return -1;
+ }
}
return 0;
}
@@ -627,10 +626,10 @@ TcpCloseProc(
fds = next;
}
if (statePtr->addrlist != NULL) {
- freeaddrinfo(statePtr->addrlist);
+ freeaddrinfo(statePtr->addrlist);
}
if (statePtr->myaddrlist != NULL) {
- freeaddrinfo(statePtr->myaddrlist);
+ freeaddrinfo(statePtr->myaddrlist);
}
ckfree(statePtr);
return errorCode;
@@ -707,7 +706,7 @@ IPv6AddressNeedsNumericRendering(
struct in6_addr addr)
{
if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) {
- return 1;
+ return 1;
}
/*
@@ -716,11 +715,11 @@ IPv6AddressNeedsNumericRendering(
*/
if (!IN6_IS_ADDR_V4MAPPED(&addr)) {
- return 0;
+ return 0;
}
return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0
- && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0);
+ && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0);
}
#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic pop
@@ -739,7 +738,7 @@ TcpHostPortList(
int flags = 0;
getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport),
- NI_NUMERICHOST | NI_NUMERICSERV);
+ NI_NUMERICHOST | NI_NUMERICSERV);
Tcl_DStringAppendElement(dsPtr, nhost);
/*
@@ -748,14 +747,14 @@ TcpHostPortList(
*/
if (addr.sa.sa_family == AF_INET) {
- if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
- flags |= NI_NUMERICHOST;
- }
+ if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
+ flags |= NI_NUMERICHOST;
+ }
#ifndef NEED_FAKE_RFC2553
} else if (addr.sa.sa_family == AF_INET6) {
- if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) {
- flags |= NI_NUMERICHOST;
- }
+ if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) {
+ flags |= NI_NUMERICHOST;
+ }
#endif /* NEED_FAKE_RFC2553 */
}
@@ -764,22 +763,22 @@ TcpHostPortList(
*/
if (interp != NULL &&
- Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) {
- flags |= NI_NUMERICHOST;
+ Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) {
+ flags |= NI_NUMERICHOST;
}
if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0,
- flags) == 0) {
- /*
- * Reverse mapping worked.
- */
+ flags) == 0) {
+ /*
+ * Reverse mapping worked.
+ */
- Tcl_DStringAppendElement(dsPtr, host);
+ Tcl_DStringAppendElement(dsPtr, host);
} else {
- /*
- * Reverse mapping failed - use the numeric rep once more.
- */
+ /*
+ * Reverse mapping failed - use the numeric rep once more.
+ */
- Tcl_DStringAppendElement(dsPtr, nhost);
+ Tcl_DStringAppendElement(dsPtr, nhost);
}
Tcl_DStringAppendElement(dsPtr, nport);
}
@@ -828,25 +827,25 @@ TcpGetOptionProc(
(strncmp(optionName, "-error", len) == 0)) {
socklen_t optlen = sizeof(int);
- if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
- /*
- * Suppress errors as long as we are not done.
- */
-
- errno = 0;
- } else if (statePtr->connectError != 0) {
- errno = statePtr->connectError;
- statePtr->connectError = 0;
- } else {
- int err;
-
- getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err,
- &optlen);
- errno = err;
- }
- if (errno != 0) {
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
+ /*
+ * Suppress errors as long as we are not done.
+ */
+
+ errno = 0;
+ } else if (statePtr->connectError != 0) {
+ errno = statePtr->connectError;
+ statePtr->connectError = 0;
+ } else {
+ int err;
+
+ getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err,
+ &optlen);
+ errno = err;
+ }
+ if (errno != 0) {
Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), -1);
- }
+ }
return TCL_OK;
}
@@ -854,13 +853,13 @@ TcpGetOptionProc(
(strncmp(optionName, "-connecting", len) == 0)) {
Tcl_DStringAppend(dsPtr,
GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", -1);
- return TCL_OK;
+ return TCL_OK;
}
if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
(strncmp(optionName, "-peername", len) == 0))) {
- address peername;
- socklen_t size = sizeof(peername);
+ address peername;
+ socklen_t size = sizeof(peername);
if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
/*
@@ -882,11 +881,11 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
}
- TcpHostPortList(interp, dsPtr, peername, size);
+ TcpHostPortList(interp, dsPtr, peername, size);
if (len) {
- return TCL_OK;
- }
- Tcl_DStringEndSublist(dsPtr);
+ return TCL_OK;
+ }
+ Tcl_DStringEndSublist(dsPtr);
} else {
/*
* getpeername failed - but if we were asked for all the options
@@ -898,7 +897,7 @@ TcpGetOptionProc(
if (len) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get peername: %s",
+ "can't get peername: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
@@ -922,7 +921,7 @@ TcpGetOptionProc(
* In async connect output an empty string
*/
- found = 1;
+ found = 1;
} else {
for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
size = sizeof(sockname);
@@ -932,23 +931,23 @@ TcpGetOptionProc(
}
}
}
- if (found) {
- if (len) {
- return TCL_OK;
- }
- Tcl_DStringEndSublist(dsPtr);
- } else {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't get sockname: %s", Tcl_PosixError(interp)));
- }
+ if (found) {
+ if (len) {
+ return TCL_OK;
+ }
+ Tcl_DStringEndSublist(dsPtr);
+ } else {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't get sockname: %s", Tcl_PosixError(interp)));
+ }
return TCL_ERROR;
}
}
if (len > 0) {
return Tcl_BadChannelOption(interp, optionName,
- "connecting peername sockname");
+ "connecting peername sockname");
}
return TCL_OK;
@@ -1055,22 +1054,22 @@ TcpWatchProc(
TcpState *statePtr = (TcpState *)instanceData;
if (statePtr->acceptProc != NULL) {
- /*
- * Make sure we don't mess with server sockets since they will never
- * be readable or writable at the Tcl level. This keeps Tcl scripts
- * from interfering with the -accept behavior (bug #3394732).
- */
+ /*
+ * Make sure we don't mess with server sockets since they will never
+ * be readable or writable at the Tcl level. This keeps Tcl scripts
+ * from interfering with the -accept behavior (bug #3394732).
+ */
- return;
+ return;
}
if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
- /*
- * Async sockets use a FileHandler internally while connecting, so we
- * need to cache this request until the connection has succeeded.
- */
+ /*
+ * Async sockets use a FileHandler internally while connecting, so we
+ * need to cache this request until the connection has succeeded.
+ */
- statePtr->filehandlers = mask;
+ statePtr->filehandlers = mask;
} else if (mask) {
/*
@@ -1194,18 +1193,17 @@ TcpConnect(
int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
int ret = -1, error = EHOSTUNREACH;
int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
+ static const int reuseaddr = 1;
if (async_callback) {
- goto reenter;
+ goto reenter;
}
for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
- statePtr->addr = statePtr->addr->ai_next) {
- for (statePtr->myaddr = statePtr->myaddrlist;
- statePtr->myaddr != NULL;
- statePtr->myaddr = statePtr->myaddr->ai_next) {
- int reuseaddr = 1;
-
+ statePtr->addr = statePtr->addr->ai_next) {
+ for (statePtr->myaddr = statePtr->myaddrlist;
+ statePtr->myaddr != NULL;
+ statePtr->myaddr = statePtr->myaddr->ai_next) {
/*
* No need to try combinations of local and remote addresses of
* different families.
@@ -1215,19 +1213,19 @@ TcpConnect(
continue;
}
- /*
- * Close the socket if it is still open from the last unsuccessful
- * iteration.
- */
+ /*
+ * Close the socket if it is still open from the last unsuccessful
+ * iteration.
+ */
- if (statePtr->fds.fd >= 0) {
+ if (statePtr->fds.fd >= 0) {
close(statePtr->fds.fd);
statePtr->fds.fd = -1;
- errno = 0;
+ errno = 0;
}
statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM,
- 0);
+ 0);
if (statePtr->fds.fd < 0) {
continue;
}
@@ -1246,28 +1244,28 @@ TcpConnect(
TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE);
if (async) {
- ret = TclUnixSetBlockingMode(statePtr->fds.fd,
- TCL_MODE_NONBLOCKING);
- if (ret < 0) {
- continue;
- }
- }
-
- /*
- * Must reset the error variable here, before we use it for the
- * first time in this iteration.
- */
-
- error = 0;
-
- (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR,
- (char *) &reuseaddr, sizeof(reuseaddr));
- ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr,
- statePtr->myaddr->ai_addrlen);
- if (ret < 0) {
- error = errno;
- continue;
- }
+ ret = TclUnixSetBlockingMode(statePtr->fds.fd,
+ TCL_MODE_NONBLOCKING);
+ if (ret < 0) {
+ continue;
+ }
+ }
+
+ /*
+ * Must reset the error variable here, before we use it for the
+ * first time in this iteration.
+ */
+
+ error = 0;
+
+ (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &reuseaddr, sizeof(reuseaddr));
+ ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr,
+ statePtr->myaddr->ai_addrlen);
+ if (ret < 0) {
+ error = errno;
+ continue;
+ }
/*
* Attempt to connect. The connect may fail at present with an
@@ -1277,35 +1275,35 @@ TcpConnect(
*/
ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr,
- statePtr->addr->ai_addrlen);
- if (ret < 0) {
- error = errno;
- }
+ statePtr->addr->ai_addrlen);
+ if (ret < 0) {
+ error = errno;
+ }
if (ret < 0 && errno == EINPROGRESS) {
- Tcl_CreateFileHandler(statePtr->fds.fd,
- TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback,
- statePtr);
- errno = EWOULDBLOCK;
- SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
- return TCL_OK;
-
- reenter:
- CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
- Tcl_DeleteFileHandler(statePtr->fds.fd);
-
- /*
- * Read the error state from the socket to see if the async
- * connection has succeeded or failed. As this clears the
- * error condition, we cache the status in the socket state
- * struct for later retrieval by [fconfigure -error].
- */
-
- optlen = sizeof(int);
-
- getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
- (char *) &error, &optlen);
- errno = error;
- }
+ Tcl_CreateFileHandler(statePtr->fds.fd,
+ TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback,
+ statePtr);
+ errno = EWOULDBLOCK;
+ SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
+ return TCL_OK;
+
+ reenter:
+ CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
+ Tcl_DeleteFileHandler(statePtr->fds.fd);
+
+ /*
+ * Read the error state from the socket to see if the async
+ * connection has succeeded or failed. As this clears the
+ * error condition, we cache the status in the socket state
+ * struct for later retrieval by [fconfigure -error].
+ */
+
+ optlen = sizeof(int);
+
+ getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
+ (char *) &error, &optlen);
+ errno = error;
+ }
if (error == 0) {
goto out;
}
@@ -1316,43 +1314,43 @@ TcpConnect(
statePtr->connectError = error;
CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
if (async_callback) {
- /*
- * An asynchonous connection has finally succeeded or failed.
- */
-
- TcpWatchProc(statePtr, statePtr->filehandlers);
- TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);
-
- if (error != 0) {
- SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
- }
-
- /*
- * We need to forward the writable event that brought us here, because
- * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
- * writable state from the socket, and so a subsequent select() on
- * behalf of a script level [fileevent] would not fire. It doesn't
- * hurt that this is also called in the successful case and will save
- * the event mechanism one roundtrip through select().
- */
+ /*
+ * An asynchonous connection has finally succeeded or failed.
+ */
+
+ TcpWatchProc(statePtr, statePtr->filehandlers);
+ TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);
+
+ if (error != 0) {
+ SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
+ }
+
+ /*
+ * We need to forward the writable event that brought us here, because
+ * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
+ * writable state from the socket, and so a subsequent select() on
+ * behalf of a script level [fileevent] would not fire. It doesn't
+ * hurt that this is also called in the successful case and will save
+ * the event mechanism one roundtrip through select().
+ */
if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) {
Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE);
}
}
if (error != 0) {
- /*
- * Failure for either a synchronous connection, or an async one that
- * failed before it could enter background mode, e.g. because an
- * invalid -myaddr was given.
- */
-
- if (interp != NULL) {
- errno = error;
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s", Tcl_PosixError(interp)));
- }
- return TCL_ERROR;
+ /*
+ * Failure for either a synchronous connection, or an async one that
+ * failed before it could enter background mode, e.g. because an
+ * invalid -myaddr was given.
+ */
+
+ if (interp != NULL) {
+ errno = error;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", Tcl_PosixError(interp)));
+ }
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -1395,16 +1393,16 @@ Tcl_OpenTcpClient(
*/
if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
- || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
- &errorMsg)) {
- if (addrlist != NULL) {
- freeaddrinfo(addrlist);
- }
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't open socket: %s", errorMsg));
- }
- return NULL;
+ || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
+ &errorMsg)) {
+ if (addrlist != NULL) {
+ freeaddrinfo(addrlist);
+ }
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open socket: %s", errorMsg));
+ }
+ return NULL;
}
/*
@@ -1424,14 +1422,14 @@ Tcl_OpenTcpClient(
*/
if (TcpConnect(interp, statePtr) != TCL_OK) {
- TcpCloseProc(statePtr, NULL);
- return NULL;
+ TcpCloseProc(statePtr, NULL);
+ return NULL;
}
snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long)statePtr);
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
- statePtr, TCL_READABLE | TCL_WRITABLE);
+ statePtr, TCL_READABLE | TCL_WRITABLE);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
"auto crlf") == TCL_ERROR) {
Tcl_Close(NULL, statePtr->channel);
@@ -1461,7 +1459,7 @@ Tcl_MakeTcpClientChannel(
void *sock) /* The socket to wrap up into a channel. */
{
return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock,
- TCL_READABLE | TCL_WRITABLE);
+ TCL_READABLE | TCL_WRITABLE);
}
/*
@@ -1556,7 +1554,7 @@ Tcl_OpenTcpServer(
for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
- addrPtr->ai_protocol);
+ addrPtr->ai_protocol);
if (sock == -1) {
if (howfar < SOCKET) {
howfar = SOCKET;
@@ -1579,98 +1577,97 @@ Tcl_OpenTcpServer(
TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE);
/*
- * Set up to reuse server addresses automatically and bind to the
- * specified port.
+ * Set up to reuse server addresses and/or ports if requested.
*/
(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
(char *) &reuseaddr, sizeof(reuseaddr));
- /*
- * Make sure we use the same port number when opening two server
- * sockets for IPv4 and IPv6 on a random port.
- *
- * As sockaddr_in6 uses the same offset and size for the port member
- * as sockaddr_in, we can handle both through the IPv4 API.
- */
+ /*
+ * Make sure we use the same port number when opening two server
+ * sockets for IPv4 and IPv6 on a random port.
+ *
+ * As sockaddr_in6 uses the same offset and size for the port member
+ * as sockaddr_in, we can handle both through the IPv4 API.
+ */
if (port == 0 && chosenport != 0) {
((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
- htons(chosenport);
+ htons(chosenport);
}
#ifdef IPV6_V6ONLY
/*
- * Missing on: Solaris 2.8
- */
+ * Missing on: Solaris 2.8
+ */
- if (addrPtr->ai_family == AF_INET6) {
- int v6only = 1;
+ if (addrPtr->ai_family == AF_INET6) {
+ int v6only = 1;
- (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
- &v6only, sizeof(v6only));
- }
+ (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
+ &v6only, sizeof(v6only));
+ }
#endif /* IPV6_V6ONLY */
status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
- if (status == -1) {
+ if (status == -1) {
if (howfar < BIND) {
howfar = BIND;
my_errno = errno;
}
- close(sock);
- sock = -1;
- continue;
- }
- if (port == 0 && chosenport == 0) {
- address sockname;
- socklen_t namelen = sizeof(sockname);
-
- /*
- * Synchronize port numbers when binding to port 0 of multiple
- * addresses.
- */
-
- if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
- chosenport = ntohs(sockname.sa4.sin_port);
- }
- }
- status = listen(sock, SOMAXCONN);
- if (status < 0) {
+ close(sock);
+ sock = -1;
+ continue;
+ }
+ if (port == 0 && chosenport == 0) {
+ address sockname;
+ socklen_t namelen = sizeof(sockname);
+
+ /*
+ * Synchronize port numbers when binding to port 0 of multiple
+ * addresses.
+ */
+
+ if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
+ chosenport = ntohs(sockname.sa4.sin_port);
+ }
+ }
+ status = listen(sock, SOMAXCONN);
+ if (status < 0) {
if (howfar < LISTEN) {
howfar = LISTEN;
my_errno = errno;
}
- close(sock);
- sock = -1;
- continue;
- }
- if (statePtr == NULL) {
- /*
- * Allocate a new TcpState for this socket.
- */
-
- statePtr = (TcpState *)ckalloc(sizeof(TcpState));
- memset(statePtr, 0, sizeof(TcpState));
- statePtr->acceptProc = acceptProc;
- statePtr->acceptProcData = acceptProcData;
- snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long) statePtr);
- newfds = &statePtr->fds;
- } else {
- newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList));
- memset(newfds, (int) 0, sizeof(TcpFdList));
- fds->next = newfds;
- }
- newfds->fd = sock;
- newfds->statePtr = statePtr;
- fds = newfds;
-
- /*
- * Set up the callback mechanism for accepting connections from new
- * clients.
- */
-
- Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds);
+ close(sock);
+ sock = -1;
+ continue;
+ }
+ if (statePtr == NULL) {
+ /*
+ * Allocate a new TcpState for this socket.
+ */
+
+ statePtr = (TcpState *)ckalloc(sizeof(TcpState));
+ memset(statePtr, 0, sizeof(TcpState));
+ statePtr->acceptProc = acceptProc;
+ statePtr->acceptProcData = acceptProcData;
+ snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, (long)statePtr);
+ newfds = &statePtr->fds;
+ } else {
+ newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList));
+ memset(newfds, (int) 0, sizeof(TcpFdList));
+ fds->next = newfds;
+ }
+ newfds->fd = sock;
+ newfds->statePtr = statePtr;
+ fds = newfds;
+
+ /*
+ * Set up the callback mechanism for accepting connections from new
+ * clients.
+ */
+
+ Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds);
}
error:
@@ -1683,15 +1680,15 @@ Tcl_OpenTcpServer(
return statePtr->channel;
}
if (interp != NULL) {
- Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1);
+ Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1);
if (errorMsg == NULL) {
- errno = my_errno;
- Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1);
- } else {
+ errno = my_errno;
+ Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1);
+ } else {
Tcl_AppendToObj(errorObj, errorMsg, -1);
}
- Tcl_SetObjResult(interp, errorObj);
+ Tcl_SetObjResult(interp, errorObj);
}
if (sock != -1) {
close(sock);
@@ -1756,9 +1753,9 @@ TcpAccept(
if (fds->statePtr->acceptProc != NULL) {
getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port),
- NI_NUMERICHOST|NI_NUMERICSERV);
+ NI_NUMERICHOST|NI_NUMERICSERV);
fds->statePtr->acceptProc(fds->statePtr->acceptProcData,
- newSockState->channel, host, atoi(port));
+ newSockState->channel, host, atoi(port));
}
}
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 92ea830..3bda2e1 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -105,7 +105,7 @@ TclplatformtestInit(
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
- NULL, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
@@ -164,7 +164,7 @@ TestfilehandlerCmd(
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" option ... \"", NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
pipePtr = NULL;
if (argc >= 3) {
@@ -259,9 +259,9 @@ TestfilehandlerCmd(
return TCL_ERROR;
}
- while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
+ while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
/* Empty loop body. */
- }
+ }
} else if (strcmp(argv[1], "fill") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
@@ -270,9 +270,9 @@ TestfilehandlerCmd(
}
memset(buffer, 'a', 4000);
- while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
+ while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
/* Empty loop body. */
- }
+ }
} else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
@@ -480,18 +480,18 @@ TestgetopenfileCmd(
ClientData filePtr;
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName forWriting\"", NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
== TCL_ERROR) {
- return TCL_ERROR;
+ return TCL_ERROR;
}
if (filePtr == NULL) {
- Tcl_AppendResult(interp,
+ Tcl_AppendResult(interp,
"Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
return TCL_OK;
}
@@ -521,9 +521,9 @@ TestsetdefencdirCmd(
const char **argv) /* Argument strings. */
{
if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" defaultDir\"", NULL);
- return TCL_ERROR;
+ return TCL_ERROR;
}
Tcl_SetDefaultEncodingDir(argv[1]);
@@ -557,14 +557,14 @@ TestforkObjCmd(
pid_t pid;
if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, "");
- return TCL_ERROR;
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
}
pid = fork();
if (pid == -1) {
- Tcl_AppendResult(interp,
- "Cannot fork", NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp,
+ "Cannot fork", NULL);
+ return TCL_ERROR;
}
/* Only needed when pthread_atfork is not present,
* should not hurt otherwise. */
@@ -600,8 +600,8 @@ TestgetdefencdirCmd(
const char **argv) /* Argument strings. */
{
if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
+ return TCL_ERROR;
}
Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 85a31e1..c6a24d1 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -187,7 +187,7 @@ TclpGetWideClicks(void)
now = ((Tcl_WideInt)time.sec)*1000000 + time.usec;
} else {
#ifdef MAC_OSX_TCL
- now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX);
+ now = (Tcl_WideInt)(mach_absolute_time() & INT64_MAX);
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
diff --git a/win/Makefile.in b/win/Makefile.in
index 3b89dd7..c433b6c 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -516,7 +516,7 @@ ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
@$(RM) ${TEST_EXE_FILE}
$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest
# use prebuilt zlib1.dll
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index b0799f8..4fc9f7a 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -90,7 +90,7 @@ main(
case 'c':
if (argc != 3) {
chars = snprintf(msg, sizeof(msg) - 1,
- "usage: %s -c <compiler option>\n"
+ "usage: %s -c <compiler option>\n"
"Tests for whether cl.exe supports an option\n"
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
@@ -271,7 +271,7 @@ CheckForCompilerFeature(
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
- "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err);
+ "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
@@ -318,11 +318,11 @@ CheckForCompilerFeature(
*/
return !(strstr(Out.buffer, "D4002") != NULL
- || strstr(Err.buffer, "D4002") != NULL
- || strstr(Out.buffer, "D9002") != NULL
- || strstr(Err.buffer, "D9002") != NULL
- || strstr(Out.buffer, "D2021") != NULL
- || strstr(Err.buffer, "D2021") != NULL);
+ || strstr(Err.buffer, "D4002") != NULL
+ || strstr(Out.buffer, "D9002") != NULL
+ || strstr(Err.buffer, "D9002") != NULL
+ || strstr(Out.buffer, "D2021") != NULL
+ || strstr(Err.buffer, "D2021") != NULL);
}
static int
@@ -405,7 +405,7 @@ CheckForLinkerFeature(
if (!ok) {
DWORD err = GetLastError();
int chars = snprintf(msg, sizeof(msg) - 1,
- "Tried to launch: \"%s\", but got error [%lu]: ", cmdline, err);
+ "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
@@ -600,9 +600,9 @@ list_free(list_item_t **listPtrPtr)
*
* Usage is something like:
* nmakehlp -S << $** > $@
- * @PACKAGE_NAME@ $(PACKAGE_NAME)
- * @PACKAGE_VERSION@ $(PACKAGE_VERSION)
- * <<
+ * @PACKAGE_NAME@ $(PACKAGE_NAME)
+ * @PACKAGE_VERSION@ $(PACKAGE_VERSION)
+ * <<
*/
static int
@@ -730,7 +730,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
return 2; /* Have no real error reporting mechanism into nmake */
}
dirlen = strlen(dir);
- if (dirlen > sizeof(path) - 3) {
+ if ((dirlen + 3) > sizeof(path)) {
return 2;
}
strncpy(path, dir, dirlen);
@@ -747,8 +747,9 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
#else
hSearch = FindFirstFile(path, &finfo);
#endif
- if (hSearch == INVALID_HANDLE_VALUE)
+ if (hSearch == INVALID_HANDLE_VALUE) {
return 1; /* Not found */
+ }
/* Loop through all subdirs checking if the keypath is under there */
ret = 1; /* Assume not found */
@@ -758,11 +759,13 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
* We need to check it is a directory despite the
* FindExSearchLimitToDirectories in the above call. See SDK docs
*/
- if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
+ if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) {
continue;
+ }
sublen = strlen(finfo.cFileName);
- if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
+ if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) {
continue; /* Path does not fit, assume not matched */
+ }
strncpy(path+dirlen+1, finfo.cFileName, sublen);
path[dirlen+1+sublen] = '\\';
strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
@@ -782,13 +785,13 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
* LocateDependency --
*
* Locates a dependency for a package.
- * keypath - a relative path within the package directory
- * that is used to confirm it is the correct directory.
+ * keypath - a relative path within the package directory
+ * that is used to confirm it is the correct directory.
* The search path for the package directory is currently only
- * the parent and grandparent of the current working directory.
- * If found, the command prints
- * name_DIRPATH=<full path of located directory>
- * and returns 0. If not found, does not print anything and returns 1.
+ * the parent and grandparent of the current working directory.
+ * If found, the command prints
+ * name_DIRPATH=<full path of located directory>
+ * and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 65c6441..0bf21dd 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -925,7 +925,7 @@ TclpObjCopyDirectory(
} else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
*errorPtr = destPathPtr;
} else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
+ *errorPtr = TclDStringToObj(&ds);
}
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index d0ff73e..38c6504 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -29,7 +29,7 @@
*/
#define POSIX_EPOCH_AS_FILETIME \
- ((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000)
+ ((Tcl_WideInt)116444736 * (Tcl_WideInt)1000000000)
/*
* Declarations for 'link' related information. This information should come
@@ -2094,8 +2094,8 @@ NativeStat(
statPtr->st_ctime = ToCTime(data.ftCreationTime);
}
attr = data.dwFileAttributes;
- statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
- (((Tcl_WideInt) data.nFileSizeHigh) << 32);
+ statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) |
+ (((Tcl_WideInt)data.nFileSizeHigh) << 32);
/*
* On Unix, for directories, nlink apparently depends on the number of
@@ -2142,8 +2142,8 @@ NativeStat(
attr = data.dwFileAttributes;
- statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
- (((Tcl_WideInt) data.nFileSizeHigh) << 32);
+ statPtr->st_size = ((Tcl_WideInt)data.nFileSizeLow) |
+ (((Tcl_WideInt)data.nFileSizeHigh) << 32);
statPtr->st_atime = ToCTime(data.ftLastAccessTime);
statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
statPtr->st_ctime = ToCTime(data.ftCreationTime);
@@ -2303,7 +2303,7 @@ ToCTime(
convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
return (time_t) ((convertedTime.QuadPart -
- (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
+ (Tcl_WideInt)POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt)10000000);
}
/*
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index df81c46..e077186 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -367,11 +367,14 @@ InitializeHostName(
if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) {
/*
- * Convert string from native to UTF then change to lowercase.
+ * Convert string from WCHAR to utf-8, then change to lowercase,
+ * then to system encoding.
*/
+ Tcl_DString inDs;
- Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &ds));
-
+ Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *)wbuf, -1, &inDs));
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&inDs), -1, &ds);
+ Tcl_DStringFree(&inDs);
} else {
Tcl_DStringInit(&ds);
if (TclpHasSockets(NULL) == TCL_OK) {
@@ -380,20 +383,14 @@ InitializeHostName(
* documents gethostname() as being always adequate.
*/
- Tcl_DString inDs;
-
- Tcl_DStringInit(&inDs);
- Tcl_DStringSetLength(&inDs, 256);
- if (gethostname(Tcl_DStringValue(&inDs),
- Tcl_DStringLength(&inDs)) == 0) {
- Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs),
- -1, &ds);
- }
- Tcl_DStringFree(&inDs);
+ Tcl_DStringInit(&ds);
+ Tcl_DStringSetLength(&ds, 256);
+ gethostname(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringSetLength(&ds, strlen(Tcl_DStringValue(&ds)));
}
}
- *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
+ *encodingPtr = Tcl_GetEncoding(NULL, NULL);
*lengthPtr = Tcl_DStringLength(&ds);
*valuePtr = (char *)ckalloc(*lengthPtr + 1);
memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index b46c101..6d04550 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -97,11 +97,11 @@ static TimeInfo timeInfo = {
(HANDLE) NULL,
(HANDLE) NULL,
#ifdef HAVE_CAST_TO_UNION
- (LARGE_INTEGER) (Tcl_WideInt) 0,
- (ULARGE_INTEGER) (DWORDLONG) 0,
- (LARGE_INTEGER) (Tcl_WideInt) 0,
- (LARGE_INTEGER) (Tcl_WideInt) 0,
- (LARGE_INTEGER) (Tcl_WideInt) 0,
+ (LARGE_INTEGER) (Tcl_WideInt)0,
+ (ULARGE_INTEGER) (DWORDLONG)0,
+ (LARGE_INTEGER) (Tcl_WideInt)0,
+ (LARGE_INTEGER) (Tcl_WideInt)0,
+ (LARGE_INTEGER) (Tcl_WideInt)0,
#else
{{0, 0}},
{{0, 0}},
@@ -506,7 +506,7 @@ NativeGetMicroseconds(void)
* && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)1193182
* && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt)3579545
*/
- && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000){
+ && timeInfo.nominalFreq.QuadPart > 15000000){
/*
* As an exception, if every logical processor on the system
* is on the same chip, we use the performance counter anyway,
@@ -1318,7 +1318,7 @@ AccumulateSample(
estFreq = 10000000 * (perfCounter - workPCSample)
/ (fileTime - workFTSample);
timeInfo.perfCounterSample[timeInfo.sampleNo] = perfCounter;
- timeInfo.fileTimeSample[timeInfo.sampleNo] = (Tcl_WideInt) fileTime;
+ timeInfo.fileTimeSample[timeInfo.sampleNo] = fileTime;
/*
* Advance the sample number.