diff options
53 files changed, 360 insertions, 473 deletions
@@ -36,6 +36,7 @@ writing Tcl scripts. - Removed subcommands [trace variable|vdelete|vinfo] - No -eofchar option for channels anymore for writing. - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. + - Removed command ::tcl::unsupported::inject. ## Incompatibilities in C public interface - Many arguments expanded type from int to Tcl_Size diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index d15a920..5d25667 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -102,9 +102,12 @@ version 8.1 of Tcl. .PP \fIProc\fR must return an integer code that is expected to be one of \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or -\fBTCL_CONTINUE\fR. See the Tcl overview man page -for details on what these codes mean. Most normal commands will only -return \fBTCL_OK\fR or \fBTCL_ERROR\fR. In addition, \fIproc\fR must set +\fBTCL_CONTINUE\fR. See the \fBreturn\fR man page for details on +what these codes mean and the use of extended values for an extension's +private use. Most normal commands will only return \fBTCL_OK\fR +or \fBTCL_ERROR\fR. +.PP +In addition, \fIproc\fR must set the interpreter result; in the case of a \fBTCL_OK\fR return code this gives the result of the command, and in the case of \fBTCL_ERROR\fR it gives an error message. diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 522f903..b28d901 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -132,9 +132,10 @@ that \fIobjv\fR[\fB2\fR] points at, but will not change where .PP \fIproc\fR must return an integer code that is either \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. -See the Tcl overview man page -for details on what these codes mean. Most normal commands will only -return \fBTCL_OK\fR or \fBTCL_ERROR\fR. +See the \fBreturn\fR man page for details on what these codes mean and the +use of extended values for an extension's private use. Most normal commands +will only return \fBTCL_OK\fR or \fBTCL_ERROR\fR. +.PP In addition, if \fIproc\fR needs to return a non-empty result, it can call \fBTcl_SetObjResult\fR to set the interpreter's result. In the case of a \fBTCL_OK\fR return code this gives the result diff --git a/doc/catch.n b/doc/catch.n index 8d885d4..0a2c513 100644 --- a/doc/catch.n +++ b/doc/catch.n @@ -30,10 +30,12 @@ return codes: 1 (\fBTCL_ERROR\fR), 2 (\fBTCL_RETURN\fR), 3 (\fBTCL_BREAK\fR), and 4 (\fBTCL_CONTINUE\fR). Errors during evaluation of a script are indicated by a return code of \fBTCL_ERROR\fR. The other exceptional return codes are returned by the \fBreturn\fR, \fBbreak\fR, and \fBcontinue\fR commands -and in other special situations as documented. Tcl packages can define -new commands that return other integer values as return codes as well, -and scripts that make use of the \fBreturn \-code\fR command can also -have return codes other than the five defined by Tcl. +and in other special situations as documented. +New commands defined by Tcl packages as well as scripts that make +use of the \fBreturn \-code\fR command can return other integer +values as the return code. These must however lie outside the range +reserved for Tcl as documented for the \fBreturn\fR command. + .PP If the \fIresultVarName\fR argument is given, then the variable it names is set to the result of the script evaluation. When the return code from the @@ -23,19 +23,19 @@ the process's standard input, output and error streams respectively). abbreviation for \fIoption\fR is acceptable. Valid options are: .\" METHOD: blocked .TP -\fBchan blocked \fIchannelId\fR +\fBchan blocked \fIchannel\fR . This tests whether the last input operation on the channel called -\fIchannelId\fR failed because it would have otherwise caused the +\fIchannel\fR failed because it would have otherwise caused the 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? +\fBchan close \fIchannel\fR ?\fIdirection\fR? . -Close and destroy the channel called \fIchannelId\fR. Note that this +Close and destroy the channel called \fIchannel\fR. Note that this deletes all existing file-events registered on the channel. If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or any unique abbreviation of them) is present, the channel will only be @@ -51,7 +51,7 @@ write-only channel for reading. As part of closing the channel, all buffered output is flushed to the channel's output device (only if the channel is ceasing to be writable), any buffered input is discarded (only if the channel is ceasing to be readable), -the underlying operating system resource is closed and \fIchannelId\fR becomes +the underlying operating system resource is closed and \fIchannel\fR becomes unavailable for future use (both only if the channel is being completely closed). .PP @@ -61,11 +61,11 @@ non-blocking and there is unflushed output, the channel remains open and the command returns immediately; output will be flushed in the background and the channel will be closed when all the flushing is complete. .PP -If \fIchannelId\fR is a blocking channel for a command pipeline then +If \fIchannel\fR is a blocking channel for a command pipeline then \fBchan close\fR waits for the child processes to complete. .PP If the channel is shared between interpreters, then \fBchan close\fR -makes \fIchannelId\fR unavailable in the invoking interpreter but has +makes \fIchannel\fR unavailable in the invoking interpreter but has no other effect until all of the sharing interpreters have closed the channel. When the last interpreter in which the channel is registered invokes \fBchan close\fR (or \fBclose\fR), the cleanup actions @@ -101,10 +101,10 @@ restores the previous behavior. .RE .\" METHOD: configure .TP -\fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... +\fBchan configure \fIchannel\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . Query or set the configuration options of the channel named -\fIchannelId\fR. +\fIchannel\fR. .RS .PP If no \fIoptionName\fR or \fIvalue\fR arguments are supplied, the @@ -391,18 +391,18 @@ within the safe interpreter. .RE .\" METHOD: eof .TP -\fBchan eof \fIchannelId\fR +\fBchan eof \fIchannel\fR . Test whether the last input operation on the channel called -\fIchannelId\fR failed because the end of the data stream was reached, +\fIchannel\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? +\fBchan event \fIchannel event\fR ?\fIscript\fR? . Arrange for the Tcl script \fIscript\fR to be installed as a \fIfile event handler\fR to be called whenever the channel called -\fIchannelId\fR enters the state described by \fIevent\fR (which must +\fIchannel\fR enters the state described by \fIevent\fR (which must be either \fBreadable\fR or \fBwritable\fR); only one such handler may be installed per event per channel at a time. If \fIscript\fR is the empty string, the current handler is deleted (this also happens if the @@ -468,9 +468,9 @@ loops due to buggy handlers. .RE .\" METHOD: flush .TP -\fBchan flush \fIchannelId\fR +\fBchan flush \fIchannel\fR . -Ensures that all pending output for the channel called \fIchannelId\fR +Ensures that all pending output for the channel called \fIchannel\fR is written. .RS .PP @@ -483,7 +483,7 @@ it. .RE .\" METHOD: gets .TP -\fBchan gets \fIchannelId\fR ?\fIvarName\fR? +\fBchan gets \fIchannel\fR ?\fIvarName\fR? . Reads a line from the channel consisting of all characters up to the next end-of-line sequence or until end of file is seen. The line feed character @@ -536,12 +536,12 @@ 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 +\fBchan pending \fImode channel\fR . Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR, returns the number of bytes of input or output (respectively) currently buffered -internally for \fIchannelId\fR (especially useful in a readable event +internally for \fIchannel\fR (especially useful in a readable event 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). @@ -572,20 +572,20 @@ allowed for. .RE .\" METHOD: pop .TP -\fBchan pop \fIchannelId\fR +\fBchan pop \fIchannel\fR . -Removes the topmost transformation from the channel \fIchannelId\fR, if there -is any. If there are no transformations added to \fIchannelId\fR, this is +Removes the topmost transformation from the channel \fIchannel\fR, if there +is any. If there are no transformations added to \fIchannel\fR, this is 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). .\" METHOD: postevent .TP -\fBchan postevent \fIchannelId eventSpec\fR +\fBchan postevent \fIchannel eventSpec\fR . This subcommand is used by command handlers specified with \fBchan create\fR. It notifies the channel represented by the handle -\fIchannelId\fR that the event(s) listed in the \fIeventSpec\fR have +\fIchannel\fR that the event(s) listed in the \fIeventSpec\fR have occurred. The argument has to be a list containing any of the strings \fBread\fR and \fBwrite\fR. The list must contain at least one element as it does not make sense to invoke the command if there are @@ -618,9 +618,9 @@ executed in the interpreter that set them up. .RE .\" METHOD: push .TP -\fBchan push \fIchannelId cmdPrefix\fR +\fBchan push \fIchannel cmdPrefix\fR . -Adds a new transformation on top of the channel \fIchannelId\fR. The +Adds a new transformation on top of the channel \fIchannel\fR. The \fIcmdPrefix\fR argument describes a list of one or more words which represent a handler that will be used to implement the transformation. The command prefix must provide the API described in the \fBtranschan\fR manual page. @@ -630,11 +630,11 @@ channel mode that it is used with or this can make the channel neither readable nor writable. .\" METHOD: puts .TP -\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR +\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannel\fR? \fIstring\fR . -Writes \fIstring\fR to the channel named \fIchannelId\fR followed by a +Writes \fIstring\fR to the channel named \fIchannel\fR followed by a newline character. A trailing newline character is written unless the -optional flag \fB\-nonewline\fR is given. If \fIchannelId\fR is +optional flag \fB\-nonewline\fR is given. If \fIchannel\fR is omitted, the string is written to the standard output channel, \fBstdout\fR. .RS @@ -654,7 +654,7 @@ flush\fR command. .PP When the output buffer fills up, the \fBchan puts\fR command will normally block until all the buffered data has been accepted for -output by the operating system. If \fIchannelId\fR is in non-blocking +output by the operating system. If \fIchannel\fR is in non-blocking mode then the \fBchan puts\fR command will not block even if the operating system cannot accept the data. Instead, Tcl continues to buffer the data and writes it in the background as fast as the @@ -675,12 +675,12 @@ may be partially written to the channel in this case. .RE .\" METHOD: read .TP -\fBchan read \fIchannelId\fR ?\fInumChars\fR? +\fBchan read \fIchannel\fR ?\fInumChars\fR? .TP -\fBchan read \fR?\fB\-nonewline\fR? \fIchannelId\fR +\fBchan read \fR?\fB\-nonewline\fR? \fIchannel\fR . In the first form, the result will be the next \fInumChars\fR -characters read from the channel named \fIchannelId\fR; if +characters read from the channel named \fIchannel\fR; if \fInumChars\fR is omitted, all characters up to the point when the channel would signal a failure (whether an end-of-file, blocked or other error condition) are read. In the second form (i.e. when @@ -689,7 +689,7 @@ given to indicate that any trailing newline in the string that has been read should be trimmed. .RS .PP -If \fIchannelId\fR is in non-blocking mode, \fBchan read\fR may not +If \fIchannel\fR is in non-blocking mode, \fBchan read\fR may not read as many characters as requested: once all available input has been read, the command will return the data that is available rather than blocking for more input. If the channel is configured to use a @@ -708,7 +708,7 @@ When reading from a serial port, most applications should configure the serial port channel to be non-blocking, like this: .PP .CS -\fBchan configure \fIchannelId \fB\-blocking \fI0\fR. +\fBchan configure \fIchannel \fB\-blocking \fI0\fR. .CE .PP Then \fBchan read\fR behaves much like described above. Note that @@ -716,12 +716,12 @@ most serial ports are comparatively slow; it is entirely possible to get a \fBreadable\fR event for each character read from them. Care must be taken when using \fBchan read\fR on blocking serial ports: .TP -\fBchan read \fIchannelId numChars\fR +\fBchan read \fIchannel numChars\fR . In this form \fBchan read\fR blocks until \fInumChars\fR have been received from the serial port. .TP -\fBchan read \fIchannelId\fR +\fBchan read \fIchannel\fR . In this form \fBchan read\fR blocks until the reception of the end-of-file character, see \fBchan configure -eofchar\fR. If there no @@ -745,10 +745,10 @@ changing the encoding in use. See \fBENCODING ERROR EXAMPLES\fR later. .RE .\" METHOD: seek .TP -\fBchan seek \fIchannelId offset\fR ?\fIorigin\fR? +\fBchan seek \fIchannel offset\fR ?\fIorigin\fR? . Sets the current access position within the underlying data stream for -the channel named \fIchannelId\fR to be \fIoffset\fR bytes relative to +the channel named \fIchannel\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 @@ -779,20 +779,20 @@ not characters, unlike \fBchan read\fR. .RE .\" METHOD: tell .TP -\fBchan tell \fIchannelId\fR +\fBchan tell \fIchannel\fR . Returns a number giving the current access position within the -underlying data stream for the channel named \fIchannelId\fR. This +underlying data stream for the channel named \fIchannel\fR. This 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? +\fBchan truncate \fIchannel\fR ?\fIlength\fR? . Sets the byte length of the underlying data stream for the channel -named \fIchannelId\fR to be \fIlength\fR (or to the current byte +named \fIchannel\fR to be \fIlength\fR (or to the current byte offset within the underlying data stream if \fIlength\fR is omitted). The channel is flushed before truncation. . diff --git a/doc/close.n b/doc/close.n index f3a61be..eecc48f 100644 --- a/doc/close.n +++ b/doc/close.n @@ -12,7 +12,7 @@ .SH NAME close \- Close an open channel .SH SYNOPSIS -\fBclose \fIchannelId\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)? +\fBclose \fIchannel\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)? .BE .SH DESCRIPTION .PP @@ -12,7 +12,7 @@ .SH NAME eof \- Check for end of file condition on channel .SH SYNOPSIS -\fBeof \fIchannelId\fR +\fBeof \fIchannel\fR .BE .SH DESCRIPTION .PP diff --git a/doc/fblocked.n b/doc/fblocked.n index 239c465..00fe7a7 100644 --- a/doc/fblocked.n +++ b/doc/fblocked.n @@ -10,7 +10,7 @@ .SH NAME fblocked \- Test whether the last input operation exhausted all available input .SH SYNOPSIS -\fBfblocked \fIchannelId\fR +\fBfblocked \fIchannel\fR .BE .SH DESCRIPTION .PP diff --git a/doc/fconfigure.n b/doc/fconfigure.n index 2870d54..e185122 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -12,9 +12,9 @@ fconfigure \- Set and get options on a channel .SH SYNOPSIS .nf -\fBfconfigure \fIchannelId\fR -\fBfconfigure \fIchannelId name\fR -\fBfconfigure \fIchannelId name value \fR?\fIname value ...\fR? +\fBfconfigure \fIchannel\fR +\fBfconfigure \fIchannel name\fR +\fBfconfigure \fIchannel name value \fR?\fIname value ...\fR? .fi .BE .SH DESCRIPTION diff --git a/doc/fileevent.n b/doc/fileevent.n index 4ba534a..d90e376 100644 --- a/doc/fileevent.n +++ b/doc/fileevent.n @@ -13,9 +13,9 @@ .SH NAME fileevent \- Execute a script when a channel becomes readable or writable .SH SYNOPSIS -\fBfileevent \fIchannelId \fBreadable \fR?\fIscript\fR? +\fBfileevent \fIchannel \fBreadable \fR?\fIscript\fR? .sp -\fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR? +\fBfileevent \fIchannel \fBwritable \fR?\fIscript\fR? .BE .SH DESCRIPTION .PP diff --git a/doc/flush.n b/doc/flush.n index 259f4cb..956750e 100644 --- a/doc/flush.n +++ b/doc/flush.n @@ -12,7 +12,7 @@ .SH NAME flush \- Flush buffered output for a channel .SH SYNOPSIS -\fBflush \fIchannelId\fR +\fBflush \fIchannel\fR .BE .SH DESCRIPTION .PP diff --git a/doc/format.n b/doc/format.n index 59774fc..b1e204a 100644 --- a/doc/format.n +++ b/doc/format.n @@ -141,8 +141,7 @@ element of the \fBtcl_platform\fR array. If it is \fBL\fR it specifies that an integer or double value is taken without truncation for conversion to a formatted substring. If neither of those are present, the integer value is -truncated to the range determined by the value of the -\fBwordSize\fR element of the \fBtcl_platform\fR array). +truncated to a 32-bit range. .SS "MANDATORY CONVERSION TYPE" .PP The last thing in a conversion specifier is an alphabetic character @@ -12,7 +12,7 @@ .SH NAME gets \- Read a line from a channel .SH SYNOPSIS -\fBgets \fIchannelId\fR ?\fIvarName\fR? +\fBgets \fIchannel\fR ?\fIvarName\fR? .BE .SH DESCRIPTION .PP diff --git a/doc/interp.n b/doc/interp.n index 2c08533..74745be 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -392,9 +392,9 @@ the maximum size of the C stack. .RE .\" METHOD: share .TP -\fBinterp share\fI srcPath channelId destPath\fR +\fBinterp share\fI srcPath channel destPath\fR . -Causes the IO channel identified by \fIchannelId\fR to become shared +Causes the IO channel identified by \fIchannel\fR to become shared between the interpreter identified by \fIsrcPath\fR and the interpreter identified by \fIdestPath\fR. Both interpreters have the same permissions on the IO channel. @@ -415,9 +415,9 @@ invoking interpreter or one of its descendants then an error is generated. The target command does not have to be defined at the time of this invocation. .\" METHOD: transfer .TP -\fBinterp transfer\fI srcPath channelId destPath\fR +\fBinterp transfer\fI srcPath channel destPath\fR . -Causes the IO channel identified by \fIchannelId\fR to become available in +Causes the IO channel identified by \fIchannel\fR to become available in the interpreter identified by \fIdestPath\fR and unavailable in the interpreter identified by \fIsrcPath\fR. .SH "CHILD COMMAND" diff --git a/doc/namespace.n b/doc/namespace.n index 5f02082..c19791c 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -495,8 +495,10 @@ However, if the name does not start with a \fB::\fR (i.e., is \fIrelative\fR), Tcl follows basic rules for looking it up: .IP \(bu -\fBVariable names\fR are always resolved by looking first in the current -namespace, and then in the global namespace. +\fBVariable names\fR are always resolved starting in the current +namespace. In the absence of special resolvers, foo::bar::baz refers to +a variable named "baz" in a namespace named "bar" that is a child of a +namespace named "foo" that is a child of the current namespace of the interpreter. .IP \(bu \fBCommand names\fR are always resolved by looking in the current namespace first. If not found there, they are searched for in every namespace on the @@ -516,10 +518,9 @@ set traceLevel 0 } .CE .PP -Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR -and then in the global namespace. +Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR. It looks up the command \fBprintTrace\fR in the same way. -If a variable or command name is not found in either context, +If a variable or command name is not found, the name is undefined. To make this point absolutely clear, consider the following example: .PP @@ -534,11 +535,9 @@ set traceLevel 0 } .CE .PP -Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR. -Since it is not found there, Tcl then looks for it -in the global namespace. -The variable \fBFoo::traceLevel\fR is completely ignored -during the name resolution process. +Here Tcl looks for \fBtraceLevel\fR in the namespace \fBFoo::Debug\fR. +The variables \fBFoo::traceLevel\fR and \fBFoo::Debug::traceLevel\fR +are completely ignored during the name resolution process. .PP You can use the \fBnamespace which\fR command to clear up any question about name resolution. @@ -548,19 +547,19 @@ For example, the command: \fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR -variable traceLevel} .CE .PP -returns \fB::traceLevel\fR. -On the other hand, the command, +returns the empty string. +The command, .PP .CS \fBnamespace eval\fR Foo {\fBnamespace which\fR -variable traceLevel} .CE .PP -returns \fB::Foo::traceLevel\fR. +returns the empty string as well. .PP As mentioned above, -namespace names are looked up differently -than the names of variables and commands. -Namespace names are always resolved in the current namespace. +namespace names and variables are looked up differently +than the names of commands. +Namespace names and variables are always resolved in the current namespace. This means, for example, that a \fBnamespace eval\fR command that creates a new namespace always creates a child of the current namespace @@ -12,7 +12,7 @@ .SH NAME puts \- Write to a channel .SH SYNOPSIS -\fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR +\fBputs \fR?\fB\-nonewline\fR? ?\fIchannel\fR? \fIstring\fR .BE .SH DESCRIPTION .PP @@ -12,9 +12,9 @@ .SH NAME read \- Read from a channel .SH SYNOPSIS -\fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR +\fBread \fR?\fB\-nonewline\fR? \fIchannel\fR .sp -\fBread \fIchannelId numChars\fR +\fBread \fIchannel numChars\fR .BE .SH DESCRIPTION .PP diff --git a/doc/refchan.n b/doc/refchan.n index b997ddb..4f78a7b 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -14,16 +14,16 @@ refchan \- command handler API of reflected channels .nf \fBchan create \fImode cmdPrefix\fR -\fIcmdPrefix \fBblocking\fI channelId mode\fR -\fIcmdPrefix \fBcget\fI channelId option\fR -\fIcmdPrefix \fBcgetall\fI channelId\fR -\fIcmdPrefix \fBconfigure\fI channelId option value\fR -\fIcmdPrefix \fBfinalize\fI channelId\fR -\fIcmdPrefix \fBinitialize\fI channelId mode\fR -\fIcmdPrefix \fBread\fI channelId count\fR -\fIcmdPrefix \fBseek\fI channelId offset base\fR -\fIcmdPrefix \fBwatch\fI channelId eventspec\fR -\fIcmdPrefix \fBwrite\fI channelId data\fR +\fIcmdPrefix \fBblocking\fI channel mode\fR +\fIcmdPrefix \fBcget\fI channel option\fR +\fIcmdPrefix \fBcgetall\fI channel\fR +\fIcmdPrefix \fBconfigure\fI channel option value\fR +\fIcmdPrefix \fBfinalize\fI channel\fR +\fIcmdPrefix \fBinitialize\fI channel mode\fR +\fIcmdPrefix \fBread\fI channel count\fR +\fIcmdPrefix \fBseek\fI channel offset base\fR +\fIcmdPrefix \fBwatch\fI channel eventspec\fR +\fIcmdPrefix \fBwrite\fI channel data\fR .fi .BE .SH DESCRIPTION @@ -44,10 +44,10 @@ other subcommands is optional. .SS "MANDATORY SUBCOMMANDS" .\" METHOD: initialize .TP -\fIcmdPrefix \fBinitialize \fIchannelId mode\fR +\fIcmdPrefix \fBinitialize \fIchannel mode\fR . An invocation of this subcommand will be the first call the -\fIcmdPrefix\fR will receive for the specified new \fIchannelId\fR. It +\fIcmdPrefix\fR will receive for the specified new \fIchannel\fR. It is the responsibility of this subcommand to set up any internal data structures required to keep track of the channel and its state. .RS @@ -75,13 +75,13 @@ supported by the \fIcmdPrefix\fR. .RE .\" METHOD: finalize .TP -\fIcmdPrefix \fBfinalize \fIchannelId\fR +\fIcmdPrefix \fBfinalize \fIchannel\fR . An invocation of this subcommand will be the last call the -\fIcmdPrefix\fR will receive for the specified \fIchannelId\fR. It will +\fIcmdPrefix\fR will receive for the specified \fIchannel\fR. It will be generated just before the destruction of the data structures of the channel held by the Tcl core. The command handler \fImust not\fR -access the \fIchannelId\fR anymore in no way. Upon this subcommand being +access the \fIchannel\fR anymore in no way. Upon this subcommand being called, any internal resources allocated to this channel must be cleaned up. .RS @@ -98,10 +98,10 @@ aborted during \fBinitialize\fR (See above). .RE .\" METHOD: watch .TP -\fIcmdPrefix \fBwatch \fIchannelId eventspec\fR +\fIcmdPrefix \fBwatch \fIchannel eventspec\fR . This subcommand notifies the \fIcmdPrefix\fR that the specified -\fIchannelId\fR is interested in the events listed in the +\fIchannel\fR is interested in the events listed in the \fIeventspec\fR. This argument is a list containing any of \fBread\fR and \fBwrite\fR. The list may be empty, which signals that the channel does not wish to be notified of any events. In that situation, @@ -119,10 +119,10 @@ event which was not listed in the last call to \fBwatch\fR will cause .SS "OPTIONAL SUBCOMMANDS" .\" METHOD: read .TP -\fIcmdPrefix \fBread \fIchannelId count\fR +\fIcmdPrefix \fBread \fIchannel count\fR . This \fIoptional\fR subcommand is called when the user requests data from the -channel \fIchannelId\fR. \fIcount\fR specifies how many \fIbytes\fR have been +channel \fIchannel\fR. \fIcount\fR specifies how many \fIbytes\fR have been requested. If the subcommand is not supported then it is not possible to read from the channel handled by the command. .RS @@ -176,10 +176,10 @@ etc.) is treated as and converted to an error. .RE .\" METHOD: write .TP -\fIcmdPrefix \fBwrite \fIchannelId data\fR +\fIcmdPrefix \fBwrite \fIchannel data\fR . This \fIoptional\fR subcommand is called when the user writes data to -the channel \fIchannelId\fR. The \fIdata\fR argument contains \fIbytes\fR, not +the channel \fIchannel\fR. The \fIdata\fR argument contains \fIbytes\fR, not characters. Any type of transformation (EOL, encoding) configured for the channel has already been applied at this point. If this subcommand is not supported then it is not possible to write to the channel @@ -234,11 +234,11 @@ as and converted to an error. .RE .\" METHOD: seek .TP -\fIcmdPrefix \fBseek \fIchannelId offset base\fR +\fIcmdPrefix \fBseek \fIchannel offset base\fR . This \fIoptional\fR subcommand is responsible for the handling of \fBchan seek\fR and \fBchan tell\fR requests on the channel -\fIchannelId\fR. If it is not supported then seeking will not be possible for +\fIchannel\fR. If it is not supported then seeking will not be possible for the channel. .RS .PP @@ -271,10 +271,10 @@ the new location identical to the current one, which is then returned. .RE .\" METHOD: configure .TP -\fIcmdPrefix \fBconfigure \fIchannelId option value\fR +\fIcmdPrefix \fBconfigure \fIchannel option value\fR . This \fIoptional\fR subcommand is for setting the type-specific options of -channel \fIchannelId\fR. The \fIoption\fR argument indicates the option to be +channel \fIchannel\fR. The \fIoption\fR argument indicates the option to be written, and the \fIvalue\fR argument indicates the value to set the option to. .RS .PP @@ -291,10 +291,10 @@ converted to an error. .RE .\" METHOD: cget .TP -\fIcmdPrefix \fBcget \fIchannelId option\fR +\fIcmdPrefix \fBcget \fIchannel option\fR . This \fIoptional\fR subcommand is used when reading a single type-specific -option of channel \fIchannelId\fR. If this subcommand is supported then the +option of channel \fIchannel\fR. If this subcommand is supported then the subcommand \fBcgetall\fR must be supported as well. .RS .PP @@ -307,10 +307,10 @@ will appear to have thrown this error. Any exception beyond \fIerror\fR .RE .\" METHOD: cgetall .TP -\fIcmdPrefix \fBcgetall \fIchannelId\fR +\fIcmdPrefix \fBcgetall \fIchannel\fR . This \fIoptional\fR subcommand is used for reading all type-specific options -of channel \fIchannelId\fR. If this subcommand is supported then the +of channel \fIchannel\fR. If this subcommand is supported then the subcommand \fBcget\fR has to be supported as well. .RS .PP @@ -324,10 +324,10 @@ will appear to have thrown this error. Any exception beyond \fBerror\fR .RE .\" METHOD: blocking .TP -\fIcmdPrefix \fBblocking \fIchannelId mode\fR +\fIcmdPrefix \fBblocking \fIchannel mode\fR . This \fIoptional\fR subcommand handles changes to the blocking mode of the -channel \fIchannelId\fR. The \fImode\fR is a boolean flag. A true value means +channel \fIchannel\fR. The \fImode\fR is a boolean flag. A true value means that the channel has to be set to blocking, and a false value means that the channel should be non-blocking. .RS @@ -341,10 +341,10 @@ etc.) is treated as and converted to an error. .RE .\" METHOD: truncate .TP -\fIcmdPrefix \fBtruncate\fI channelId length\fR +\fIcmdPrefix \fBtruncate\fI channel length\fR . This \fIoptional\fR subcommand handles changing the length of the -underlying data stream for the channel \fIchannelId\fR. Its length +underlying data stream for the channel \fIchannel\fR. Its length gets set to \fIlength\fR. .RS .PP diff --git a/doc/return.n b/doc/return.n index 9bf1ae2..d285e87 100644 --- a/doc/return.n +++ b/doc/return.n @@ -78,7 +78,10 @@ were the command \fBcontinue\fR. \fIvalue\fR . \fIValue\fR must be an integer; it will be returned as the -return code for the current procedure. +return code for the current procedure. Applications +and packages should use values in the range 5 to 1073741823 (0x3fffffff) +for their own purposes. Values outside this range are reserved +for use by Tcl. .LP When a procedure wants to signal that it has received invalid arguments from its caller, it may use \fBreturn -code error\fR @@ -73,17 +73,18 @@ The size modifier field is used only when scanning a substring into one of Tcl's integer values. The size modifier field dictates the integer range acceptable to be stored in a variable, or, for the inline case, in a position in the result list. -The syntactically valid values for the size modifier are \fBh\fR, \fBL\fR, -\fBl\fR, \fBz\fR, \fBt\fR, and \fBll\fR. The \fBh\fR size -modifier value is equivalent -to the absence of a size modifier in the the conversion specifier. -Either one indicates the integer range to be stored is limited to the range -determined by the value of the \fBwordSize\fR element of the \fBtcl_platform\fR -array). The \fBL\fR, \fBq\fR or \fBj\fR size modifiers are equivalent to the -\fBl\fR size modifier. Either of them indicates the integer range to be stored is -limited to the same range produced by the \fBwide()\fR function of -the \fBexpr\fR command. The \fBll\fR size modifier indicates that -the integer range to be stored is unlimited. +The syntactically valid values for the size modifier are \fBh\fR, +\fBl\fR, \fBz\fR, \fBt\fR, \fBq\fR, \fBj\fR, \fBll\fR, and \fBL\fR. +The \fBh\fR size modifier value is equivalent to the absence of a size +modifier in the the conversion specifier. Either one indicates the +integer range to be stored is limited to the 32-bit range. The \fBL\fR +size modifier is equivalent to the \fBll\fR size modifier. Either one +indicates the integer range to be stored is unlimited. The \fBl\fR (or +\fBq\fR or \fBj\fR) size modifier indicates that the integer range to be +stored is limited to the same range produced by the \fBwide()\fR function +of the \fBexpr\fR command. The \fBz\fR and \fBt\fR modifiers indicate the +integer range to be the same as for either \fBh\fR or \fBl\fR, depending +on the value of the \fBpointerSize\fR element of the \fBtcl_platform\fR array. .SS "MANDATORY CONVERSION CHARACTER" .PP The following conversion characters are supported: @@ -248,8 +249,6 @@ An interactive session demonstrating the truncation of integer values determined by size modifiers: .PP .CS -\fI%\fR set tcl_platform(wordSize) -4 \fI%\fR scan 20000000000000000000 %d 2147483647 \fI%\fR scan 20000000000000000000 %ld @@ -12,7 +12,7 @@ .SH NAME seek \- Change the access position for an open channel .SH SYNOPSIS -\fBseek \fIchannelId offset \fR?\fIorigin\fR? +\fBseek \fIchannel offset \fR?\fIorigin\fR? .BE .SH DESCRIPTION .PP @@ -12,7 +12,7 @@ .SH NAME tell \- Return current access position for an open channel .SH SYNOPSIS -\fBtell \fIchannelId\fR +\fBtell \fIchannel\fR .BE .SH DESCRIPTION .PP diff --git a/doc/transchan.n b/doc/transchan.n index abae7b9..d174d23 100644 --- a/doc/transchan.n +++ b/doc/transchan.n @@ -12,7 +12,7 @@ transchan \- command handler API of channel transforms .SH SYNOPSIS .nf -\fBchan push \fIchannelId cmdPrefix\fR +\fBchan push \fIchannel cmdPrefix\fR \fIcmdPrefix \fBclear \fIhandle\fR \fIcmdPrefix \fBdrain \fIhandle\fR diff --git a/generic/tcl.h b/generic/tcl.h index b5630cc..c3f3516 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -515,6 +515,8 @@ typedef struct stat *Tcl_OldStat_; * exited; the interpreter's result is meaningless. * TCL_CONTINUE Go on to the next iteration of the current loop; the * interpreter's result is meaningless. + * Integer return codes in the range TCL_CODE_USER_MIN to TCL_CODE_USER_MAX are + * reserved for the use of packages. */ #define TCL_OK 0 @@ -522,6 +524,8 @@ typedef struct stat *Tcl_OldStat_; #define TCL_RETURN 2 #define TCL_BREAK 3 #define TCL_CONTINUE 4 +#define TCL_CODE_USER_MIN 5 +#define TCL_CODE_USER_MAX 0x3fffffff /* 1073741823 */ /* *---------------------------------------------------------------------------- diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 7618415..7fe0f3a 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -512,7 +512,7 @@ assignNumber( void *clientData; int tcl_number_type; - if (Tcl_GetNumberFromObj(interp, numberObj, &clientData, + if (Tcl_GetNumberFromObj(interp, numberObj, &clientData, &tcl_number_type) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7944e24..16cc531 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -237,7 +237,6 @@ static Tcl_NRPostProc TEOV_RunLeaveTraces; static Tcl_NRPostProc EvalObjvCore; static Tcl_NRPostProc Dispatch; -static Tcl_ObjCmdProc NRInjectObjCmd; static Tcl_NRPostProc NRPostInvoke; static Tcl_ObjCmdProc CoroTypeObjCmd; static Tcl_ObjCmdProc TclNRCoroInjectObjCmd; @@ -1196,8 +1195,6 @@ Tcl_CreateInterp(void) cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ - Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, - NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", CoroTypeObjCmd, NULL, NULL); @@ -9310,35 +9307,6 @@ TclNRCoroutineActivateCallback( /* *---------------------------------------------------------------------- * - * TclNREvalList -- - * - * Callback to invoke command as list, used in order to delayed - * processing of canonical list command in sane environment. - * - *---------------------------------------------------------------------- - */ - -static int -TclNREvalList( - void *data[], - Tcl_Interp *interp, - TCL_UNUSED(int) /*result*/) -{ - Tcl_Size objc; - Tcl_Obj **objv; - Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; - - Tcl_IncrRefCount(listPtr); - - TclMarkTailcall(interp); - TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); - TclListObjGetElements(NULL, listPtr, &objc, &objv); - return TclNREvalObjv(interp, objc, objv, 0, NULL); -} - -/* - *---------------------------------------------------------------------- - * * CoroTypeObjCmd -- * * Implementation of [::tcl::unsupported::corotype] command. @@ -9662,61 +9630,6 @@ InjectHandlerPostCall( return result; } -/* - *---------------------------------------------------------------------- - * - * NRInjectObjCmd -- - * - * Implementation of [::tcl::unsupported::inject] command. - * - *---------------------------------------------------------------------- - */ - -static int -NRInjectObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - CoroutineData *corPtr; - ExecEnv *savedEEPtr = iPtr->execEnvPtr; - - /* - * Usage more or less like tailcall: - * inject coroName cmd ?arg1 arg2 ...? - */ - - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?"); - return TCL_ERROR; - } - - corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); - if (!corPtr) { - return TCL_ERROR; - } - if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; - } - - /* - * Add the callback to the coro's execEnv, so that it is the first thing - * to happen when the coro is resumed. - */ - - iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), - NULL, NULL, NULL); - iPtr->execEnvPtr = savedEEPtr; - - return TCL_OK; -} - int TclNRInterpCoroutine( void *clientData, diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index a9bcf0c..915a916 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -277,7 +277,7 @@ TclNamespaceEnsembleCmd( * * Note: * Can't use SetEnsembleConfigOptions() here. Different (but overlapping) - * options are supported. + * options are supported. * *---------------------------------------------------------------------- */ @@ -886,7 +886,7 @@ Tcl_CreateEnsemble( */ static inline EnsembleConfig * GetEnsembleFromCommand( - Tcl_Interp *interp, /* Where to report an error. May be NULL. */ + Tcl_Interp *interp, /* Where to report an error. May be NULL. */ Tcl_Command token) /* What to check for ensemble-ness. */ { Command *cmdPtr = (Command *) token; @@ -1704,6 +1704,8 @@ TclMakeEnsemble( TCL_AUTO_LENGTH))) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); } + /* don't compile unsafe subcommands in safe interp */ + cmdPtr->compileProc = NULL; } else { /* * Not hidden, so just create it. Yay! @@ -1713,8 +1715,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); @@ -3222,7 +3224,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) { @@ -3230,7 +3232,6 @@ TclCompileEnsemble( * Maps to an undefined command or a command without a compiler. * Cannot compile. */ - goto cleanup; } cmdPtr = newCmdPtr; diff --git a/generic/tclIO.c b/generic/tclIO.c index 4859bc1..4018e1a 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9195,7 +9195,7 @@ Tcl_FileEventObjCmd( static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE}; if ((objc != 3) && (objc != 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel event ?script?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0, diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index c7ecb76..0357471 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -138,7 +138,7 @@ Tcl_PutsObjCmd( /* Fall through */ default: /* [puts] or * [puts some bad number of arguments...] */ - Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string"); + Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channel? string"); return TCL_ERROR; } @@ -222,7 +222,7 @@ Tcl_FlushObjCmd( int mode; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } chanObjPtr = objv[1]; @@ -288,7 +288,7 @@ Tcl_GetsObjCmd( int code = TCL_OK; if ((objc != 2) && (objc != 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel ?varName?"); return TCL_ERROR; } chanObjPtr = objv[1]; @@ -379,7 +379,7 @@ Tcl_ReadObjCmd( argerror: iPtr = (Interp *) interp; - Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel ?numChars?"); /* * Do not append directly; that makes ensembles using this command as @@ -387,7 +387,7 @@ Tcl_ReadObjCmd( */ iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS; - Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channel"); return TCL_ERROR; } @@ -515,7 +515,7 @@ Tcl_SeekObjCmd( static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END}; if ((objc != 3) && (objc != 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel offset ?origin?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { @@ -584,7 +584,7 @@ Tcl_TellObjCmd( int code; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -647,7 +647,7 @@ Tcl_CloseObjCmd( static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE}; if ((objc != 2) && (objc != 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel ?direction?"); return TCL_ERROR; } @@ -753,7 +753,7 @@ Tcl_FconfigureObjCmd( int i; /* Iterate over arg-value pairs. */ if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel ?-option value ...?"); return TCL_ERROR; } @@ -826,7 +826,7 @@ Tcl_EofObjCmd( Tcl_Channel chan; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -1038,7 +1038,7 @@ Tcl_FblockedObjCmd( int mode; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -1808,7 +1808,7 @@ ChanPendingObjCmd( int mode; if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "mode channelId"); + Tcl_WrongNumArgs(interp, 1, objv, "mode channel"); return TCL_ERROR; } @@ -1868,7 +1868,7 @@ ChanTruncateObjCmd( Tcl_WideInt length; if ((objc < 2) || (objc > 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?"); + Tcl_WrongNumArgs(interp, 1, objv, "channel ?length?"); return TCL_ERROR; } if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 70e1246..985190f 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1064,7 +1064,7 @@ NRInterpCmd( Tcl_Channel chan; if (objc != 5) { - Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath"); + Tcl_WrongNumArgs(interp, 2, objv, "srcPath channel destPath"); return TCL_ERROR; } parentInterp = GetInterp(interp, objv[2]); diff --git a/generic/tclScan.c b/generic/tclScan.c index c143efa..48d2bcc 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -385,6 +385,10 @@ ValidateFormat( } format += TclUtfToUniChar(format, &ch); break; + case 'L': + flags |= SCAN_BIG; + format += TclUtfToUniChar(format, &ch); + break; case 'l': if (*format == 'l') { flags |= SCAN_BIG; @@ -393,7 +397,6 @@ ValidateFormat( break; } /* FALLTHRU */ - case 'L': case 'j': case 'q': flags |= SCAN_LONGER; @@ -601,7 +604,7 @@ Tcl_ScanObjCmd( const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; - long value; + int value; const char *string, *end, *baseString; char op = 0; int underflow = 0; @@ -994,11 +997,11 @@ Tcl_ScanObjCmd( } } } else { - if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { + if (TclGetIntFromObj(NULL, objPtr, &value) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { - value = LONG_MIN; + value = INT_MIN; } else { - value = LONG_MAX; + value = INT_MAX; } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 8b6b719..75b4fdd 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1875,9 +1875,7 @@ Tcl_AppendFormatToObj( int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int gotPrecision, sawFlag, useShort = 0, useBig = 0; Tcl_WideInt width, precision; -#ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; -#endif int newXpg, allocSegment = 0; Tcl_Size numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; @@ -2082,18 +2080,14 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG } else { useWide = 1; -#endif } } else if (ch == 'I') { if ((format[1] == '6') && (format[2] == '4')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG useWide = 1; -#endif } else if ((format[1] == '3') && (format[2] == '2')) { format += (step + 2); step = TclUtfToUniChar(format, &ch); @@ -2104,17 +2098,13 @@ Tcl_AppendFormatToObj( } else if ((ch == 'q') || (ch == 'j')) { format += step; step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG useWide = 1; -#endif } else if ((ch == 't') || (ch == 'z')) { format += step; step = TclUtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG if (sizeof(void *) > sizeof(int)) { useWide = 1; } -#endif } else if (ch == 'L') { format += step; step = TclUtfToUniChar(format, &ch); @@ -2180,17 +2170,15 @@ Tcl_AppendFormatToObj( case 'b': { short s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ - long l; + int l; Tcl_WideInt w; mp_int big; int isNegative = 0; Tcl_Size toAppend; -#ifndef TCL_WIDE_INT_IS_LONG if ((ch == 'p') && (sizeof(void *) > sizeof(int))) { useWide = 1; } -#endif if (useBig) { int cmpResult; if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { @@ -2211,7 +2199,6 @@ Tcl_AppendFormatToObj( ch = 'd'; } } -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; @@ -2220,12 +2207,11 @@ Tcl_AppendFormatToObj( if (w == (Tcl_WideInt) 0) { gotHash = 0; } -#endif - } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { + } else if (TclGetIntFromObj(NULL, segment, &l) != TCL_OK) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { goto error; } else { - l = (long) w; + l = (int) w; } if (useShort) { s = (short) l; @@ -2234,8 +2220,8 @@ Tcl_AppendFormatToObj( gotHash = 0; } } else { - isNegative = (l < (long) 0); - if (l == (long) 0) { + isNegative = (l < (int) 0); + if (l == (int) 0) { gotHash = 0; } } @@ -2246,8 +2232,8 @@ Tcl_AppendFormatToObj( gotHash = 0; } } else { - isNegative = (l < (long) 0); - if (l == (long) 0) { + isNegative = (l < (int) 0); + if (l == (int) 0) { gotHash = 0; } } @@ -2294,10 +2280,8 @@ Tcl_AppendFormatToObj( if (useShort) { TclNewIntObj(pure, s); -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { TclNewIntObj(pure, w); -#endif } else if (useBig) { pure = Tcl_NewBignumObj(&big); } else { @@ -2382,7 +2366,6 @@ Tcl_AppendFormatToObj( numDigits++; us /= base; } -#ifndef TCL_WIDE_INT_IS_LONG } else if (useWide) { Tcl_WideUInt uw = (Tcl_WideUInt) w; @@ -2391,7 +2374,6 @@ Tcl_AppendFormatToObj( numDigits++; uw /= base; } -#endif } else if (useBig && !mp_iszero(&big)) { int leftover = (big.used * MP_DIGIT_BIT) % numBits; mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover); @@ -2408,7 +2390,7 @@ Tcl_AppendFormatToObj( goto errorMsg; } } else if (!useBig) { - unsigned long ul = (unsigned long) l; + unsigned ul = (unsigned) l; bits = (Tcl_WideUInt) ul; while (ul) { diff --git a/generic/tclTest.c b/generic/tclTest.c index 0bb09f6..3b08cd6 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6444,7 +6444,7 @@ TestChannelCmd( if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " transform channelId -command cmd\"", (char *)NULL); + " transform channel -command cmd\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3], "-command") != 0) { diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 79492f6..25304404 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1639,7 +1639,7 @@ proc tcltest::Replace::puts {args} { # return [Puts [lindex $args 0]] } 2 { - # Either -nonewline or channelId has been specified + # Either -nonewline or channel has been specified if {[lindex $args 0] eq "-nonewline"} { append outData [lindex $args end] return @@ -1651,7 +1651,7 @@ proc tcltest::Replace::puts {args} { } 3 { if {[lindex $args 0] eq "-nonewline"} { - # Both -nonewline and channelId are specified, unless + # Both -nonewline and channel are specified, unless # it's an error. -nonewline is supposed to be argv[0]. set channel [lindex $args 1] set newline "" diff --git a/tests/chan.test b/tests/chan.test index 87d642c..04fd17e 100644 --- a/tests/chan.test +++ b/tests/chan.test @@ -29,10 +29,10 @@ test chan-1.2 {chan command general syntax} -body { test chan-2.1 {chan command: blocked subcommand} -body { chan blocked foo bar -} -returnCodes error -result "wrong # args: should be \"chan blocked channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan blocked channel\"" test chan-3.1 {chan command: close subcommand} -body { chan close foo bar zet -} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\"" +} -returnCodes error -result "wrong # args: should be \"chan close channel ?direction?\"" test chan-3.2 {chan command: close subcommand} -setup { set chan [open [info script] r] } -body { @@ -49,7 +49,7 @@ test chan-3.3 {chan command: close subcommand} -setup { } -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test chan-4.1 {chan command: configure subcommand} -body { chan configure -} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\"" +} -returnCodes error -result "wrong # args: should be \"chan configure channel ?-option value ...?\"" test chan-4.2 {chan command: [Bug 800753]} -body { chan configure stdout -eofchar Ā } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character} @@ -72,19 +72,19 @@ test chan-5.1 {chan command: copy subcommand} -body { test chan-6.1 {chan command: eof subcommand} -body { chan eof foo bar -} -returnCodes error -result "wrong # args: should be \"chan eof channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan eof channel\"" test chan-7.1 {chan command: event subcommand} -body { chan event foo -} -returnCodes error -result "wrong # args: should be \"chan event channelId event ?script?\"" +} -returnCodes error -result "wrong # args: should be \"chan event channel event ?script?\"" test chan-8.1 {chan command: flush subcommand} -body { chan flush foo bar -} -returnCodes error -result "wrong # args: should be \"chan flush channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan flush channel\"" test chan-9.1 {chan command: gets subcommand} -body { chan gets -} -returnCodes error -result "wrong # args: should be \"chan gets channelId ?varName?\"" +} -returnCodes error -result "wrong # args: should be \"chan gets channel ?varName?\"" test chan-10.1 {chan command: names subcommand} -body { chan names foo bar @@ -92,23 +92,23 @@ test chan-10.1 {chan command: names subcommand} -body { test chan-11.1 {chan command: puts subcommand} -body { chan puts foo bar foo bar -} -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channelId? string\"" +} -returnCodes error -result "wrong # args: should be \"chan puts ?-nonewline? ?channel? string\"" test chan-12.1 {chan command: read subcommand} -body { chan read -} -returnCodes error -result "wrong # args: should be \"chan read channelId ?numChars?\" or \"chan read ?-nonewline? channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan read channel ?numChars?\" or \"chan read ?-nonewline? channel\"" test chan-13.1 {chan command: seek subcommand} -body { chan seek foo bar foo bar -} -returnCodes error -result "wrong # args: should be \"chan seek channelId offset ?origin?\"" +} -returnCodes error -result "wrong # args: should be \"chan seek channel offset ?origin?\"" test chan-14.1 {chan command: tell subcommand} -body { chan tell foo bar -} -returnCodes error -result "wrong # args: should be \"chan tell channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan tell channel\"" test chan-15.1 {chan command: truncate subcommand} -body { chan truncate foo bar foo bar -} -returnCodes error -result "wrong \# args: should be \"chan truncate channelId ?length?\"" +} -returnCodes error -result "wrong \# args: should be \"chan truncate channel ?length?\"" test chan-15.2 {chan command: truncate subcommand} -setup { set file [makeFile {} testTruncate] set f [open $file w+] @@ -127,13 +127,13 @@ test chan-15.2 {chan command: truncate subcommand} -setup { # TIP 287: chan pending test chan-16.1 {chan command: pending subcommand} -body { chan pending -} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan pending mode channel\"" test chan-16.2 {chan command: pending subcommand} -body { chan pending stdin -} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan pending mode channel\"" test chan-16.3 {chan command: pending subcommand} -body { chan pending stdin stdout stderr -} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\"" +} -returnCodes error -result "wrong # args: should be \"chan pending mode channel\"" test chan-16.4 {chan command: pending subcommand} -body { chan pending {input output} stdout } -returnCodes error -result "bad mode \"input output\": must be input or output" diff --git a/tests/chanio.test b/tests/chanio.test index 6173d0d..e95a0ca 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -5505,10 +5505,10 @@ test chan-io-40.16 {verify no tilde substitution in open} -setup { test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo -} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"} +} -returnCodes error -result {wrong # args: should be "chan event channel event ?script?"} test chan-io-41.2 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event foo bar baz q -} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"} +} -returnCodes error -result {wrong # args: should be "chan event channel event ?script?"} test chan-io-41.3 {Tcl_FileeventCmd: errors} -constraints fileevent -body { chan event gorp readable } -returnCodes error -result {can not find channel named "gorp"} diff --git a/tests/coroutine.test b/tests/coroutine.test index c3023f7..845a4df 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -825,28 +825,12 @@ test coroutine-7.14 { return [list $done0 $done1] } -result {failure failure} - -test coroutine-8.0.0 {coro inject executed} -body { - coroutine demo apply {{} { foreach i {1 2} yield }} - demo - set ::result none - tcl::unsupported::inject demo set ::result inject-executed - demo - set ::result -} -result {inject-executed} -test coroutine-8.0.1 {coro inject after error} -body { - coroutine demo apply {{} { foreach i {1 2} yield; error test }} - demo - set ::result none - tcl::unsupported::inject demo set ::result inject-executed - lappend ::result [catch {demo} err] $err -} -result {inject-executed 1 test} test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body { interp create child child eval { coroutine demo apply {{} { while {1} yield }} demo - tcl::unsupported::inject demo set ::result inject-executed + coroinject demo set ::result inject-executed } interp delete child } -result {} @@ -855,14 +839,15 @@ test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body { child eval { coroutine demo apply {{} { while {1} yield }} demo - tcl::unsupported::inject demo set ::result inject-executed + coroinject demo lappend ::result inject-executed } child eval demo set result [child eval {set ::result}] interp delete child set result -} -result {inject-executed} +} -result {inject-executed yield {}} + test coroutine-9.1 {coroprobe with yield} -body { coroutine demo apply {{} { foreach i {1 2} yield }} @@ -1037,7 +1022,7 @@ test coroutine-12.1 {coroutine general introspection} -setup { $i eval { # Make the introspection code namespace path tcl::unsupported - proc probe {type var} { + proc probe {var type args} { upvar 1 $var v set f [info frame] incr f -1 @@ -1049,7 +1034,7 @@ test coroutine-12.1 {coroutine general introspection} -setup { } } proc pokecoro {c var} { - inject $c probe [corotype $c] $var + coroinject $c probe $var $c } diff --git a/tests/expr.test b/tests/expr.test index f2c7ae6..bfefde3 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -5842,7 +5842,7 @@ test expr-33.1 {parse largest long value} { [expr {int(2147483647 + 1) > 0}] \ } {2147483647 2147483647 2147483647 2147483647 1 1} -test expr-33.2 {parse smallest long value} longIs32bit { +test expr-33.2 {parse smallest long value} { set min_long_str -2147483648 set min_long_hex "-0x80000000 " diff --git a/tests/format.test b/tests/format.test index 5af6c19..39de907 100644 --- a/tests/format.test +++ b/tests/format.test @@ -15,10 +15,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -# %u output depends on word length, so this test is not portable. -testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] -testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] -testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] +# %z/%t/%p output depends on pointerSize, so some tests are not portable. testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain # particularly in Continuous Integration, and there isn't anything much we can @@ -31,12 +28,9 @@ test format-1.1 {integer formatting} { test format-1.2 {integer formatting} { format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12 } { 6 34 16923 -12 -1 0xe 0xC} -test format-1.3 {integer formatting} longIs32bit { +test format-1.3 {integer formatting} { format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 } { 6 34 16923 4294967284 -1 0} -test format-1.3.1 {integer formatting} longIs64bit { - format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0 -} { 6 34 16923 18446744073709551604 -1 0} test format-1.4 {integer formatting} { format "%-4d %-4i %-4d %-4ld" 6 34 16923 -12 -1 } {6 34 16923 -12 } @@ -48,36 +42,21 @@ test format-1.6 {integer formatting} { } {000034} # Printing negative numbers in hex or octal format depends on word # length, so these tests are not portable. -test format-1.7 {integer formatting} longIs32bit { +test format-1.7 {integer formatting} { format "%4x %4x %4x %4x" 6 34 16923 -12 -1 } { 6 22 421b fffffff4} -test format-1.7.1 {integer formatting} longIs64bit { - format "%4x %4x %4x %4x" 6 34 16923 -12 -1 -} { 6 22 421b fffffffffffffff4} -test format-1.8 {integer formatting} longIs32bit { +test format-1.8 {integer formatting} { format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421B 0xfffffff4} -test format-1.8.1 {integer formatting} longIs64bit { - format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1 -} {0 0x6 0x22 0x421B 0xfffffffffffffff4} -test format-1.9 {integer formatting} longIs32bit { +test format-1.9 {integer formatting} { format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 } { 0 0x6 0x22 0x421b 0xfffffff4} -test format-1.9.1 {integer formatting} longIs64bit { - format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1 -} { 0 0x6 0x22 0x421b 0xfffffffffffffff4} -test format-1.10 {integer formatting} longIs32bit { +test format-1.10 {integer formatting} { format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 } {0 0x6 0x22 0x421b 0xfffffff4 } -test format-1.10.1 {integer formatting} longIs64bit { - format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1 -} {0 0x6 0x22 0x421b 0xfffffffffffffff4 } -test format-1.11 {integer formatting} longIs32bit { +test format-1.11 {integer formatting} { format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 } {0 0o6 0o42 0o41033 0o37777777764 } -test format-1.11.1 {integer formatting} longIs64bit { - format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1 -} {0 0o6 0o42 0o41033 0o1777777777777777777764} test format-1.12 {integer formatting} { format "%b %#b %#b %llb" 5 0 5 [expr {2**100}] } {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} @@ -556,13 +535,13 @@ for {set i 290} {$i < 400} {incr i} { append b "x" } -test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} { +test format-17.1 {testing %d with wide} { format %d 7810179016327718216 } 1819043144 -test format-17.2 {testing %ld with wide} {wideIs64bit} { +test format-17.2 {testing %ld with wide} { format %ld 7810179016327718216 } 7810179016327718216 -test format-17.3 {testing %ld with non-wide} {wideIs64bit} { +test format-17.3 {testing %ld with non-wide} { format %ld 42 } 42 test format-17.4 {testing %l with non-integer} { @@ -589,7 +568,7 @@ test format-18.1 {do not demote existing numeric values} { format %08x $b lappend result [expr {$a == $b}] } {1 1 1 1} -test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} { +test format-18.2 {do not demote existing numeric values} { set a [expr {0xaaaaaaaaaa + 1}] set b 0xaaaaaaaaab list [format %08x $a] [expr {$a == $b}] @@ -606,8 +585,7 @@ test format-19.3 {Bug 2830354} { string length [format %340f 0] } 340 -test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \ --constraints {longIs32bit} -body { +test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} -body { # in case of overflow into negative, it produces width -2 (and limit exceeded), # in case of width will be unsigned, it will be outside limit (2GB for 32bit)... # and it don't throw an error in case the bug is not fixed (and probably no segfault). diff --git a/tests/io.test b/tests/io.test index ad8d6b7..d550352 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6074,10 +6074,10 @@ test io-40.17 {tilde substitution in open} { test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo} msg] $msg -} {1 {wrong # args: should be "fileevent channelId event ?script?"}} +} {1 {wrong # args: should be "fileevent channel event ?script?"}} test io-41.2 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent foo bar baz q} msg] $msg -} {1 {wrong # args: should be "fileevent channelId event ?script?"}} +} {1 {wrong # args: should be "fileevent channel event ?script?"}} test io-41.3 {Tcl_FileeventCmd: errors} {fileevent} { list [catch {fileevent gorp readable} msg] $msg } {1 {can not find channel named "gorp"}} diff --git a/tests/ioCmd.test b/tests/ioCmd.test index e8a9c57..07cf3cd 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -30,13 +30,13 @@ testConstraint testchannel [llength [info commands testchannel]] test iocmd-1.1 {puts command} { list [catch {puts} msg] $msg -} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} +} {1 {wrong # args: should be "puts ?-nonewline? ?channel? string"}} test iocmd-1.2 {puts command} { list [catch {puts a b c d e f g} msg] $msg -} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} +} {1 {wrong # args: should be "puts ?-nonewline? ?channel? string"}} test iocmd-1.3 {puts command} { list [catch {puts froboz -nonewline kablooie} msg] $msg -} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}} +} {1 {wrong # args: should be "puts ?-nonewline? ?channel? string"}} test iocmd-1.4 {puts command} { list [catch {puts froboz hello} msg] $msg } {1 {can not find channel named "froboz"}} @@ -70,10 +70,10 @@ test iocmd-1.8 {puts command} { test iocmd-2.1 {flush command} { list [catch {flush} msg] $msg -} {1 {wrong # args: should be "flush channelId"}} +} {1 {wrong # args: should be "flush channel"}} test iocmd-2.2 {flush command} { list [catch {flush a b c d e} msg] $msg -} {1 {wrong # args: should be "flush channelId"}} +} {1 {wrong # args: should be "flush channel"}} test iocmd-2.3 {flush command} { list [catch {flush foo} msg] $msg } {1 {can not find channel named "foo"}} @@ -83,10 +83,10 @@ test iocmd-2.4 {flush command} { test iocmd-3.1 {gets command} { list [catch {gets} msg] $msg -} {1 {wrong # args: should be "gets channelId ?varName?"}} +} {1 {wrong # args: should be "gets channel ?varName?"}} test iocmd-3.2 {gets command} { list [catch {gets a b c d e f g} msg] $msg -} {1 {wrong # args: should be "gets channelId ?varName?"}} +} {1 {wrong # args: should be "gets channel ?varName?"}} test iocmd-3.3 {gets command} { list [catch {gets aaa} msg] $msg } {1 {can not find channel named "aaa"}} @@ -107,16 +107,16 @@ test iocmd-3.5 {gets command} { test iocmd-4.1 {read command} { list [catch {read} msg] $msg -} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} +} {1 {wrong # args: should be "read channel ?numChars?" or "read ?-nonewline? channel"}} test iocmd-4.2 {read command} { list [catch {read a b c d e f g h} msg] $msg -} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} +} {1 {wrong # args: should be "read channel ?numChars?" or "read ?-nonewline? channel"}} test iocmd-4.3 {read command} { list [catch {read aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-4.4 {read command} { list [catch {read -nonewline} msg] $msg -} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}} +} {1 {wrong # args: should be "read channel ?numChars?" or "read ?-nonewline? channel"}} test iocmd-4.5 {read command} { list [catch {read -nonew file4} msg] $msg $::errorCode } {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}} @@ -136,7 +136,7 @@ test iocmd-4.8 {read command with incorrect combination of arguments} { set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode] close $f set x -} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "read channel ?numChars?" or "read ?-nonewline? channel"} {TCL WRONGARGS}} test iocmd-4.9 {read command} { list [catch {read stdin foo} msg] $msg $::errorCode } {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}} @@ -161,10 +161,10 @@ test iocmd-4.12 {read command} -setup { test iocmd-5.1 {seek command} -returnCodes error -body { seek -} -result {wrong # args: should be "seek channelId offset ?origin?"} +} -result {wrong # args: should be "seek channel offset ?origin?"} test iocmd-5.2 {seek command} -returnCodes error -body { seek a b c d e f g -} -result {wrong # args: should be "seek channelId offset ?origin?"} +} -result {wrong # args: should be "seek channel offset ?origin?"} test iocmd-5.3 {seek command} -returnCodes error -body { seek stdin gugu } -result {expected integer but got "gugu"} @@ -174,20 +174,20 @@ test iocmd-5.4 {seek command} -returnCodes error -body { test iocmd-6.1 {tell command} { list [catch {tell} msg] $msg -} {1 {wrong # args: should be "tell channelId"}} +} {1 {wrong # args: should be "tell channel"}} test iocmd-6.2 {tell command} { list [catch {tell a b c d e} msg] $msg -} {1 {wrong # args: should be "tell channelId"}} +} {1 {wrong # args: should be "tell channel"}} test iocmd-6.3 {tell command} { list [catch {tell aaa} msg] $msg } {1 {can not find channel named "aaa"}} test iocmd-7.1 {close command} { list [catch {close} msg] $msg -} {1 {wrong # args: should be "close channelId ?direction?"}} +} {1 {wrong # args: should be "close channel ?direction?"}} test iocmd-7.2 {close command} { list [catch {close a b c d e} msg] $msg -} {1 {wrong # args: should be "close channelId ?direction?"}} +} {1 {wrong # args: should be "close channel ?direction?"}} test iocmd-7.3 {close command} { list [catch {close aaa} msg] $msg } {1 {can not find channel named "aaa"}} @@ -216,10 +216,10 @@ proc expectedOpts {got extra} { } test iocmd-8.1 {fconfigure command} -returnCodes error -body { fconfigure -} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"} +} -result {wrong # args: should be "fconfigure channel ?-option value ...?"} test iocmd-8.2 {fconfigure command} -returnCodes error -body { fconfigure a b c d e f -} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"} +} -result {wrong # args: should be "fconfigure channel ?-option value ...?"} test iocmd-8.3 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -376,10 +376,10 @@ test iocmd-8.23 {fconfigure -profile badprofile} -body { test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "eof channel"} {TCL WRONGARGS}} test iocmd-9.2 {eof command} { list [catch {eof a b} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "eof channel"} {TCL WRONGARGS}} test iocmd-9.3 {eof command} { catch {close file100} list [catch {eof file100} msg] $msg $::errorCode @@ -389,10 +389,10 @@ test iocmd-9.3 {eof command} { test iocmd-10.1 {fblocked command} { list [catch {fblocked} msg] $msg -} {1 {wrong # args: should be "fblocked channelId"}} +} {1 {wrong # args: should be "fblocked channel"}} test iocmd-10.2 {fblocked command} { list [catch {fblocked a b c d e f g} msg] $msg -} {1 {wrong # args: should be "fblocked channelId"}} +} {1 {wrong # args: should be "fblocked channel"}} test iocmd-10.3 {fblocked command} { list [catch {fblocked file1000} msg] $msg } {1 {can not find channel named "file1000"}} diff --git a/tests/namespace.test b/tests/namespace.test index ae233cb..3af5030 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3371,6 +3371,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/obj.test b/tests/obj.test index eb85c84..fcd8d89 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -20,7 +20,6 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] -testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj { @@ -547,11 +546,11 @@ test obj-32.1 {freeing very large object trees} { unset x } {} -test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.1 {integer overflow on input} {wideIs64bit} { set x 0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 2147483648} -test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.2 {integer overflow on input} {wideIs64bit} { set x 0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 4294967295} @@ -559,15 +558,15 @@ test obj-33.3 {integer overflow on input} { set x 0x10000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 4294967296} -test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.4 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0000 list [string is integer $x] [expr { wide($x) }] } {1 -2147483648} -test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.5 {integer overflow on input} {wideIs64bit} { set x -0x8000; append x 0001 list [string is integer $x] [expr { wide($x) }] } {1 -2147483649} -test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} { +test obj-33.6 {integer overflow on input} {wideIs64bit} { set x -0xffff; append x ffff list [string is integer $x] [expr { wide($x) }] } {1 -4294967295} diff --git a/tests/pid.test b/tests/pid.test index 3f62457..5abbe1f 100644 --- a/tests/pid.test +++ b/tests/pid.test @@ -47,7 +47,7 @@ test pid-1.3 {pid command} -constraints pidDefined -setup { } -result {} test pid-1.4 {pid command} pidDefined { list [catch {pid a b} msg] $msg -} {1 {wrong # args: should be "pid ?channelId?"}} +} {1 {wrong # args: should be "pid ?channel?"}} test pid-1.5 {pid command} pidDefined { list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} diff --git a/tests/scan.test b/tests/scan.test index 6d7a9fb..6d91c8d 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -82,7 +82,6 @@ proc testIEEE {} { } testConstraint ieeeFloatingPoint [testIEEE] -testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}] test scan-1.1 {BuildCharSet, CharInSet} { list [scan foo {%[^o]} x] $x @@ -517,7 +516,7 @@ test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { list [scan "4294967280 4294967280" "%u %d" a b] $a \ [expr {$b == -16 || $b == 0x7fffffff}] } -result {2 4294967280 1} -test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup { +test scan-5.12 {integer scanning} -setup { set a {}; set b {}; set c {} } -body { list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \ diff --git a/tests/trace.test b/tests/trace.test index 64c9111..16c858c 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -1695,7 +1695,7 @@ test trace-21.12 {bug 2438181} -setup { trace add execution set2 leave {puts one two three #;} } -body { set2 a hello -} -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channelId? string"} +} -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channel? string"} proc factorial {n} { if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] } diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index a61c083..046ec90 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -1380,7 +1380,7 @@ Tcl_PidObjCmd( Tcl_Obj *resultPtr; if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); + Tcl_WrongNumArgs(interp, 1, objv, "?channel?"); return TCL_ERROR; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index f36407d..12a10e6 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1324,7 +1324,7 @@ DdeObjCmd( "-async", "-binary", NULL }; enum DdeExecOptions { - DDE_EXEC_ASYNC, DDE_EXEC_BINARY + DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; static const char *const ddeEvalOptions[] = { "-async", NULL diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 5a83425..b878cd4 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1711,8 +1711,8 @@ ConvertFileNameFormat( Tcl_WCharToUtfDString(nativeName, TCL_INDEX_NONE, &dsTemp); Tcl_DStringFree(&ds); - tempPath = Tcl_DStringToObj(&dsTemp); - Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); + tempPath = Tcl_DStringToObj(&dsTemp); + Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); } } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 17f4898..1eb8b22 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1438,23 +1438,23 @@ TclpGetUserHome( if (domain == NULL) { const char *ptr; - /* - * Treat the current user as a special case because the general case - * below does not properly retrieve the path. The NetUserGetInfo - * call returns an empty path and the code defaults to the user's - * name in the profiles directory. On modern Windows systems, this - * is generally wrong as when the account is a Microsoft account, - * for example abcdefghi@outlook.com, the directory name is - * abcde and not abcdefghi. - * - * Note we could have just used env(USERPROFILE) here but - * the intent is to retrieve (as on Unix) the system's view - * of the home irrespective of environment settings of HOME - * and USERPROFILE. - * - * Fixing this for the general user needs more investigating but - * at least for the current user we can use a direct call. - */ + /* + * Treat the current user as a special case because the general case + * below does not properly retrieve the path. The NetUserGetInfo + * call returns an empty path and the code defaults to the user's + * name in the profiles directory. On modern Windows systems, this + * is generally wrong as when the account is a Microsoft account, + * for example abcdefghi@outlook.com, the directory name is + * abcde and not abcdefghi. + * + * Note we could have just used env(USERPROFILE) here but + * the intent is to retrieve (as on Unix) the system's view + * of the home irrespective of environment settings of HOME + * and USERPROFILE. + * + * Fixing this for the general user needs more investigating but + * at least for the current user we can use a direct call. + */ ptr = TclpGetUserName(&ds); if (ptr != NULL && strcasecmp(name, ptr) == 0) { HANDLE hProcess; @@ -2054,27 +2054,27 @@ NativeStat( BY_HANDLE_FILE_INFORMATION data; if (GetFileInformationByHandle(fileHandle,&data) != TRUE) { - fileType = GetFileType(fileHandle); - CloseHandle(fileHandle); - if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { - Tcl_SetErrno(ENOENT); - return -1; - } - - /* + fileType = GetFileType(fileHandle); + CloseHandle(fileHandle); + if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) { + Tcl_SetErrno(ENOENT); + return -1; + } + + /* * Mock up the expected structure */ - memset(&data, 0, sizeof(data)); - statPtr->st_atime = 0; - statPtr->st_mtime = 0; - statPtr->st_ctime = 0; - } else { - CloseHandle(fileHandle); - statPtr->st_atime = ToCTime(data.ftLastAccessTime); - statPtr->st_mtime = ToCTime(data.ftLastWriteTime); - statPtr->st_ctime = ToCTime(data.ftCreationTime); - } + memset(&data, 0, sizeof(data)); + statPtr->st_atime = 0; + statPtr->st_mtime = 0; + statPtr->st_ctime = 0; + } else { + CloseHandle(fileHandle); + statPtr->st_atime = ToCTime(data.ftLastAccessTime); + statPtr->st_mtime = ToCTime(data.ftLastWriteTime); + statPtr->st_ctime = ToCTime(data.ftCreationTime); + } attr = data.dwFileAttributes; statPtr->st_size = ((long long) data.nFileSizeLow) | (((long long) data.nFileSizeHigh) << 32); @@ -2134,11 +2134,11 @@ NativeStat( dev = NativeDev(nativePath); mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath)); if (fileType == FILE_TYPE_CHAR) { - mode &= ~S_IFMT; - mode |= S_IFCHR; + mode &= ~S_IFMT; + mode |= S_IFCHR; } else if (fileType == FILE_TYPE_DISK) { - mode &= ~S_IFMT; - mode |= S_IFBLK; + mode &= ~S_IFMT; + mode |= S_IFBLK; } statPtr->st_dev = (dev_t) dev; @@ -3280,12 +3280,12 @@ TclWinFileOwned( if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT, OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL, &secd) != ERROR_SUCCESS) { - /* + /* * Either not a file, or we do not have access to it in which case we * are in all likelihood not the owner. */ - return 0; + return 0; } /* @@ -3296,19 +3296,19 @@ TclWinFileOwned( */ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) { - /* + /* * Find out how big the buffer needs to be. */ - bufsz = 0; - GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); - if (bufsz) { - buf = (LPBYTE)Tcl_Alloc(bufsz); - if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { - owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); - } - } - CloseHandle(token); + bufsz = 0; + GetTokenInformation(token, TokenUser, NULL, 0, &bufsz); + if (bufsz) { + buf = (LPBYTE)Tcl_Alloc(bufsz); + if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) { + owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid); + } + } + CloseHandle(token); } /* @@ -3316,10 +3316,10 @@ TclWinFileOwned( */ if (secd) { - LocalFree(secd); /* Also frees ownerSid */ + LocalFree(secd); /* Also frees ownerSid */ } if (buf) { - Tcl_Free(buf); + Tcl_Free(buf); } return (owned != 0); /* Convert non-0 to 1 */ diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 4234ceb..5c8ca91 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -516,14 +516,14 @@ TclpSetVariables( Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), TCL_GLOBAL_ONLY); } else { - /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ - ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); - if (ptr != NULL && ptr[0]) { - Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); - } else { - /* Last resort */ - Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); - } + /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */ + ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY); + if (ptr != NULL && ptr[0]) { + Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY); + } else { + /* Last resort */ + Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); + } } } diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 1cc7ae1..b0c4c3b 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -90,11 +90,11 @@ TclpDlopen( Tcl_DString ds; - /* - * Remember the first error on load attempt to be used if the - * second load attempt below also fails. - */ - firstError = (nativeName == NULL) ? + /* + * Remember the first error on load attempt to be used if the + * second load attempt below also fails. + */ + firstError = (nativeName == NULL) ? ERROR_MOD_NOT_FOUND : GetLastError(); Tcl_DStringInit(&ds); @@ -106,19 +106,19 @@ TclpDlopen( if (hInstance == NULL) { DWORD lastError; - Tcl_Obj *errMsg; - - /* - * We choose to only use the error from the second call if the first - * call failed due to the file not being found. Else stick to the - * first error for reporting purposes. - */ - if (firstError == ERROR_MOD_NOT_FOUND || + Tcl_Obj *errMsg; + + /* + * We choose to only use the error from the second call if the first + * call failed due to the file not being found. Else stick to the + * first error for reporting purposes. + */ + if (firstError == ERROR_MOD_NOT_FOUND || firstError == ERROR_DLL_NOT_FOUND) { - lastError = GetLastError(); - } else { - lastError = firstError; - } + lastError = GetLastError(); + } else { + lastError = firstError; + } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", TclGetString(pathPtr)); @@ -157,11 +157,11 @@ TclpDlopen( Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", TCL_INDEX_NONE); break; - case ERROR_BAD_EXE_FORMAT: + case ERROR_BAD_EXE_FORMAT: Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); - break; - default: + break; + default: Tcl_WinConvertError(lastError); Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), TCL_INDEX_NONE); } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index eeb06f8..7b083a5 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -2762,7 +2762,7 @@ Tcl_PidObjCmd( Tcl_Obj *resultPtr; if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?channelId?"); + Tcl_WrongNumArgs(interp, 1, objv, "?channel?"); return TCL_ERROR; } if (objc == 1) { |