Compare commits
142
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ea11870f5b | ||
|
|
27696b490b | ||
|
|
d0af5aa92c | ||
|
|
9faead9d18 | ||
|
|
404eadfdaf | ||
|
|
722ba1aa44 | ||
|
|
4cead413c9 | ||
|
|
2501dbb8d0 | ||
|
|
acb9c613f1 | ||
|
|
ad4538af95 | ||
|
|
c2e7b1ce36 | ||
|
|
f846b3f965 | ||
|
|
a22b8736ec | ||
|
|
f5bf1de995 | ||
|
|
6f9ac81ae9 | ||
|
|
c947326c4a | ||
|
|
9b1a5dc878 | ||
|
|
4bc50a0a12 | ||
|
|
26532df53f | ||
|
|
0b8d92332a | ||
|
|
67a6300cc4 | ||
|
|
fd72878261 | ||
|
|
2edc274601 | ||
|
|
89796adf9c | ||
|
|
11b61660d2 | ||
|
|
d214692a28 | ||
|
|
eec270dc08 | ||
|
|
34d3a97939 | ||
|
|
c3c52cf7b0 | ||
|
|
96d7deb99b | ||
|
|
0ceae7a885 | ||
|
|
e19d125606 | ||
|
|
68432b7ed1 | ||
|
|
f1f3820560 | ||
|
|
363cf0a6f1 | ||
|
|
508b6fc60d | ||
|
|
75f3cb9d07 | ||
|
|
31ec149e21 | ||
|
|
6076256c3f | ||
|
|
25f7d3b86e | ||
|
|
464153fecd | ||
|
|
139a16f600 | ||
|
|
600487a9d6 | ||
|
|
a2962cc586 | ||
|
|
d6ae741f7f | ||
|
|
48e3873f19 | ||
|
|
57a42f683c | ||
|
|
b2e1bb03b1 | ||
|
|
47620e4ba8 | ||
|
|
f290d19b27 | ||
|
|
1446838d71 | ||
|
|
8c8c1a6415 | ||
|
|
07f3d3e393 | ||
|
|
85d1666247 | ||
|
|
bf0a1dc6c5 | ||
|
|
31e1e2a8c4 | ||
|
|
8f4ed81159 | ||
|
|
966906b7ae | ||
|
|
20e8eaedc8 | ||
|
|
7b6eaf23e9 | ||
|
|
bf33e5524b | ||
|
|
23c3438aee | ||
|
|
21124cf6ab | ||
|
|
1694cf05a6 | ||
|
|
65bd912b77 | ||
|
|
dd879c794d | ||
|
|
1481e6f3da | ||
|
|
42c2792287 | ||
|
|
08826b79fe | ||
|
|
d5617720bb | ||
|
|
e95143affd | ||
|
|
ced0d271ff | ||
|
|
38e85a2dbe | ||
|
|
221b47806c | ||
|
|
286034431c | ||
|
|
04633c731b | ||
|
|
b28ae0fbb5 | ||
|
|
6c2c1397ff | ||
|
|
16dc425318 | ||
|
|
7a41668df0 | ||
|
|
ef99853da4 | ||
|
|
cb9a441bb9 | ||
|
|
3619c13393 | ||
|
|
f05e229780 | ||
|
|
5cae882ff3 | ||
|
|
0592038cf9 | ||
|
|
fab681eb11 | ||
|
|
01e94e53ed | ||
|
|
e5320ae0d5 | ||
|
|
eccf18644f | ||
|
|
e4b872fc07 | ||
|
|
8445a00210 | ||
|
|
345d7cf628 | ||
|
|
482ab2e9dc | ||
|
|
751453253c | ||
|
|
fa88074963 | ||
|
|
d418226edb | ||
|
|
bdfafd3539 | ||
|
|
819b87f1df | ||
|
|
b36880503c | ||
|
|
3c2b67a4d3 | ||
|
|
08c3a9b76b | ||
|
|
dd519c7dac | ||
|
|
f67a341fce | ||
|
|
c755ef0815 | ||
|
|
99d3f3c9f3 | ||
|
|
0b3a8804eb | ||
|
|
92a9b04a12 | ||
|
|
a4532de5a0 | ||
|
|
b4024d86d1 | ||
|
|
58f5175075 | ||
|
|
5aee84a3f3 | ||
|
|
e52789c557 | ||
|
|
67cfc8e178 | ||
|
|
dca8fae05f | ||
|
|
5512629c55 | ||
|
|
af7e16b8e4 | ||
|
|
63e94b434f | ||
|
|
41a668a515 | ||
|
|
d0a8ae5cf7 | ||
|
|
7f43feafd5 | ||
|
|
2b502a4b2b | ||
|
|
f95100b44a | ||
|
|
0d4e358f5e | ||
|
|
5f7157f3a2 | ||
|
|
7cde8a22a1 | ||
|
|
535895e577 | ||
|
|
366828918a | ||
|
|
1195cdbd77 | ||
|
|
5330c4e5d3 | ||
|
|
52799e58d6 | ||
|
|
46d0e89d6e | ||
|
|
c9bd1f3334 | ||
|
|
6d990b9c83 | ||
|
|
84f95a3ef4 | ||
|
|
008944a5c3 | ||
|
|
7a4ad0872e | ||
|
|
885379e2cc | ||
|
|
76d0eb32fc | ||
|
|
76f6131b81 | ||
|
|
1438a1b7f7 | ||
|
|
024bab4116 |
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.6.5 source distribution.
|
||||
This is the Tcl 8.6.6 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
|
||||
@@ -8624,3 +8624,77 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
|
||||
2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)
|
||||
|
||||
--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
2016-03-01 (bug)[803042] mem leak due to reference cycle (porter)
|
||||
|
||||
2016-03-08 (bug)[bbc304] reflected watch race condition (porter)
|
||||
|
||||
2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter)
|
||||
|
||||
2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter)
|
||||
|
||||
2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows)
|
||||
|
||||
2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans)
|
||||
|
||||
2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans)
|
||||
|
||||
2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans)
|
||||
|
||||
2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans)
|
||||
|
||||
2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin)
|
||||
|
||||
2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti)
|
||||
|
||||
2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)
|
||||
|
||||
2016-05-13 (bug) registry package support any Unicode env (nijtmans)
|
||||
=> registry 1.3.2
|
||||
|
||||
2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
|
||||
|
||||
2016-06-02 (TIP 447) execution time verbosity option (cerutti)
|
||||
=> tcltest 2.4.0
|
||||
|
||||
2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)
|
||||
|
||||
2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)
|
||||
|
||||
2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)
|
||||
|
||||
2016-06-21 (update) Update Unicode data to 9.0 (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter)
|
||||
|
||||
2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows)
|
||||
|
||||
2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect)
|
||||
|
||||
2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)
|
||||
|
||||
2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)
|
||||
|
||||
2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)
|
||||
|
||||
2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-10 (bug)[da340d] integer division in clock math (nadkarni)
|
||||
|
||||
2016-07-20 tzdata updated to Olson's tzdata2016f (venkat)
|
||||
|
||||
--- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
+1
-1
@@ -164,7 +164,7 @@ The source interpreter will have its result reset by this operation.
|
||||
.SH "DEPRECATED INTERFACES"
|
||||
.SS "OLD STRING PROCEDURES"
|
||||
.PP
|
||||
Use of the following procedures (is deprecated
|
||||
Use of the following procedures is deprecated
|
||||
since they manipulate the Tcl result as a string.
|
||||
Procedures such as \fBTcl_SetObjResult\fR
|
||||
that manipulate the result as a value
|
||||
|
||||
+20
-6
@@ -287,12 +287,14 @@ slow destinations like network sockets.
|
||||
.RS
|
||||
.PP
|
||||
The \fBchan copy\fR command transfers data from \fIinputChan\fR until
|
||||
end of file or \fIsize\fR bytes have been transferred. If no
|
||||
\fB\-size\fR argument is given, then the copy goes until end of file.
|
||||
All the data read from \fIinputChan\fR is copied to \fIoutputChan\fR.
|
||||
Without the \fB\-command\fR option, \fBchan copy\fR blocks until the
|
||||
copy is complete and returns the number of bytes written to
|
||||
\fIoutputChan\fR.
|
||||
end of file or \fIsize\fR bytes or characters have been transferred;
|
||||
\fIsize\fR is in bytes if the two channels are using the same encoding,
|
||||
and is in characters otherwise. If no \fB\-size\fR argument is given,
|
||||
then the copy goes until end of file. All the data read from
|
||||
\fIinputChan\fR is copied to \fIoutputChan\fR. Without the
|
||||
\fB\-command\fR option, \fBchan copy\fR blocks until the copy is
|
||||
complete and returns the number of bytes or characters (using the same
|
||||
rules as for the \fB\-size\fR option) written to \fIoutputChan\fR.
|
||||
.PP
|
||||
The \fB\-command\fR argument makes \fBchan copy\fR work in the
|
||||
background. In this case it returns immediately and the
|
||||
@@ -547,6 +549,18 @@ this, spawn with "2>@" or
|
||||
">@" redirection operators onto the write side of a pipe, and then
|
||||
immediately close it in the parent. This is necessary to get an EOF on
|
||||
the read side once the child has exited or otherwise closed its output.
|
||||
.RS
|
||||
.PP
|
||||
Note that the pipe buffering semantics can vary at the operating system level
|
||||
substantially; it is not safe to assume that a write performed on the output
|
||||
side of the pipe will appear instantly to the input side. This is a
|
||||
fundamental difference and Tcl cannot conceal it. The overall stream semantics
|
||||
\fIare\fR compatible, so blocking reads and writes will not see most of the
|
||||
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
|
||||
.TP
|
||||
\fBchan pop \fIchannelId\fR
|
||||
|
||||
+3
-2
@@ -271,8 +271,9 @@ limitation as \fBexec\fR wants to communicate over pipes. The Expect
|
||||
extension addresses this issue when communicating with a TUI application.
|
||||
.PP
|
||||
When attempting to execute an application, \fBexec\fR first searches for
|
||||
the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
|
||||
\fB.bat\fR are appended to the end of the specified name and it searches
|
||||
the name as it was specified. Then, in order,
|
||||
\fB.com\fR, \fB.exe\fR, \fB.bat\fR and \fB.cmd\fR
|
||||
are appended to the end of the specified name and it searches
|
||||
for the longer name. If a directory name was not specified as part of the
|
||||
application name, the following directories are automatically searched in
|
||||
order when attempting to locate the application:
|
||||
|
||||
+9
-3
@@ -25,12 +25,15 @@ network sockets.
|
||||
.PP
|
||||
The \fBfcopy\fR
|
||||
command transfers data from \fIinchan\fR until end of file
|
||||
or \fIsize\fR bytes have been
|
||||
transferred. If no \fB\-size\fR argument is given,
|
||||
or \fIsize\fR bytes or characters have been
|
||||
transferred; \fIsize\fR is in bytes if the two channels are using the
|
||||
same encoding, and is in characters otherwise.
|
||||
If no \fB\-size\fR argument is given,
|
||||
then the copy goes until end of file.
|
||||
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
|
||||
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
|
||||
and returns the number of bytes written to \fIoutchan\fR.
|
||||
and returns the number of bytes or characters (using the same rules as
|
||||
for the \fB\-size\fR option) written to \fIoutchan\fR.
|
||||
.PP
|
||||
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
|
||||
In this case it returns immediately and the \fIcallback\fR is invoked
|
||||
@@ -174,3 +177,6 @@ vwait done
|
||||
eof(n), fblocked(n), fconfigure(n), file(n)
|
||||
.SH KEYWORDS
|
||||
blocking, channel, end of line, end of file, nonblocking, read, translation
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
|
||||
+6
-5
@@ -162,7 +162,9 @@ returns \fB/home\fR (or something similar).
|
||||
\fBfile executable \fIname\fR
|
||||
.
|
||||
Returns \fB1\fR if file \fIname\fR is executable by the current user,
|
||||
\fB0\fR otherwise.
|
||||
\fB0\fR otherwise. On Windows, which does not have an executable attribute,
|
||||
the command treats all directories and any files with extensions
|
||||
\fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable.
|
||||
.TP
|
||||
\fBfile exists \fIname\fR
|
||||
.
|
||||
@@ -482,10 +484,9 @@ not the effective ones.
|
||||
.TP
|
||||
\fBWindows\fR\0\0\0\0
|
||||
.
|
||||
The \fBfile owned\fR subcommand currently always reports that the current user
|
||||
is the owner of the file, without regard for what the operating system
|
||||
believes to be true, making an ownership test useless. This issue (#3613671)
|
||||
may be fixed in a future release of Tcl.
|
||||
The \fBfile owned\fR subcommand uses the user identifier (SID) of
|
||||
the process token, not the thread token which may be impersonating
|
||||
some other user.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This procedure shows how to search for C files in a given directory
|
||||
|
||||
+23
-5
@@ -34,8 +34,9 @@ one or two fields. If there is only a single field in the specifier
|
||||
then it is the name of the argument; if there are two fields, then
|
||||
the first is the argument name and the second is its default value.
|
||||
Arguments with default values that are followed by non-defaulted
|
||||
arguments become required arguments. In 8.6 this will be considered an
|
||||
error.
|
||||
arguments become required arguments; enough actual arguments must be
|
||||
supplied to allow all arguments up to and including the last required
|
||||
formal argument.
|
||||
.PP
|
||||
When \fIname\fR is invoked a local variable
|
||||
will be created for each of the formal arguments to the procedure; its
|
||||
@@ -48,11 +49,14 @@ actual arguments for all the
|
||||
formal arguments that do not have defaults, and there must not be any extra
|
||||
actual arguments.
|
||||
Arguments with default values that are followed by non-defaulted
|
||||
arguments become required arguments (in 8.6 it will be considered an
|
||||
error).
|
||||
arguments become de-facto required arguments, though this may change
|
||||
in a future version of Tcl; portable code should ensure that all
|
||||
optional arguments come after all required arguments.
|
||||
.PP
|
||||
There is one special case to permit procedures with
|
||||
variable numbers of arguments. If the last formal argument has the name
|
||||
\fBargs\fR, then a call to the procedure may contain more actual arguments
|
||||
.QW \fBargs\fR ,
|
||||
then a call to the procedure may contain more actual arguments
|
||||
than the procedure has formal arguments. In this case, all of the actual arguments
|
||||
starting at the one that would be assigned to \fBargs\fR are combined into
|
||||
a list (as if the \fBlist\fR command had been used); this combined value
|
||||
@@ -80,6 +84,20 @@ If an error occurs while executing the procedure
|
||||
body, then the procedure-as-a-whole will return that same error.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This is a procedure that takes two arguments and prints both their sum
|
||||
and their product. It also returns the string
|
||||
.QW OK
|
||||
to the caller as an explicit result.
|
||||
.PP
|
||||
.CS
|
||||
\fBproc\fR printSumProduct {x y} {
|
||||
set sum [expr {$x + $y}]
|
||||
set prod [expr {$x * $y}]
|
||||
puts "sum is $sum, product is $prod"
|
||||
return "OK"
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
This is a procedure that accepts arbitrarily many arguments and prints
|
||||
them out, one by one.
|
||||
.PP
|
||||
|
||||
+12
-2
@@ -872,8 +872,8 @@ harness are doing.
|
||||
.
|
||||
Sets the type of output verbosity desired to \fIlevel\fR,
|
||||
a list of zero or more of the elements \fBbody\fR, \fBpass\fR,
|
||||
\fBskip\fR, \fBstart\fR, \fBerror\fR and \fBline\fR. Default value
|
||||
is
|
||||
\fBskip\fR, \fBstart\fR, \fBerror\fR, \fBline\fR, \fBmsec\fR and \fBusec\fR.
|
||||
Default value is
|
||||
.QW "\fBbody error\fR" .
|
||||
Levels are defined as:
|
||||
.RS
|
||||
@@ -890,6 +890,16 @@ Print errorInfo and errorCode, if they exist, when a test return code
|
||||
does not match its expected return code
|
||||
.IP "line (\fBl\fR)"
|
||||
Print source file line information of failed tests
|
||||
.IP "msec (\fBm\fR)"
|
||||
Print each test's execution time in milliseconds
|
||||
.IP "usec (\fBu\fR)"
|
||||
Print each test's execution time in microseconds
|
||||
.PP
|
||||
Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as
|
||||
indicative measures only. They do not tackle the problem of repeatibility which
|
||||
should be considered in performance tests or benchmarks. To use these verbosity
|
||||
levels to thoroughly track performance degradations, consider wrapping your
|
||||
test bodies with \fBtime\fR commands.
|
||||
.PP
|
||||
The single letter abbreviations noted above are also recognized
|
||||
so that
|
||||
|
||||
+12
-6
@@ -174,7 +174,11 @@ to the \fBzlib push\fR command:
|
||||
.VS "TIP 400"
|
||||
Sets the compression dictionary to use when working with compressing or
|
||||
decompressing the data to be \fIbinData\fR. Not valid for transformations that
|
||||
work with gzip-format data.
|
||||
work with gzip-format data. The dictionary should consist of strings (byte
|
||||
sequences) that are likely to be encountered later in the data to be compressed,
|
||||
with the most commonly used strings preferably put towards the end of the
|
||||
dictionary. Tcl provides no mechanism for choosing a good such dictionary for
|
||||
a particular data sequence.
|
||||
.VE
|
||||
.TP
|
||||
\fB\-header\fI dictionary\fR
|
||||
@@ -207,11 +211,13 @@ compression algorithm depends on what format is being produced or consumed.
|
||||
.TP
|
||||
\fB\-dictionary\fI binData\fR
|
||||
.VS "TIP 400"
|
||||
This read-write options gets or sets the compression dictionary to use when
|
||||
working with compressing or decompressing the data to be \fIbinData\fR. It is
|
||||
not valid for transformations that work with gzip-format data, and should not
|
||||
normally be set on compressing transformations other than at the point where
|
||||
the transformation is stacked.
|
||||
This read-write options gets or sets the initial compression dictionary to use
|
||||
when working with compressing or decompressing the data to be \fIbinData\fR.
|
||||
It is not valid for transformations that work with gzip-format data, and should
|
||||
not normally be set on compressing transformations other than at the point where
|
||||
the transformation is stacked. Note that this cannot be used to get the
|
||||
current active compression dictionary mid-stream, as that information is not
|
||||
exposed by the underlying library.
|
||||
.VE
|
||||
.TP
|
||||
\fB\-flush\fI type\fR
|
||||
|
||||
+202
-191
@@ -140,35 +140,36 @@ static const crange alphaRangeTable[] = {
|
||||
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
|
||||
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
|
||||
{0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x904, 0x939},
|
||||
{0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c}, {0x993, 0x9a8},
|
||||
{0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1}, {0xa05, 0xa0a},
|
||||
{0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c}, {0xa72, 0xa74},
|
||||
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
|
||||
{0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
|
||||
{0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a}, {0xb8e, 0xb90},
|
||||
{0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xc05, 0xc0c},
|
||||
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc58, 0xc5a},
|
||||
{0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
|
||||
{0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd3a},
|
||||
{0xd5f, 0xd61}, {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1},
|
||||
{0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46},
|
||||
{0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0},
|
||||
{0xec0, 0xec4}, {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c},
|
||||
{0xf88, 0xf8c}, {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d},
|
||||
{0x106e, 0x1070}, {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa},
|
||||
{0x10fc, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d},
|
||||
{0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5},
|
||||
{0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310},
|
||||
{0x1312, 0x1315}, {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5},
|
||||
{0x13f8, 0x13fd}, {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a},
|
||||
{0x16a0, 0x16ea}, {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711},
|
||||
{0x1720, 0x1731}, {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770},
|
||||
{0x1780, 0x17b3}, {0x1820, 0x1877}, {0x1880, 0x18a8}, {0x18b0, 0x18f5},
|
||||
{0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
|
||||
{0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
|
||||
{0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
|
||||
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1},
|
||||
{0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x8b6, 0x8bd},
|
||||
{0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c},
|
||||
{0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
|
||||
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28},
|
||||
{0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a},
|
||||
{0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
|
||||
{0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39},
|
||||
{0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8},
|
||||
{0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
|
||||
{0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61}, {0xd7a, 0xd7f},
|
||||
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
|
||||
{0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, {0xe99, 0xe9f},
|
||||
{0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf},
|
||||
{0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a},
|
||||
{0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081},
|
||||
{0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d},
|
||||
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
|
||||
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
|
||||
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
|
||||
{0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c},
|
||||
{0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8},
|
||||
{0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
|
||||
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877},
|
||||
{0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e},
|
||||
{0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
|
||||
{0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b},
|
||||
{0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f},
|
||||
{0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1},
|
||||
{0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
|
||||
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
|
||||
{0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3},
|
||||
@@ -183,7 +184,7 @@ static const crange alphaRangeTable[] = {
|
||||
{0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5},
|
||||
{0x4e00, 0x9fd5}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c},
|
||||
{0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5},
|
||||
{0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ad}, {0xa7b0, 0xa7b7},
|
||||
{0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae}, {0xa7b0, 0xa7b7},
|
||||
{0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822},
|
||||
{0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925},
|
||||
{0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4},
|
||||
@@ -193,6 +194,8 @@ static const crange alphaRangeTable[] = {
|
||||
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
|
||||
{0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2}, {0xac00, 0xd7a3},
|
||||
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e},
|
||||
{0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e},
|
||||
{0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e}, {0xde40, 0xde7e},
|
||||
{0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e},
|
||||
{0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
|
||||
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36},
|
||||
@@ -205,36 +208,38 @@ static const crange alphaRangeTable[] = {
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
|
||||
{0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
|
||||
{0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
|
||||
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
|
||||
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
|
||||
{0x10860, 0x10876}, {0x10880, 0x1089e}, {0x108e0, 0x108f2}, {0x10900, 0x10915},
|
||||
{0x10920, 0x10939}, {0x10980, 0x109b7}, {0x10a10, 0x10a13}, {0x10a15, 0x10a17},
|
||||
{0x10a19, 0x10a33}, {0x10a60, 0x10a7c}, {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7},
|
||||
{0x10ac9, 0x10ae4}, {0x10b00, 0x10b35}, {0x10b40, 0x10b55}, {0x10b60, 0x10b72},
|
||||
{0x10b80, 0x10b91}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
|
||||
{0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8}, {0x11103, 0x11126},
|
||||
{0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4}, {0x11200, 0x11211},
|
||||
{0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
|
||||
{0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c}, {0x11313, 0x11328},
|
||||
{0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361}, {0x11480, 0x114af},
|
||||
{0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563},
|
||||
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
|
||||
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
|
||||
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
|
||||
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
|
||||
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
|
||||
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
|
||||
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
|
||||
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
|
||||
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
|
||||
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
|
||||
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
|
||||
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
|
||||
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x12000, 0x12399},
|
||||
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
|
||||
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
|
||||
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
|
||||
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
|
||||
{0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
|
||||
{0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
|
||||
{0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
|
||||
{0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
|
||||
{0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
|
||||
{0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
|
||||
{0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
|
||||
{0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1},
|
||||
{0x2f800, 0x2fa1d}
|
||||
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08},
|
||||
{0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x12000, 0x12399}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
|
||||
{0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f}, {0x17000, 0x187ec},
|
||||
{0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88},
|
||||
{0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
|
||||
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
|
||||
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
|
||||
{0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
|
||||
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943},
|
||||
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
|
||||
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
|
||||
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
|
||||
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
|
||||
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -249,24 +254,24 @@ static const chr alphaCharTable[] = {
|
||||
0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9,
|
||||
0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83,
|
||||
0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d,
|
||||
0xc60, 0xc61, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2, 0xd3d,
|
||||
0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87, 0xe88,
|
||||
0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3, 0xebd,
|
||||
0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7, 0x10cd,
|
||||
0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf, 0x1cf5,
|
||||
0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107,
|
||||
0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3,
|
||||
0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c, 0xa62a,
|
||||
0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0,
|
||||
0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
|
||||
0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87,
|
||||
0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3,
|
||||
0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7,
|
||||
0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf,
|
||||
0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102,
|
||||
0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2,
|
||||
0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c,
|
||||
0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6,
|
||||
0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
|
||||
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
|
||||
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x16f50,
|
||||
0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
|
||||
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
|
||||
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
|
||||
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
|
||||
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11c40,
|
||||
0x16f50, 0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6,
|
||||
0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
|
||||
0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
|
||||
0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -289,7 +294,7 @@ static const crange controlRangeTable[] = {
|
||||
#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))
|
||||
|
||||
static const chr controlCharTable[] = {
|
||||
0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff
|
||||
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x110bd, 0xe0001
|
||||
#endif
|
||||
@@ -314,9 +319,10 @@ static const crange digitRangeTable[] = {
|
||||
{0xff10, 0xff19}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
|
||||
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x114d0, 0x114d9}, {0x11650, 0x11659},
|
||||
{0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9}, {0x16a60, 0x16a69},
|
||||
{0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}
|
||||
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
|
||||
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
|
||||
{0x11c50, 0x11c59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff},
|
||||
{0x1e950, 0x1e959}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -339,7 +345,7 @@ static const crange punctRangeTable[] = {
|
||||
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
|
||||
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
|
||||
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e42},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e44},
|
||||
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
|
||||
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
|
||||
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
|
||||
@@ -348,9 +354,9 @@ static const crange punctRangeTable[] = {
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
|
||||
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
|
||||
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x115c1, 0x115d7},
|
||||
{0x11641, 0x11643}, {0x1173c, 0x1173e}, {0x12470, 0x12474}, {0x16b37, 0x16b3b},
|
||||
{0x1da87, 0x1da8b}
|
||||
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
|
||||
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
|
||||
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -371,8 +377,8 @@ static const chr punctCharTable[] = {
|
||||
0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x114c6, 0x16a6e, 0x16a6f, 0x16af5,
|
||||
0x16b44, 0x1bc9f
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
|
||||
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -404,24 +410,24 @@ static const crange lowerRangeTable[] = {
|
||||
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
|
||||
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
|
||||
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
|
||||
{0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d},
|
||||
{0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37},
|
||||
{0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d},
|
||||
{0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4},
|
||||
{0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4},
|
||||
{0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25},
|
||||
{0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a},
|
||||
{0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
|
||||
{0xff41, 0xff5a}
|
||||
{0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
|
||||
{0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
|
||||
{0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
|
||||
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
|
||||
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
|
||||
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
|
||||
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
|
||||
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
|
||||
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10428, 0x1044f}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df}, {0x1d41a, 0x1d433},
|
||||
{0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9},
|
||||
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537},
|
||||
{0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607},
|
||||
{0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da},
|
||||
{0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b}, {0x1d736, 0x1d74e},
|
||||
{0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2},
|
||||
{0x1d7c4, 0x1d7c9}
|
||||
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
|
||||
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
|
||||
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
|
||||
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
|
||||
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
|
||||
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
|
||||
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
|
||||
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -513,15 +519,15 @@ static const crange upperRangeTable[] = {
|
||||
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
|
||||
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
|
||||
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
|
||||
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ad}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
|
||||
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10400, 0x10427}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf}, {0x1d400, 0x1d419},
|
||||
{0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5},
|
||||
{0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
|
||||
{0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585},
|
||||
{0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621}, {0x1d63c, 0x1d655},
|
||||
{0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734},
|
||||
{0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}
|
||||
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
|
||||
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
|
||||
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
|
||||
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
|
||||
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -610,26 +616,26 @@ static const crange graphRangeTable[] = {
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
|
||||
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
|
||||
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b4},
|
||||
{0x8e3, 0x983}, {0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0},
|
||||
{0x9b6, 0x9b9}, {0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3},
|
||||
{0x9e6, 0x9fb}, {0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28},
|
||||
{0xa2a, 0xa30}, {0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c},
|
||||
{0xa66, 0xa75}, {0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
|
||||
{0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5},
|
||||
{0xac7, 0xac9}, {0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1},
|
||||
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
|
||||
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
|
||||
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
|
||||
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
|
||||
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
|
||||
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
|
||||
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
|
||||
{0xc66, 0xc6f}, {0xc78, 0xc7f}, {0xc81, 0xc83}, {0xc85, 0xc8c},
|
||||
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
|
||||
{0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
|
||||
{0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
|
||||
{0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4e},
|
||||
{0xd5f, 0xd63}, {0xd66, 0xd75}, {0xd79, 0xd7f}, {0xd85, 0xd96},
|
||||
{0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
|
||||
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
|
||||
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83},
|
||||
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
|
||||
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
|
||||
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c},
|
||||
{0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44},
|
||||
{0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a},
|
||||
{0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
|
||||
{0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa},
|
||||
{0xc00, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
|
||||
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
|
||||
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc83},
|
||||
{0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
|
||||
{0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd},
|
||||
{0xce0, 0xce3}, {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c},
|
||||
{0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48},
|
||||
{0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f}, {0xd85, 0xd96},
|
||||
{0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4},
|
||||
{0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a},
|
||||
{0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3},
|
||||
@@ -650,25 +656,25 @@ static const crange graphRangeTable[] = {
|
||||
{0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
|
||||
{0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
|
||||
{0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
|
||||
{0x1c4d, 0x1c7f}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5},
|
||||
{0x1dfc, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
|
||||
{0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5},
|
||||
{0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
|
||||
{0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4},
|
||||
{0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4},
|
||||
{0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e},
|
||||
{0x2090, 0x209c}, {0x20a0, 0x20be}, {0x20d0, 0x20f0}, {0x2100, 0x218b},
|
||||
{0x2190, 0x23fa}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
|
||||
{0x2190, 0x23fe}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
|
||||
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1},
|
||||
{0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
|
||||
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
|
||||
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e42},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e44},
|
||||
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312d},
|
||||
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fd5}, {0xa000, 0xa48c},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ad},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
|
||||
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
|
||||
{0xa880, 0xa8c4}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
|
||||
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
|
||||
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
|
||||
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
|
||||
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
|
||||
@@ -687,54 +693,59 @@ static const crange graphRangeTable[] = {
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
|
||||
{0x10137, 0x1018c}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
|
||||
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
|
||||
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a},
|
||||
{0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
|
||||
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x10500, 0x10527}, {0x10530, 0x10563},
|
||||
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
|
||||
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10857, 0x1089e}, {0x108a7, 0x108af},
|
||||
{0x108e0, 0x108f2}, {0x108fb, 0x1091b}, {0x1091f, 0x10939}, {0x10980, 0x109b7},
|
||||
{0x109bc, 0x109cf}, {0x109d2, 0x10a03}, {0x10a0c, 0x10a13}, {0x10a15, 0x10a17},
|
||||
{0x10a19, 0x10a33}, {0x10a38, 0x10a3a}, {0x10a3f, 0x10a47}, {0x10a50, 0x10a58},
|
||||
{0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6}, {0x10aeb, 0x10af6}, {0x10b00, 0x10b35},
|
||||
{0x10b39, 0x10b55}, {0x10b58, 0x10b72}, {0x10b78, 0x10b91}, {0x10b99, 0x10b9c},
|
||||
{0x10ba9, 0x10baf}, {0x10c00, 0x10c48}, {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2},
|
||||
{0x10cfa, 0x10cff}, {0x10e60, 0x10e7e}, {0x11000, 0x1104d}, {0x11052, 0x1106f},
|
||||
{0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8}, {0x110f0, 0x110f9},
|
||||
{0x11100, 0x11134}, {0x11136, 0x11143}, {0x11150, 0x11176}, {0x11180, 0x111cd},
|
||||
{0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211}, {0x11213, 0x1123d},
|
||||
{0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a9},
|
||||
{0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303}, {0x11305, 0x1130c},
|
||||
{0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1133c, 0x11344},
|
||||
{0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c}, {0x11370, 0x11374},
|
||||
{0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
|
||||
{0x11600, 0x11644}, {0x11650, 0x11659}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
|
||||
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb},
|
||||
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
|
||||
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
|
||||
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
|
||||
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
|
||||
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
|
||||
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
|
||||
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
|
||||
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
|
||||
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
|
||||
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
|
||||
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
|
||||
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
|
||||
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
|
||||
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
|
||||
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
|
||||
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
|
||||
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
|
||||
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
|
||||
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
|
||||
{0x11ac0, 0x11af8}, {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474},
|
||||
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
|
||||
{0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5},
|
||||
{0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77},
|
||||
{0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
|
||||
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371},
|
||||
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
|
||||
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
|
||||
{0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b},
|
||||
{0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6},
|
||||
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
|
||||
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
|
||||
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
|
||||
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
|
||||
{0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
|
||||
{0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f19a},
|
||||
{0x1f1e6, 0x1f202}, {0x1f210, 0x1f23a}, {0x1f240, 0x1f248}, {0x1f300, 0x1f579},
|
||||
{0x1f57b, 0x1f5a3}, {0x1f5a5, 0x1f6d0}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f3},
|
||||
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
|
||||
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f910, 0x1f918},
|
||||
{0x1f980, 0x1f984}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
|
||||
{0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
|
||||
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
|
||||
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
|
||||
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
|
||||
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
|
||||
{0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88},
|
||||
{0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126},
|
||||
{0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356},
|
||||
{0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
|
||||
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
|
||||
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
|
||||
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
|
||||
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ee00, 0x1ee03},
|
||||
{0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
|
||||
{0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
|
||||
{0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
|
||||
{0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae},
|
||||
{0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c},
|
||||
{0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
|
||||
{0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f300, 0x1f6d2}, {0x1f6e0, 0x1f6ec},
|
||||
{0x1f6f0, 0x1f6f6}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b},
|
||||
{0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad},
|
||||
{0x1f910, 0x1f91e}, {0x1f920, 0x1f927}, {0x1f933, 0x1f93e}, {0x1f940, 0x1f94b},
|
||||
{0x1f950, 0x1f95e}, {0x1f980, 0x1f991}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
|
||||
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -747,20 +758,20 @@ static const chr graphCharTable[] = {
|
||||
0xad0, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56,
|
||||
0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e,
|
||||
0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6,
|
||||
0xcde, 0xcf1, 0xcf2, 0xd57, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6,
|
||||
0xe81, 0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7,
|
||||
0xeaa, 0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773,
|
||||
0x1940, 0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27,
|
||||
0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc,
|
||||
0xfffd
|
||||
0xcde, 0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81,
|
||||
0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa,
|
||||
0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940,
|
||||
0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d,
|
||||
0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
|
||||
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x118ff, 0x16a6e, 0x16a6f, 0x1b000, 0x1b001,
|
||||
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
|
||||
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
|
||||
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
|
||||
0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x16a6e, 0x16a6f,
|
||||
0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
|
||||
0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
|
||||
0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
|
||||
0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
|
||||
0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f930, 0x1f9c0
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
+2
-2
@@ -56,10 +56,10 @@ extern "C" {
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 6
|
||||
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 5
|
||||
#define TCL_RELEASE_SERIAL 6
|
||||
|
||||
#define TCL_VERSION "8.6"
|
||||
#define TCL_PATCH_LEVEL "8.6.5"
|
||||
#define TCL_PATCH_LEVEL "8.6.6"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
|
||||
@@ -3984,10 +3984,12 @@ UnstackExpiredCatches(
|
||||
|
||||
while (catchDepth > bbPtr->catchDepth) {
|
||||
--catchDepth;
|
||||
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
|
||||
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
|
||||
catches[catchDepth] = NULL;
|
||||
catchIndices[catchDepth] = -1;
|
||||
if (catches[catchDepth] != NULL) {
|
||||
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
|
||||
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
|
||||
catches[catchDepth] = NULL;
|
||||
catchIndices[catchDepth] = -1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+16
-11
@@ -128,7 +128,7 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
|
||||
int actual, Tcl_Obj *const *objv);
|
||||
static Tcl_NRPostProc NRCoroutineCallerCallback;
|
||||
static Tcl_NRPostProc NRCoroutineExitCallback;
|
||||
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc NRCommand;
|
||||
|
||||
static Tcl_ObjCmdProc OldMathFuncProc;
|
||||
static void OldMathFuncDeleteProc(ClientData clientData);
|
||||
@@ -146,7 +146,6 @@ static int TEOV_RunEnterTraces(Tcl_Interp *interp,
|
||||
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static Tcl_NRPostProc RewindCoroutineCallback;
|
||||
static Tcl_NRPostProc TailcallCleanup;
|
||||
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
|
||||
static Tcl_NRPostProc TEOEx_ListCallback;
|
||||
static Tcl_NRPostProc TEOV_Error;
|
||||
@@ -723,9 +722,7 @@ Tcl_CreateInterp(void)
|
||||
* Initialize the ensemble error message rewriting support.
|
||||
*/
|
||||
|
||||
iPtr->ensembleRewrite.sourceObjs = NULL;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 0;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
|
||||
/*
|
||||
* TIP#143: Initialise the resource limit support.
|
||||
@@ -4220,7 +4217,7 @@ EvalObjvCore(
|
||||
* TCL_EVAL_INVOKE was not set: clear rewrite rules
|
||||
*/
|
||||
|
||||
iPtr->ensembleRewrite.sourceObjs = NULL;
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
|
||||
if (flags & TCL_EVAL_GLOBAL) {
|
||||
TEOV_SwitchVarFrame(interp);
|
||||
@@ -8373,7 +8370,7 @@ TclNRTailcallEval(
|
||||
* a now-gone namespace: cleanup and return.
|
||||
*/
|
||||
|
||||
TailcallCleanup(data, interp, result);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -8382,18 +8379,26 @@ TclNRTailcallEval(
|
||||
*/
|
||||
|
||||
TclMarkTailcall(interp);
|
||||
TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
|
||||
TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
|
||||
iPtr->lookupNsPtr = (Namespace *) nsPtr;
|
||||
return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
|
||||
}
|
||||
|
||||
static int
|
||||
TailcallCleanup(
|
||||
int
|
||||
TclNRReleaseValues(
|
||||
ClientData data[],
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
Tcl_DecrRefCount((Tcl_Obj *) data[0]);
|
||||
int i = 0;
|
||||
while (i < 4) {
|
||||
if (data[i]) {
|
||||
Tcl_DecrRefCount((Tcl_Obj *) data[i]);
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
i++;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
@@ -1499,7 +1499,19 @@ GetJulianDayFromEraYearMonthDay(
|
||||
* Try an initial conversion in the Gregorian calendar.
|
||||
*/
|
||||
|
||||
#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
|
||||
ym1o4 = ym1 / 4;
|
||||
#else
|
||||
/*
|
||||
* Have to make sure quotient is truncated towards 0 when negative.
|
||||
* See above bug for details. The casts are necessary.
|
||||
*/
|
||||
if (ym1 >= 0)
|
||||
ym1o4 = ym1 / 4;
|
||||
else {
|
||||
ym1o4 = - (int) (((unsigned int) -ym1) / 4);
|
||||
}
|
||||
#endif
|
||||
if (ym1 % 4 < 0) {
|
||||
ym1o4--;
|
||||
}
|
||||
|
||||
+31
-12
@@ -12,6 +12,9 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#ifdef _WIN32
|
||||
# include "tclWinInt.h"
|
||||
#endif
|
||||
#include <locale.h>
|
||||
|
||||
/*
|
||||
@@ -1157,6 +1160,16 @@ FileAttrAccessTimeCmd(
|
||||
if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#if defined(_WIN32)
|
||||
/* We use a value of 0 to indicate the access time not available */
|
||||
if (buf.st_atime == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get access time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#endif
|
||||
|
||||
if (objc == 3) {
|
||||
/*
|
||||
* Need separate variable for reading longs from an object on 64-bit
|
||||
@@ -1229,6 +1242,15 @@ FileAttrModifyTimeCmd(
|
||||
if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#if defined(_WIN32)
|
||||
/* We use a value of 0 to indicate the modification time not available */
|
||||
if (buf.st_mtime == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"could not get modification time for file \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#endif
|
||||
if (objc == 3) {
|
||||
/*
|
||||
* Need separate variable for reading longs from an object on 64-bit
|
||||
@@ -1574,28 +1596,25 @@ FileAttrIsOwnedCmd(
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
#ifdef __CYGWIN__
|
||||
#define geteuid() (short)(geteuid)()
|
||||
#endif
|
||||
#if !defined(_WIN32)
|
||||
Tcl_StatBuf buf;
|
||||
#endif
|
||||
int value = 0;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "name");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
|
||||
/*
|
||||
* For Windows, there are no user ids associated with a file, so we
|
||||
* always return 1.
|
||||
*
|
||||
* TODO: use GetSecurityInfo to get the real owner of the file and
|
||||
* test for equivalence to the current user.
|
||||
*/
|
||||
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
value = 1;
|
||||
#if defined(_WIN32)
|
||||
value = TclWinFileOwned(objv[1]);
|
||||
#else
|
||||
if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
|
||||
value = (geteuid() == buf.st_uid);
|
||||
#endif
|
||||
}
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+3
-4
@@ -105,8 +105,7 @@ typedef struct SortInfo {
|
||||
*/
|
||||
|
||||
static int DictionaryCompare(const char *left, const char *right);
|
||||
static int IfConditionCallback(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc IfConditionCallback;
|
||||
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
@@ -1203,7 +1202,7 @@ InfoFrameCmd(
|
||||
levelError:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad level \"%s\"", TclGetString(objv[1])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
|
||||
TclGetString(objv[1]), NULL);
|
||||
code = TCL_ERROR;
|
||||
goto done;
|
||||
@@ -1638,7 +1637,7 @@ InfoLevelCmd(
|
||||
levelError:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad level \"%s\"", TclGetString(objv[1])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
|
||||
TclGetString(objv[1]), NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+4
-8
@@ -22,14 +22,10 @@
|
||||
|
||||
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
|
||||
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
|
||||
static int SwitchPostProc(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static int TryPostBody(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static int TryPostFinal(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static int TryPostHandler(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static Tcl_NRPostProc SwitchPostProc;
|
||||
static Tcl_NRPostProc TryPostBody;
|
||||
static Tcl_NRPostProc TryPostFinal;
|
||||
static Tcl_NRPostProc TryPostHandler;
|
||||
static int UniCharIsAscii(int character);
|
||||
static int UniCharIsHexDigit(int character);
|
||||
|
||||
|
||||
@@ -3239,8 +3239,10 @@ EnterCmdWordData(
|
||||
TclAdvanceLines(&wordLine, last, tokenPtr->start);
|
||||
TclAdvanceContinuations(&wordLine, &wordNext,
|
||||
tokenPtr->start - envPtr->source);
|
||||
/* See Ticket 4b61afd660 */
|
||||
wwlines[wordIdx] =
|
||||
(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
|
||||
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
|
||||
? wordLine : -1;
|
||||
ePtr->line[wordIdx] = wordLine;
|
||||
ePtr->next[wordIdx] = wordNext;
|
||||
last = tokenPtr->start;
|
||||
|
||||
+1
-7
@@ -359,14 +359,8 @@ typedef short int yytype_int16;
|
||||
#ifndef YYSIZE_T
|
||||
# ifdef __SIZE_TYPE__
|
||||
# define YYSIZE_T __SIZE_TYPE__
|
||||
# elif defined size_t
|
||||
# define YYSIZE_T size_t
|
||||
# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
|
||||
|| defined __cplusplus || defined _MSC_VER)
|
||||
# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
|
||||
# define YYSIZE_T size_t
|
||||
# else
|
||||
# define YYSIZE_T unsigned int
|
||||
# define YYSIZE_T size_t
|
||||
# endif
|
||||
#endif
|
||||
|
||||
|
||||
+6
-12
@@ -70,18 +70,12 @@ static inline void DeleteChainTable(struct Dict *dict);
|
||||
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
|
||||
Tcl_Obj *keyPtr, int *newPtr);
|
||||
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
|
||||
static int FinalizeDictUpdate(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int FinalizeDictWith(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
static int DictForLoopCallback(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int DictMapLoopCallback(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc FinalizeDictUpdate;
|
||||
static Tcl_NRPostProc FinalizeDictWith;
|
||||
static Tcl_ObjCmdProc DictForNRCmd;
|
||||
static Tcl_ObjCmdProc DictMapNRCmd;
|
||||
static Tcl_NRPostProc DictForLoopCallback;
|
||||
static Tcl_NRPostProc DictMapLoopCallback;
|
||||
|
||||
/*
|
||||
* Table of dict subcommand names and implementations.
|
||||
|
||||
+134
-1
@@ -6,7 +6,7 @@
|
||||
*
|
||||
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
|
||||
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
|
||||
* Copyright (c) 2013 Donal K. Fellows.
|
||||
* Copyright (c) 2013-2016 Donal K. Fellows.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -1279,9 +1279,11 @@ Tcl_DisassembleObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
static const char *const types[] = {
|
||||
"constructor", "destructor",
|
||||
"lambda", "method", "objmethod", "proc", "script", NULL
|
||||
};
|
||||
enum Types {
|
||||
DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR,
|
||||
DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
|
||||
DISAS_SCRIPT
|
||||
};
|
||||
@@ -1290,6 +1292,7 @@ Tcl_DisassembleObjCmd(
|
||||
Proc *procPtr = NULL;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Object *oPtr;
|
||||
Method *methodPtr;
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
|
||||
@@ -1384,6 +1387,136 @@ Tcl_DisassembleObjCmd(
|
||||
codeObjPtr = objv[2];
|
||||
break;
|
||||
|
||||
case DISAS_CLASS_CONSTRUCTOR:
|
||||
if (objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "className");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Look up the body of a constructor.
|
||||
*/
|
||||
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (oPtr->classPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"\"%s\" is not a class", TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
|
||||
TclGetString(objv[2]), NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
methodPtr = oPtr->classPtr->constructorPtr;
|
||||
if (methodPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"\"%s\" has no defined constructor",
|
||||
TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
|
||||
"CONSRUCTOR", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
procPtr = TclOOGetProcFromMethod(methodPtr);
|
||||
if (procPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"body not available for this kind of constructor", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
|
||||
"METHODTYPE", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compile if necessary.
|
||||
*/
|
||||
|
||||
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
|
||||
Command cmd;
|
||||
|
||||
/*
|
||||
* Yes, this is ugly, but we need to pass the namespace in to the
|
||||
* compiler in two places.
|
||||
*/
|
||||
|
||||
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
|
||||
procPtr->cmdPtr = &cmd;
|
||||
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
|
||||
(Namespace *) oPtr->namespacePtr, "body of constructor",
|
||||
TclGetString(objv[2]));
|
||||
procPtr->cmdPtr = NULL;
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
}
|
||||
codeObjPtr = procPtr->bodyPtr;
|
||||
break;
|
||||
|
||||
case DISAS_CLASS_DESTRUCTOR:
|
||||
if (objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "className");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Look up the body of a destructor.
|
||||
*/
|
||||
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (oPtr->classPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"\"%s\" is not a class", TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
|
||||
TclGetString(objv[2]), NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
methodPtr = oPtr->classPtr->destructorPtr;
|
||||
if (methodPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"\"%s\" has no defined destructor",
|
||||
TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
|
||||
"DESRUCTOR", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
procPtr = TclOOGetProcFromMethod(methodPtr);
|
||||
if (procPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"body not available for this kind of destructor", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
|
||||
"METHODTYPE", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compile if necessary.
|
||||
*/
|
||||
|
||||
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
|
||||
Command cmd;
|
||||
|
||||
/*
|
||||
* Yes, this is ugly, but we need to pass the namespace in to the
|
||||
* compiler in two places.
|
||||
*/
|
||||
|
||||
cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
|
||||
procPtr->cmdPtr = &cmd;
|
||||
result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
|
||||
(Namespace *) oPtr->namespacePtr, "body of destructor",
|
||||
TclGetString(objv[2]));
|
||||
procPtr->cmdPtr = NULL;
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
}
|
||||
codeObjPtr = procPtr->bodyPtr;
|
||||
break;
|
||||
|
||||
case DISAS_CLASS_METHOD:
|
||||
if (objc != 4) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
|
||||
|
||||
+244
-152
@@ -30,11 +30,10 @@ static int NsEnsembleStringOrder(const void *strPtr1,
|
||||
const void *strPtr2);
|
||||
static void DeleteEnsembleConfig(ClientData clientData);
|
||||
static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
|
||||
EnsembleConfig *ensemblePtr,
|
||||
const char *subcmdName, Tcl_Obj *prefixObjPtr);
|
||||
EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr,
|
||||
Tcl_Obj *fix);
|
||||
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
|
||||
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
|
||||
static void CompileToInvokedCommand(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Tcl_Obj *replacements,
|
||||
Command *cmdPtr, CompileEnv *envPtr);
|
||||
@@ -42,6 +41,8 @@ static int CompileBasicNArgCommand(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
CompileEnv *envPtr);
|
||||
|
||||
static Tcl_NRPostProc FreeER;
|
||||
|
||||
/*
|
||||
* The lists of subcommands and options for the [namespace ensemble] command.
|
||||
*/
|
||||
@@ -77,14 +78,30 @@ enum EnsConfigOpts {
|
||||
* that implements it.
|
||||
*/
|
||||
|
||||
const Tcl_ObjType tclEnsembleCmdType = {
|
||||
static const Tcl_ObjType ensembleCmdType = {
|
||||
"ensembleCommand", /* the type's name */
|
||||
FreeEnsembleCmdRep, /* freeIntRepProc */
|
||||
DupEnsembleCmdRep, /* dupIntRepProc */
|
||||
StringOfEnsembleCmdRep, /* updateStringProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc */
|
||||
};
|
||||
|
||||
/*
|
||||
* The internal rep for caching ensemble subcommand lookups and
|
||||
* spell corrections.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
int epoch; /* Used to confirm when the data in this
|
||||
* really structure matches up with the
|
||||
* ensemble. */
|
||||
Command *token; /* Reference to the command for which this
|
||||
* structure is a cache of the resolution. */
|
||||
Tcl_Obj *fix; /* Corrected spelling, if needed. */
|
||||
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
|
||||
* hash table. */
|
||||
} EnsembleCmdRep;
|
||||
|
||||
|
||||
static inline Tcl_Obj *
|
||||
NewNsObj(
|
||||
@@ -1643,6 +1660,8 @@ NsEnsembleImplementationCmdNR(
|
||||
* names. */
|
||||
int reparseCount = 0; /* Number of reparses. */
|
||||
Tcl_Obj *errorObj; /* Used for building error messages. */
|
||||
Tcl_Obj *subObj;
|
||||
int subIdx;
|
||||
|
||||
/*
|
||||
* Must recheck objc, since numParameters might have changed. Cf. test
|
||||
@@ -1650,24 +1669,18 @@ NsEnsembleImplementationCmdNR(
|
||||
*/
|
||||
|
||||
restartEnsembleParse:
|
||||
if (objc < 2 + ensemblePtr->numParameters) {
|
||||
subIdx = 1 + ensemblePtr->numParameters;
|
||||
if (objc < subIdx + 1) {
|
||||
/*
|
||||
* We don't have a subcommand argument. Make error message.
|
||||
*/
|
||||
|
||||
Tcl_DString buf; /* Message being built */
|
||||
Tcl_Obj **elemPtrs; /* Parameter names */
|
||||
int len; /* Number of parameters to append */
|
||||
|
||||
Tcl_DStringInit(&buf);
|
||||
if (ensemblePtr->parameterList == NULL) {
|
||||
len = 0;
|
||||
} else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
|
||||
&len, &elemPtrs) != TCL_OK) {
|
||||
Tcl_Panic("List of ensemble parameters is not a list");
|
||||
}
|
||||
for (; len>0; len--,elemPtrs++) {
|
||||
TclDStringAppendObj(&buf, *elemPtrs);
|
||||
if (ensemblePtr->parameterList) {
|
||||
Tcl_DStringAppend(&buf,
|
||||
TclGetString(ensemblePtr->parameterList), -1);
|
||||
TclDStringAppendLiteral(&buf, " ");
|
||||
}
|
||||
TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
|
||||
@@ -1695,6 +1708,8 @@ NsEnsembleImplementationCmdNR(
|
||||
* up in there and go straight to dispatch.
|
||||
*/
|
||||
|
||||
subObj = objv[subIdx];
|
||||
|
||||
if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
|
||||
/*
|
||||
* Table of subcommands is still valid; therefore there might be a
|
||||
@@ -1703,15 +1718,16 @@ NsEnsembleImplementationCmdNR(
|
||||
* part where we do the invocation of the subcommand.
|
||||
*/
|
||||
|
||||
if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
|
||||
EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
|
||||
->internalRep.twoPtrValue.ptr1;
|
||||
if (subObj->typePtr==&ensembleCmdType){
|
||||
EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
|
||||
ensembleCmd->epoch == ensemblePtr->epoch &&
|
||||
ensembleCmd->token == ensemblePtr->token) {
|
||||
prefixObj = ensembleCmd->realPrefixObj;
|
||||
if (ensembleCmd->epoch == ensemblePtr->epoch &&
|
||||
ensembleCmd->token == (Command *)ensemblePtr->token) {
|
||||
prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
|
||||
Tcl_IncrRefCount(prefixObj);
|
||||
if (ensembleCmd->fix) {
|
||||
TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
|
||||
}
|
||||
goto runResultingSubcommand;
|
||||
}
|
||||
}
|
||||
@@ -1726,18 +1742,14 @@ NsEnsembleImplementationCmdNR(
|
||||
*/
|
||||
|
||||
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
|
||||
TclGetString(objv[1 + ensemblePtr->numParameters]));
|
||||
TclGetString(subObj));
|
||||
if (hPtr != NULL) {
|
||||
char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
|
||||
|
||||
prefixObj = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/*
|
||||
* Cache for later in the subcommand object.
|
||||
*/
|
||||
|
||||
MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
|
||||
ensemblePtr, fullName, prefixObj);
|
||||
MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL);
|
||||
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
|
||||
/*
|
||||
* Could not map, no prefixing, go to unknown/error handling.
|
||||
@@ -1757,9 +1769,9 @@ NsEnsembleImplementationCmdNR(
|
||||
char *fullName = NULL; /* Full name of the subcommand. */
|
||||
int stringLength, i;
|
||||
int tableLength = ensemblePtr->subcommandTable.numEntries;
|
||||
Tcl_Obj *fix;
|
||||
|
||||
subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]);
|
||||
stringLength = objv[1 + ensemblePtr->numParameters]->length;
|
||||
subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
|
||||
for (i=0 ; i<tableLength ; i++) {
|
||||
register int cmp = strncmp(subcmdName,
|
||||
ensemblePtr->subcommandArrayPtr[i],
|
||||
@@ -1799,16 +1811,22 @@ NsEnsembleImplementationCmdNR(
|
||||
Tcl_Panic("full name %s not found in supposedly synchronized hash",
|
||||
fullName);
|
||||
}
|
||||
prefixObj = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/*
|
||||
* Record the spelling correction for usage message.
|
||||
*/
|
||||
|
||||
fix = Tcl_NewStringObj(fullName, -1);
|
||||
|
||||
/*
|
||||
* Cache for later in the subcommand object.
|
||||
*/
|
||||
|
||||
MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
|
||||
ensemblePtr, fullName, prefixObj);
|
||||
MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
|
||||
TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
|
||||
}
|
||||
|
||||
prefixObj = Tcl_GetHashValue(hPtr);
|
||||
Tcl_IncrRefCount(prefixObj);
|
||||
runResultingSubcommand:
|
||||
|
||||
@@ -1827,47 +1845,26 @@ NsEnsembleImplementationCmdNR(
|
||||
*/
|
||||
|
||||
{
|
||||
Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
|
||||
* target command prefix. */
|
||||
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
|
||||
* Will be freed by the dispatch engine. */
|
||||
int prefixObjc, copyObjc;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj **copyObjv;
|
||||
int copyObjc, prefixObjc;
|
||||
|
||||
/*
|
||||
* Get the prefix that we're rewriting to. To do this we need to
|
||||
* ensure that the internal representation of the list does not change
|
||||
* so that we can safely keep the internal representations of the
|
||||
* elements in the list.
|
||||
*
|
||||
* TODO: Use conventional list operations to make this code sane!
|
||||
*/
|
||||
Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
|
||||
|
||||
TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
|
||||
|
||||
copyObjc = objc - 2 + prefixObjc;
|
||||
copyPtr = Tcl_NewListObj(copyObjc, NULL);
|
||||
if (copyObjc > 0) {
|
||||
register Tcl_Obj **copyObjv;
|
||||
/* Space used to construct the list of
|
||||
* arguments to pass to the command that
|
||||
* implements the ensemble subcommand. */
|
||||
register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
|
||||
register int i;
|
||||
|
||||
listRepPtr->elemCount = copyObjc;
|
||||
copyObjv = &listRepPtr->elements;
|
||||
memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
|
||||
memcpy(copyObjv+prefixObjc, objv+1,
|
||||
sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
|
||||
memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
|
||||
objv+ensemblePtr->numParameters+2,
|
||||
sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
|
||||
|
||||
for (i=0; i < copyObjc; i++) {
|
||||
Tcl_IncrRefCount(copyObjv[i]);
|
||||
}
|
||||
if (objc == 2) {
|
||||
copyPtr = TclListObjCopy(NULL, prefixObj);
|
||||
} else {
|
||||
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
|
||||
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
|
||||
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
|
||||
ensemblePtr->numParameters, objv + 1);
|
||||
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
|
||||
objc - 2 - ensemblePtr->numParameters,
|
||||
objv + 2 + ensemblePtr->numParameters);
|
||||
}
|
||||
Tcl_IncrRefCount(copyPtr);
|
||||
TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
|
||||
TclDecrRefCount(prefixObj);
|
||||
|
||||
/*
|
||||
@@ -1876,25 +1873,10 @@ NsEnsembleImplementationCmdNR(
|
||||
* count both as inserted and removed arguments.
|
||||
*/
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs =
|
||||
2 + ensemblePtr->numParameters;
|
||||
iPtr->ensembleRewrite.numInsertedObjs =
|
||||
prefixObjc + ensemblePtr->numParameters;
|
||||
if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
|
||||
prefixObjc + ensemblePtr->numParameters, objv)) {
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
|
||||
NULL);
|
||||
} else {
|
||||
register int ni = 2 + ensemblePtr->numParameters
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
/* Position in objv of new front of insertion
|
||||
* relative to old one. */
|
||||
if (ni > 0) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += ni;
|
||||
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1902,7 +1884,8 @@ NsEnsembleImplementationCmdNR(
|
||||
*/
|
||||
|
||||
TclSkipTailcall(interp);
|
||||
return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
|
||||
Tcl_ListObjGetElements(NULL, copyPtr, ©Objc, ©Objv);
|
||||
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
|
||||
}
|
||||
|
||||
unknownOrAmbiguousSubcommand:
|
||||
@@ -1934,20 +1917,17 @@ NsEnsembleImplementationCmdNR(
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
|
||||
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
|
||||
TclGetString(subObj), NULL);
|
||||
if (ensemblePtr->subcommandTable.numEntries == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"unknown subcommand \"%s\": namespace %s does not"
|
||||
" export any commands",
|
||||
TclGetString(objv[1+ensemblePtr->numParameters]),
|
||||
" export any commands", TclGetString(subObj),
|
||||
ensemblePtr->nsPtr->fullName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
|
||||
TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
|
||||
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
|
||||
TclGetString(objv[1+ensemblePtr->numParameters]));
|
||||
TclGetString(subObj));
|
||||
if (ensemblePtr->subcommandTable.numEntries == 1) {
|
||||
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
|
||||
} else {
|
||||
@@ -2013,7 +1993,7 @@ TclInitRewriteEnsemble(
|
||||
|
||||
if (numIns < numRemoved) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
|
||||
iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = numInserted;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
|
||||
}
|
||||
@@ -2053,6 +2033,149 @@ TclResetRewriteEnsemble(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclSpellFix --
|
||||
*
|
||||
* Record a spelling correction that needs making in the
|
||||
* generation of the WrongNumArgs usage message.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Can create an alternative ensemble rewrite structure.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
FreeER(
|
||||
ClientData data[],
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
Tcl_Obj **tmp = (Tcl_Obj **)data[0];
|
||||
|
||||
ckfree(tmp[2]);
|
||||
ckfree(tmp);
|
||||
return result;
|
||||
}
|
||||
|
||||
void
|
||||
TclSpellFix(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv,
|
||||
int objc,
|
||||
int badIdx,
|
||||
Tcl_Obj *bad,
|
||||
Tcl_Obj *fix)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Obj *const *search;
|
||||
Tcl_Obj **store;
|
||||
int idx;
|
||||
int size;
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 0;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
}
|
||||
|
||||
/* Compute the valid length of the ensemble root */
|
||||
|
||||
size = iPtr->ensembleRewrite.numRemovedObjs + objc
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
/* Awful casting abuse here */
|
||||
search = (Tcl_Obj *const *) search[1];
|
||||
}
|
||||
|
||||
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
|
||||
/*
|
||||
* Misspelled value was inserted. We cannot directly jump
|
||||
* to the bad value, but have to search.
|
||||
*/
|
||||
idx = 1;
|
||||
while (idx < size) {
|
||||
if (search[idx] == bad) {
|
||||
break;
|
||||
}
|
||||
idx++;
|
||||
}
|
||||
if (idx == size) {
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
/* Jump to the misspelled value. */
|
||||
idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
/* Verify */
|
||||
if (search[idx] != bad) {
|
||||
Tcl_Panic("SpellFix: programming error");
|
||||
}
|
||||
}
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
store = (Tcl_Obj **)search[2];
|
||||
} else {
|
||||
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
|
||||
tmp[0] = NULL;
|
||||
tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
|
||||
|
||||
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
|
||||
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
|
||||
store = (Tcl_Obj **)tmp[2];
|
||||
}
|
||||
|
||||
store[idx] = fix;
|
||||
Tcl_IncrRefCount(fix);
|
||||
TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclFetchEnsembleRoot --
|
||||
*
|
||||
* Returns the root of ensemble rewriting, if any.
|
||||
* If no root exists, returns objv instead.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *const *
|
||||
TclFetchEnsembleRoot(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv,
|
||||
int objc,
|
||||
int *objcPtr)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs) {
|
||||
*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
return iPtr->ensembleRewrite.sourceObjs;
|
||||
}
|
||||
*objcPtr = objc;
|
||||
return objv;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2218,17 +2341,17 @@ static void
|
||||
MakeCachedEnsembleCommand(
|
||||
Tcl_Obj *objPtr,
|
||||
EnsembleConfig *ensemblePtr,
|
||||
const char *subcommandName,
|
||||
Tcl_Obj *prefixObjPtr)
|
||||
Tcl_HashEntry *hPtr,
|
||||
Tcl_Obj *fix)
|
||||
{
|
||||
register EnsembleCmdRep *ensembleCmd;
|
||||
int length;
|
||||
|
||||
if (objPtr->typePtr == &tclEnsembleCmdType) {
|
||||
if (objPtr->typePtr == &ensembleCmdType) {
|
||||
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
|
||||
TclNsDecrRefCount(ensembleCmd->nsPtr);
|
||||
ckfree(ensembleCmd->fullSubcmdName);
|
||||
TclCleanupCommandMacro(ensembleCmd->token);
|
||||
if (ensembleCmd->fix) {
|
||||
Tcl_DecrRefCount(ensembleCmd->fix);
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Kill the old internal rep, and replace it with a brand new one of
|
||||
@@ -2238,22 +2361,21 @@ MakeCachedEnsembleCommand(
|
||||
TclFreeIntRep(objPtr);
|
||||
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
|
||||
objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
|
||||
objPtr->typePtr = &tclEnsembleCmdType;
|
||||
objPtr->typePtr = &ensembleCmdType;
|
||||
}
|
||||
|
||||
/*
|
||||
* Populate the internal rep.
|
||||
*/
|
||||
|
||||
ensembleCmd->nsPtr = ensemblePtr->nsPtr;
|
||||
ensembleCmd->epoch = ensemblePtr->epoch;
|
||||
ensembleCmd->token = ensemblePtr->token;
|
||||
ensemblePtr->nsPtr->refCount++;
|
||||
ensembleCmd->realPrefixObj = prefixObjPtr;
|
||||
length = strlen(subcommandName)+1;
|
||||
ensembleCmd->fullSubcmdName = ckalloc(length);
|
||||
memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
|
||||
Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
|
||||
ensembleCmd->token = (Command *) ensemblePtr->token;
|
||||
ensembleCmd->token->refCount++;
|
||||
if (fix) {
|
||||
Tcl_IncrRefCount(fix);
|
||||
}
|
||||
ensembleCmd->fix = fix;
|
||||
ensembleCmd->hPtr = hPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2634,9 +2756,10 @@ FreeEnsembleCmdRep(
|
||||
{
|
||||
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
|
||||
ckfree(ensembleCmd->fullSubcmdName);
|
||||
TclNsDecrRefCount(ensembleCmd->nsPtr);
|
||||
TclCleanupCommandMacro(ensembleCmd->token);
|
||||
if (ensembleCmd->fix) {
|
||||
Tcl_DecrRefCount(ensembleCmd->fix);
|
||||
}
|
||||
ckfree(ensembleCmd);
|
||||
objPtr->typePtr = NULL;
|
||||
}
|
||||
@@ -2666,48 +2789,17 @@ DupEnsembleCmdRep(
|
||||
{
|
||||
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
|
||||
int length = strlen(ensembleCmd->fullSubcmdName);
|
||||
|
||||
copyPtr->typePtr = &tclEnsembleCmdType;
|
||||
copyPtr->typePtr = &ensembleCmdType;
|
||||
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
|
||||
ensembleCopy->nsPtr = ensembleCmd->nsPtr;
|
||||
ensembleCopy->epoch = ensembleCmd->epoch;
|
||||
ensembleCopy->token = ensembleCmd->token;
|
||||
ensembleCopy->nsPtr->refCount++;
|
||||
ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
|
||||
Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
|
||||
ensembleCopy->fullSubcmdName = ckalloc(length + 1);
|
||||
memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
|
||||
(unsigned) length+1);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StringOfEnsembleCmdRep --
|
||||
*
|
||||
* Creates a string representation of a Tcl_Obj that holds a subcommand
|
||||
* of an ensemble.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object gains a string (UTF-8) representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
StringOfEnsembleCmdRep(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
int length = strlen(ensembleCmd->fullSubcmdName);
|
||||
|
||||
objPtr->length = length;
|
||||
objPtr->bytes = ckalloc(length + 1);
|
||||
memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
|
||||
ensembleCopy->token->refCount++;
|
||||
ensembleCopy->fix = ensembleCmd->fix;
|
||||
if (ensembleCopy->fix) {
|
||||
Tcl_IncrRefCount(ensembleCopy->fix);
|
||||
}
|
||||
ensembleCopy->hPtr = ensembleCmd->hPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -1462,6 +1462,8 @@ VwaitVarProc(
|
||||
int *donePtr = clientData;
|
||||
|
||||
*donePtr = 1;
|
||||
Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
|
||||
VwaitVarProc, clientData);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
+30
-20
@@ -2077,6 +2077,13 @@ TclNRExecuteByteCode(
|
||||
iPtr->stats.numExecutions++;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Test namespace-50.9 demonstrates the need for this call.
|
||||
* Use a --enable-symbols=mem bug to see.
|
||||
*/
|
||||
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
|
||||
/*
|
||||
* Push the callback for bytecode execution
|
||||
*/
|
||||
@@ -3153,35 +3160,34 @@ TEBCresume(
|
||||
fflush(stdout);
|
||||
}
|
||||
#endif /*TCL_COMPILE_DEBUG*/
|
||||
{
|
||||
Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
|
||||
register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
|
||||
Tcl_Obj **copyObjv = &listRepPtr->elements;
|
||||
int i;
|
||||
|
||||
listRepPtr->elemCount = objc - opnd + 1;
|
||||
copyObjv[0] = objPtr;
|
||||
memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
|
||||
for (i=1 ; i<objc-opnd+1 ; i++) {
|
||||
Tcl_IncrRefCount(copyObjv[i]);
|
||||
}
|
||||
objPtr = copyPtr;
|
||||
}
|
||||
bcFramePtr->data.tebc.pc = (char *) pc;
|
||||
iPtr->cmdFramePtr = bcFramePtr;
|
||||
if (iPtr->flags & INTERP_DEBUG_FRAME) {
|
||||
ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
|
||||
}
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = opnd;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 1;
|
||||
|
||||
TclInitRewriteEnsemble(interp, opnd, 1, objv);
|
||||
|
||||
{
|
||||
Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
|
||||
|
||||
Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
|
||||
Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
|
||||
objc - opnd, objv + opnd);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
objPtr = copyPtr;
|
||||
}
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
pc += 6;
|
||||
TEBC_YIELD();
|
||||
|
||||
TclMarkTailcall(interp);
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
|
||||
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
|
||||
TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
|
||||
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
|
||||
|
||||
/*
|
||||
* -----------------------------------------------------------------
|
||||
@@ -4414,8 +4420,8 @@ TEBCresume(
|
||||
savedNsPtr = iPtr->varFramePtr->nsPtr;
|
||||
iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
|
||||
otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
|
||||
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
|
||||
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
|
||||
(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
|
||||
"access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
|
||||
iPtr->varFramePtr->nsPtr = savedNsPtr;
|
||||
if (!otherPtr) {
|
||||
TRACE_ERROR(interp);
|
||||
@@ -7706,6 +7712,7 @@ TEBCresume(
|
||||
goto gotError;
|
||||
}
|
||||
}
|
||||
Tcl_IncrRefCount(dictPtr);
|
||||
if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
|
||||
&keyPtrPtr) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
@@ -7718,6 +7725,7 @@ TEBCresume(
|
||||
if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
|
||||
&valuePtr) != TCL_OK) {
|
||||
TRACE_ERROR(interp);
|
||||
Tcl_DecrRefCount(dictPtr);
|
||||
goto gotError;
|
||||
}
|
||||
varPtr = LOCAL(duiPtr->varIndices[i]);
|
||||
@@ -7734,10 +7742,12 @@ TEBCresume(
|
||||
duiPtr->varIndices[i]) == NULL) {
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
Tcl_DecrRefCount(dictPtr);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
}
|
||||
TclDecrRefCount(dictPtr);
|
||||
TRACE_APPEND(("OK\n"));
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
|
||||
|
||||
@@ -1595,8 +1595,9 @@ Tcl_GlobObjCmd(
|
||||
} else if (dir == PATH_GENERAL) {
|
||||
Tcl_DString str;
|
||||
|
||||
Tcl_DStringInit(&str);
|
||||
for (i = 0; i < objc; i++) {
|
||||
Tcl_DStringInit(&str);
|
||||
Tcl_DStringSetLength(&str, 0);
|
||||
if (dir == PATH_GENERAL) {
|
||||
TclDStringAppendDString(&str, &prefix);
|
||||
}
|
||||
|
||||
+73
-86
@@ -313,15 +313,20 @@ static int WillRead(Channel *chanPtr);
|
||||
&& (strncmp(optionName, (nameString), len) == 0))
|
||||
|
||||
/*
|
||||
* The ChannelObjType type. We actually store the ChannelState structure
|
||||
* as that lives longest and we want to return the bottomChanPtr when
|
||||
* requested (consistent with Tcl_GetChannel). The setFromAny and
|
||||
* updateString can be NULL as they should not be called.
|
||||
* The ChannelObjType type. Used to store the result of looking up
|
||||
* a channel name in the context of an interp. Saves the lookup
|
||||
* result and values needed to check its continued validity.
|
||||
*/
|
||||
|
||||
typedef struct ResolvedChanName {
|
||||
ChannelState *statePtr; /* The saved lookup result */
|
||||
Tcl_Interp *interp; /* The interp in which the lookup was done. */
|
||||
int epoch; /* The epoch of the channel when the lookup
|
||||
* was done. Use to verify validity. */
|
||||
int refCount; /* Share this struct among many Tcl_Obj. */
|
||||
} ResolvedChanName;
|
||||
|
||||
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
static int SetChannelFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
static void FreeChannelIntRep(Tcl_Obj *objPtr);
|
||||
|
||||
static const Tcl_ObjType chanObjType = {
|
||||
@@ -329,18 +334,9 @@ static const Tcl_ObjType chanObjType = {
|
||||
FreeChannelIntRep, /* freeIntRepProc */
|
||||
DupChannelIntRep, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc SetChannelFromAny */
|
||||
NULL /* setFromAnyProc */
|
||||
};
|
||||
|
||||
#define GET_CHANNELSTATE(objPtr) \
|
||||
((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
|
||||
#define SET_CHANNELSTATE(objPtr, storePtr) \
|
||||
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
|
||||
#define GET_CHANNELINTERP(objPtr) \
|
||||
((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
|
||||
#define SET_CHANNELINTERP(objPtr, storePtr) \
|
||||
((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
|
||||
|
||||
#define BUSY_STATE(st, fl) \
|
||||
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
|
||||
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
|
||||
@@ -1021,7 +1017,7 @@ DeleteChannelTable(
|
||||
*/
|
||||
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
SetFlag(statePtr, CHANNEL_TAINTED);
|
||||
statePtr->epoch++;
|
||||
if (statePtr->refCount-- <= 1) {
|
||||
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
|
||||
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
|
||||
@@ -1365,7 +1361,7 @@ DetachChannel(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
SetFlag(statePtr, CHANNEL_TAINTED);
|
||||
statePtr->epoch++;
|
||||
|
||||
/*
|
||||
* Remove channel handlers that refer to this interpreter, so that
|
||||
@@ -1498,12 +1494,57 @@ TclGetChannelFromObj(
|
||||
int flags)
|
||||
{
|
||||
ChannelState *statePtr;
|
||||
ResolvedChanName *resPtr = NULL;
|
||||
Tcl_Channel chan;
|
||||
|
||||
if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
|
||||
if (interp == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
statePtr = GET_CHANNELSTATE(objPtr);
|
||||
if (objPtr->typePtr == &chanObjType) {
|
||||
/*
|
||||
* Confirm validity of saved lookup results.
|
||||
*/
|
||||
|
||||
resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
|
||||
statePtr = resPtr->statePtr;
|
||||
if ((resPtr->interp == interp) /* Same interp context */
|
||||
/* No epoch change in channel since lookup */
|
||||
&& (resPtr->epoch == statePtr->epoch)) {
|
||||
|
||||
/* Have a valid saved lookup. Jump to end to return it. */
|
||||
goto valid;
|
||||
}
|
||||
}
|
||||
|
||||
chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
|
||||
|
||||
if (chan == NULL) {
|
||||
if (resPtr) {
|
||||
FreeChannelIntRep(objPtr);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (resPtr && resPtr->refCount == 1) {
|
||||
/* Re-use the ResolvedCmdName struct */
|
||||
Tcl_Release((ClientData) resPtr->statePtr);
|
||||
|
||||
} else {
|
||||
TclFreeIntRep(objPtr);
|
||||
|
||||
resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
|
||||
resPtr->refCount = 1;
|
||||
objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
|
||||
objPtr->typePtr = &chanObjType;
|
||||
}
|
||||
statePtr = ((Channel *)chan)->state;
|
||||
resPtr->statePtr = statePtr;
|
||||
Tcl_Preserve((ClientData) statePtr);
|
||||
resPtr->interp = interp;
|
||||
resPtr->epoch = statePtr->epoch;
|
||||
|
||||
valid:
|
||||
*channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
|
||||
|
||||
if (modePtr != NULL) {
|
||||
@@ -1676,6 +1717,8 @@ Tcl_CreateChannel(
|
||||
statePtr->chanMsg = NULL;
|
||||
statePtr->unreportedMsg = NULL;
|
||||
|
||||
statePtr->epoch = 0;
|
||||
|
||||
/*
|
||||
* Link the channel into the list of all channels; create an on-exit
|
||||
* handler if there is not one already, to close off all the channels in
|
||||
@@ -11121,75 +11164,13 @@ DupChannelIntRep(
|
||||
register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
|
||||
* currently have an internal rep.*/
|
||||
{
|
||||
ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
|
||||
ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
SET_CHANNELSTATE(copyPtr, statePtr);
|
||||
SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
|
||||
Tcl_Preserve(statePtr);
|
||||
resPtr->refCount++;
|
||||
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
|
||||
copyPtr->typePtr = srcPtr->typePtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* SetChannelFromAny --
|
||||
*
|
||||
* Create an internal representation of type "Channel" for an object.
|
||||
*
|
||||
* Results:
|
||||
* This operation always succeeds and returns TCL_OK.
|
||||
*
|
||||
* Side effects:
|
||||
* Any old internal reputation for objPtr is freed and the internal
|
||||
* representation is set to "Channel".
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
SetChannelFromAny(
|
||||
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
|
||||
register Tcl_Obj *objPtr) /* The object to convert. */
|
||||
{
|
||||
ChannelState *statePtr;
|
||||
|
||||
if (interp == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objPtr->typePtr == &chanObjType) {
|
||||
/*
|
||||
* TODO: TAINT Flag and dup'd channel values?
|
||||
* The channel is valid until any call to DetachChannel occurs.
|
||||
* Ensure consistency checks are done.
|
||||
*/
|
||||
|
||||
statePtr = GET_CHANNELSTATE(objPtr);
|
||||
if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
|
||||
ResetFlag(statePtr, CHANNEL_TAINTED);
|
||||
Tcl_Release(statePtr);
|
||||
objPtr->typePtr = NULL;
|
||||
} else if (interp != GET_CHANNELINTERP(objPtr)) {
|
||||
Tcl_Release(statePtr);
|
||||
objPtr->typePtr = NULL;
|
||||
}
|
||||
}
|
||||
if (objPtr->typePtr != &chanObjType) {
|
||||
Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
|
||||
|
||||
if (chan == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
TclFreeIntRep(objPtr);
|
||||
statePtr = ((Channel *) chan)->state;
|
||||
Tcl_Preserve(statePtr);
|
||||
SET_CHANNELSTATE(objPtr, statePtr);
|
||||
SET_CHANNELINTERP(objPtr, interp);
|
||||
objPtr->typePtr = &chanObjType;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -11210,8 +11191,14 @@ static void
|
||||
FreeChannelIntRep(
|
||||
Tcl_Obj *objPtr) /* Object with internal rep to free. */
|
||||
{
|
||||
Tcl_Release(GET_CHANNELSTATE(objPtr));
|
||||
ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
objPtr->typePtr = NULL;
|
||||
if (--resPtr->refCount) {
|
||||
return;
|
||||
}
|
||||
Tcl_Release(resPtr->statePtr);
|
||||
ckfree(resPtr);
|
||||
}
|
||||
|
||||
#if 0
|
||||
|
||||
+2
-4
@@ -214,6 +214,8 @@ typedef struct ChannelState {
|
||||
* because it happened in the background. The
|
||||
* value is the chanMg, if any. #219's
|
||||
* companion to 'unreportedError'. */
|
||||
int epoch; /* Used to test validity of stored channelname
|
||||
* lookup results. */
|
||||
} ChannelState;
|
||||
|
||||
/*
|
||||
@@ -275,10 +277,6 @@ typedef struct ChannelState {
|
||||
* usable, but it may not be closed
|
||||
* again from within the close
|
||||
* handler. */
|
||||
#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed.
|
||||
* Used by Channel Tcl_Obj type to
|
||||
* determine if we have to revalidate
|
||||
* the channel. */
|
||||
#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed.
|
||||
* No further Tcl-level write IO on
|
||||
* the channel is allowed. */
|
||||
|
||||
+1
-2
@@ -71,8 +71,7 @@ typedef struct ThreadSpecificData {
|
||||
* Prototypes for functions defined later in this file.
|
||||
*/
|
||||
|
||||
static int EvalFileCallback(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc EvalFileCallback;
|
||||
static FilesystemRecord*FsGetFirstFilesystem(void);
|
||||
static void FsThrExitProc(ClientData cd);
|
||||
static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
|
||||
|
||||
+8
-11
@@ -924,6 +924,14 @@ Tcl_WrongNumArgs(
|
||||
int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
|
||||
Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
|
||||
|
||||
/*
|
||||
* Check for spelling fixes, and substitute the fixed values.
|
||||
*/
|
||||
|
||||
if (origObjv[0] == NULL) {
|
||||
origObjv = (Tcl_Obj *const *)origObjv[2];
|
||||
}
|
||||
|
||||
/*
|
||||
* We only know how to do rewriting if all the replaced objects are
|
||||
* actually arguments (in objv) to this function. Otherwise it just
|
||||
@@ -957,12 +965,6 @@ Tcl_WrongNumArgs(
|
||||
|
||||
elementStr = EXPAND_OF(indexRep);
|
||||
elemLen = strlen(elementStr);
|
||||
} else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
|
||||
register EnsembleCmdRep *ecrPtr =
|
||||
origObjv[i]->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
elementStr = ecrPtr->fullSubcmdName;
|
||||
elemLen = strlen(elementStr);
|
||||
} else {
|
||||
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
|
||||
}
|
||||
@@ -1011,11 +1013,6 @@ Tcl_WrongNumArgs(
|
||||
register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
|
||||
} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
|
||||
register EnsembleCmdRep *ecrPtr =
|
||||
objv[i]->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
|
||||
} else {
|
||||
/*
|
||||
* Quote the argument if it contains spaces (Bug 942757).
|
||||
|
||||
+24
-24
@@ -48,7 +48,8 @@
|
||||
#else
|
||||
#include <string.h>
|
||||
#endif
|
||||
#ifdef STDC_HEADERS
|
||||
#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
|
||||
|| defined(__cplusplus) || defined(_MSC_VER)
|
||||
#include <stddef.h>
|
||||
#else
|
||||
typedef int ptrdiff_t;
|
||||
@@ -168,6 +169,21 @@ typedef struct Tcl_ResolverInfo {
|
||||
* at compile time. */
|
||||
} Tcl_ResolverInfo;
|
||||
|
||||
/*
|
||||
* This flag bit should not interfere with TCL_GLOBAL_ONLY,
|
||||
* TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
|
||||
* lookup is performed for upvar (or similar) purposes, with slightly
|
||||
* different rules:
|
||||
* - Bug #696893 - variable is either proc-local or in the current
|
||||
* namespace; never follow the second (global) resolution path
|
||||
* - Bug #631741 - do not use special namespace or interp resolvers
|
||||
*
|
||||
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
|
||||
* (Bug #835020)
|
||||
*/
|
||||
|
||||
#define TCL_AVOID_RESOLVERS 0x40000
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Data structures related to namespaces.
|
||||
@@ -388,27 +404,6 @@ struct NamespacePathEntry {
|
||||
#define TCL_CREATE_NS_IF_UNKNOWN 0x800
|
||||
#define TCL_FIND_ONLY_NS 0x1000
|
||||
|
||||
/*
|
||||
* The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
|
||||
* twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
|
||||
* referring to the same subcommand, even where one is a duplicate of another.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
Namespace *nsPtr; /* The namespace backing the ensemble which
|
||||
* this is a subcommand of. */
|
||||
int epoch; /* Used to confirm when the data in this
|
||||
* really structure matches up with the
|
||||
* ensemble. */
|
||||
Tcl_Command token; /* Reference to the comamnd for which this
|
||||
* structure is a cache of the resolution. */
|
||||
char *fullSubcmdName; /* The full (local) name of the subcommand,
|
||||
* allocated with ckalloc(). */
|
||||
Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
|
||||
* command that implements this ensemble
|
||||
* subcommand. */
|
||||
} EnsembleCmdRep;
|
||||
|
||||
/*
|
||||
* The client data for an ensemble command. This consists of the table of
|
||||
* commands that are actually exported by the namespace, and an epoch counter
|
||||
@@ -2761,6 +2756,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
|
||||
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
|
||||
|
||||
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
|
||||
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
|
||||
@@ -2871,8 +2867,7 @@ MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
|
||||
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
|
||||
int *loc);
|
||||
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
|
||||
@@ -2908,6 +2903,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
|
||||
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
|
||||
Tcl_DString *toAppendPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
|
||||
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv, int objc, int *objcPtr);
|
||||
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
|
||||
MODULE_SCOPE void TclFinalizeAsync(void);
|
||||
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
|
||||
@@ -3110,6 +3107,9 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
|
||||
Tcl_Obj *newValue, Tcl_Encoding encoding);
|
||||
MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result);
|
||||
MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv, int objc, int subIdx,
|
||||
Tcl_Obj *bad, Tcl_Obj *fix);
|
||||
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
|
||||
int numBytes);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
|
||||
|
||||
+4
-28
@@ -1795,11 +1795,9 @@ AliasNRCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument vector. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Alias *aliasPtr = clientData;
|
||||
int prefc, cmdc, i;
|
||||
Tcl_Obj **prefv, **cmdv;
|
||||
int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
|
||||
Tcl_Obj *listPtr;
|
||||
List *listRep;
|
||||
int flags = TCL_EVAL_INVOKE;
|
||||
@@ -1831,21 +1829,7 @@ AliasNRCmd(
|
||||
* only the source command should show, not the full target prefix.
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 1;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = prefc;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* We are sending a 0-refCount obj, do not need a callback: it will be
|
||||
* cleaned up automatically. But we may need to clear the rootEnsemble
|
||||
* stuff ...
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
|
||||
}
|
||||
TclSkipTailcall(interp);
|
||||
@@ -1866,7 +1850,7 @@ AliasObjCmd(
|
||||
Tcl_Obj **prefv, **cmdv;
|
||||
Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
|
||||
Interp *tPtr = (Interp *) targetInterp;
|
||||
int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
|
||||
int isRootEnsemble;
|
||||
|
||||
/*
|
||||
* Append the arguments to the command prefix and invoke the command in
|
||||
@@ -1896,13 +1880,7 @@ AliasObjCmd(
|
||||
* only the source command should show, not the full target prefix.
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
tPtr->ensembleRewrite.sourceObjs = objv;
|
||||
tPtr->ensembleRewrite.numRemovedObjs = 1;
|
||||
tPtr->ensembleRewrite.numInsertedObjs = prefc;
|
||||
} else {
|
||||
tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
|
||||
}
|
||||
isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv);
|
||||
|
||||
/*
|
||||
* Protect the target interpreter if it isn't the same as the source
|
||||
@@ -1925,9 +1903,7 @@ AliasObjCmd(
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
tPtr->ensembleRewrite.sourceObjs = NULL;
|
||||
tPtr->ensembleRewrite.numRemovedObjs = 0;
|
||||
tPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+68
-41
@@ -1105,8 +1105,6 @@ TclTeardownNamespace(
|
||||
Interp *iPtr = (Interp *) nsPtr->interp;
|
||||
register Tcl_HashEntry *entryPtr;
|
||||
Tcl_HashSearch search;
|
||||
Tcl_Namespace *childNsPtr;
|
||||
Tcl_Command cmd;
|
||||
int i;
|
||||
|
||||
/*
|
||||
@@ -1121,16 +1119,31 @@ TclTeardownNamespace(
|
||||
/*
|
||||
* Delete all commands in this namespace. Be careful when traversing the
|
||||
* hash table: when each command is deleted, it removes itself from the
|
||||
* command table.
|
||||
*
|
||||
* Don't optimize to Tcl_NextHashEntry() because of traces.
|
||||
* command table. Because of traces (and the desire to avoid the quadratic
|
||||
* problems of just using Tcl_FirstHashEntry over and over, [Bug
|
||||
* f97d4ee020]) we copy to a temporary array and then delete all those
|
||||
* commands.
|
||||
*/
|
||||
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
|
||||
cmd = Tcl_GetHashValue(entryPtr);
|
||||
Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
|
||||
while (nsPtr->cmdTable.numEntries > 0) {
|
||||
int length = nsPtr->cmdTable.numEntries;
|
||||
Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Command *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
cmds[i] = Tcl_GetHashValue(entryPtr);
|
||||
cmds[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
|
||||
(Tcl_Command) cmds[i]);
|
||||
TclCleanupCommandMacro(cmds[i]);
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, cmds);
|
||||
}
|
||||
Tcl_DeleteHashTable(&nsPtr->cmdTable);
|
||||
Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
|
||||
@@ -1175,25 +1188,54 @@ TclTeardownNamespace(
|
||||
*
|
||||
* BE CAREFUL: When each child is deleted, it will divorce itself from its
|
||||
* parent. You can't traverse a hash table properly if its elements are
|
||||
* being deleted. We use only the Tcl_FirstHashEntry function to be safe.
|
||||
* being deleted. Because of traces (and the desire to avoid the
|
||||
* quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
|
||||
* f97d4ee020]) we copy to a temporary array and then delete all those
|
||||
* namespaces.
|
||||
*
|
||||
* Don't optimize to Tcl_NextHashEntry() because of traces.
|
||||
* Important: leave the hash table itself still live.
|
||||
*/
|
||||
|
||||
#ifndef BREAK_NAMESPACE_COMPAT
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
|
||||
childNsPtr = Tcl_GetHashValue(entryPtr);
|
||||
Tcl_DeleteNamespace(childNsPtr);
|
||||
while (nsPtr->childTable.numEntries > 0) {
|
||||
int length = nsPtr->childTable.numEntries;
|
||||
Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
#else
|
||||
if (nsPtr->childTablePtr != NULL) {
|
||||
for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
|
||||
childNsPtr = Tcl_GetHashValue(entryPtr);
|
||||
Tcl_DeleteNamespace(childNsPtr);
|
||||
while (nsPtr->childTablePtr->numEntries > 0) {
|
||||
int length = nsPtr->childTablePtr->numEntries;
|
||||
Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
|
||||
sizeof(Namespace *) * length);
|
||||
|
||||
i = 0;
|
||||
for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
|
||||
entryPtr != NULL;
|
||||
entryPtr = Tcl_NextHashEntry(&search)) {
|
||||
children[i] = Tcl_GetHashValue(entryPtr);
|
||||
children[i]->refCount++;
|
||||
i++;
|
||||
}
|
||||
for (i = 0 ; i < length ; i++) {
|
||||
Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
|
||||
TclNsDecrRefCount(children[i]);
|
||||
}
|
||||
TclStackFree((Tcl_Interp *) iPtr, children);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
@@ -3312,14 +3354,7 @@ NRNamespaceEvalCmd(
|
||||
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
|
||||
namespacePtr, /*isProcCallFrame*/ 0);
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
framePtr->objc = objc;
|
||||
framePtr->objv = objv;
|
||||
} else {
|
||||
framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
|
||||
}
|
||||
framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
|
||||
|
||||
if (objc == 3) {
|
||||
/*
|
||||
@@ -3726,7 +3761,6 @@ NRNamespaceInscopeCmd(
|
||||
{
|
||||
Tcl_Namespace *namespacePtr;
|
||||
CallFrame *framePtr, **framePtrPtr;
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
int i;
|
||||
Tcl_Obj *cmdObjPtr;
|
||||
|
||||
@@ -3752,14 +3786,7 @@ NRNamespaceInscopeCmd(
|
||||
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
|
||||
namespacePtr, /*isProcCallFrame*/ 0);
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
framePtr->objc = objc;
|
||||
framePtr->objv = objv;
|
||||
} else {
|
||||
framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
|
||||
}
|
||||
framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
|
||||
|
||||
/*
|
||||
* Execute the command. If there is just one argument, just treat it as a
|
||||
@@ -4511,8 +4538,8 @@ NamespaceUpvarCmd(
|
||||
savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
|
||||
iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
|
||||
otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
|
||||
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
|
||||
/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
|
||||
(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
|
||||
"access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
|
||||
iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
|
||||
if (otherPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
|
||||
+11
-14
@@ -68,12 +68,9 @@ static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
|
||||
static void DeletedDefineNamespace(ClientData clientData);
|
||||
static void DeletedObjdefNamespace(ClientData clientData);
|
||||
static void DeletedHelpersNamespace(ClientData clientData);
|
||||
static int FinalizeAlloc(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int FinalizeNext(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int FinalizeObjectCall(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc FinalizeAlloc;
|
||||
static Tcl_NRPostProc FinalizeNext;
|
||||
static Tcl_NRPostProc FinalizeObjectCall;
|
||||
static int InitFoundation(Tcl_Interp *interp);
|
||||
static void KillFoundation(ClientData clientData,
|
||||
Tcl_Interp *interp);
|
||||
@@ -1687,7 +1684,7 @@ Tcl_NewObjectInstance(
|
||||
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
|
||||
|
||||
if (contextPtr != NULL) {
|
||||
int result;
|
||||
int isRoot, result;
|
||||
Tcl_InterpState state;
|
||||
|
||||
state = Tcl_SaveInterpState(interp, TCL_OK);
|
||||
@@ -1698,13 +1695,14 @@ Tcl_NewObjectInstance(
|
||||
* Adjust the ensmble tracking record if necessary. [Bug 3514761]
|
||||
*/
|
||||
|
||||
if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
|
||||
((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
|
||||
((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
|
||||
}
|
||||
isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
|
||||
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
|
||||
objc, objv);
|
||||
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
|
||||
/*
|
||||
* It's an error if the object was whacked in the constructor.
|
||||
* Force this if it isn't already an error (don't want to lose
|
||||
@@ -1827,9 +1825,8 @@ TclNRNewObjectInstance(
|
||||
* Adjust the ensmble tracking record if necessary. [Bug 3514761]
|
||||
*/
|
||||
|
||||
if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
|
||||
((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
|
||||
((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
|
||||
if (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+1
-1
@@ -24,7 +24,7 @@
|
||||
* win/tclooConfig.sh
|
||||
*/
|
||||
|
||||
#define TCLOO_VERSION "1.0.4"
|
||||
#define TCLOO_VERSION "1.0.5"
|
||||
#define TCLOO_PATCHLEVEL TCLOO_VERSION
|
||||
|
||||
#include "tcl.h"
|
||||
|
||||
+3
-6
@@ -70,15 +70,12 @@ static void AddSimpleClassChainToCallContext(Class *classPtr,
|
||||
Class *const filterDecl);
|
||||
static int CmpStr(const void *ptr1, const void *ptr2);
|
||||
static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
|
||||
static int FinalizeMethodRefs(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc FinalizeMethodRefs;
|
||||
static void FreeMethodNameRep(Tcl_Obj *objPtr);
|
||||
static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
|
||||
int flags, int reuseMask);
|
||||
static int ResetFilterFlags(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int SetFilterFlags(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc ResetFilterFlags;
|
||||
static Tcl_NRPostProc SetFilterFlags;
|
||||
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
|
||||
|
||||
/*
|
||||
|
||||
+16
-42
@@ -847,9 +847,8 @@ TclOODefineObjCmd(
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Command cmd;
|
||||
int dummy;
|
||||
int isRoot, dummy;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
@@ -861,18 +860,7 @@ TclOODefineObjCmd(
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 3;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 1;
|
||||
} else {
|
||||
int ni = iPtr->ensembleRewrite.numInsertedObjs;
|
||||
if (ni < 3) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs -= 2;
|
||||
}
|
||||
}
|
||||
isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
@@ -894,6 +882,9 @@ TclOODefineObjCmd(
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
DelRef(oPtr);
|
||||
@@ -927,7 +918,7 @@ TclOOObjDefObjCmd(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
int result;
|
||||
int isRoot, result;
|
||||
Object *oPtr;
|
||||
|
||||
if (objc < 3) {
|
||||
@@ -962,7 +953,6 @@ TclOOObjDefObjCmd(
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Command cmd;
|
||||
int dummy;
|
||||
|
||||
@@ -976,18 +966,7 @@ TclOOObjDefObjCmd(
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 3;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 1;
|
||||
} else {
|
||||
int ni = iPtr->ensembleRewrite.numInsertedObjs;
|
||||
if (ni < 3) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs -= 2;
|
||||
}
|
||||
}
|
||||
isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
@@ -1009,6 +988,10 @@ TclOOObjDefObjCmd(
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
|
||||
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
DelRef(oPtr);
|
||||
@@ -1077,9 +1060,8 @@ TclOODefineSelfObjCmd(
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_Command cmd;
|
||||
int dummy;
|
||||
int isRoot, dummy;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
@@ -1091,18 +1073,7 @@ TclOODefineSelfObjCmd(
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 2;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 1;
|
||||
} else {
|
||||
int ni = iPtr->ensembleRewrite.numInsertedObjs;
|
||||
if (ni < 2) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs -= 1;
|
||||
}
|
||||
}
|
||||
isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
@@ -1124,6 +1095,9 @@ TclOODefineSelfObjCmd(
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
DelRef(oPtr);
|
||||
|
||||
+10
-23
@@ -70,10 +70,8 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
|
||||
static int InvokeProcedureMethod(ClientData clientData,
|
||||
Tcl_Interp *interp, Tcl_ObjectContext context,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
static int FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static int FinalizePMCall(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static Tcl_NRPostProc FinalizeForwardCall;
|
||||
static Tcl_NRPostProc FinalizePMCall;
|
||||
static int PushMethodCallFrame(Tcl_Interp *interp,
|
||||
CallContext *contextPtr, ProcedureMethod *pmPtr,
|
||||
int objc, Tcl_Obj *const *objv,
|
||||
@@ -1458,6 +1456,11 @@ InvokeForwardMethod(
|
||||
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
|
||||
numPrefixes, prefixObjs, &len);
|
||||
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
|
||||
/*
|
||||
* NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
|
||||
* of the TCL_EVAL_NOERR flag results in an evaluation configuration
|
||||
* very much like TCL_EVAL_INVOKE.
|
||||
*/
|
||||
((Interp *)interp)->lookupNsPtr
|
||||
= (Namespace *) contextPtr->oPtr->namespacePtr;
|
||||
return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
|
||||
@@ -1594,12 +1597,9 @@ InitEnsembleRewrite(
|
||||
int *lengthPtr) /* Where to write the resulting length of the
|
||||
* array of rewritten arguments. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
|
||||
Tcl_Obj **argObjs;
|
||||
unsigned len = rewriteLength + objc - toRewrite;
|
||||
Tcl_Obj **argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
|
||||
|
||||
argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
|
||||
memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
|
||||
memcpy(argObjs + rewriteLength, objv + toRewrite,
|
||||
sizeof(Tcl_Obj *) * (objc - toRewrite));
|
||||
@@ -1613,22 +1613,9 @@ InitEnsembleRewrite(
|
||||
* (and unavoidably).
|
||||
*/
|
||||
|
||||
if (isRootEnsemble) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = toRewrite;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = rewriteLength;
|
||||
} else {
|
||||
int numIns = iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
if (numIns < toRewrite) {
|
||||
iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns;
|
||||
iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs +=
|
||||
rewriteLength - toRewrite;
|
||||
}
|
||||
if (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) {
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
|
||||
}
|
||||
|
||||
*lengthPtr = len;
|
||||
return argObjs;
|
||||
}
|
||||
|
||||
@@ -869,12 +869,16 @@ TclJoinPath(
|
||||
* object which can be normalized more efficiently. Currently we only
|
||||
* use the special case when we have exactly two elements, but we
|
||||
* could expand that in the future.
|
||||
*
|
||||
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
|
||||
* to be an absolute path. Added a check for that elt is absolute.
|
||||
*/
|
||||
|
||||
if ((i == (elements-2)) && (i == 0)
|
||||
&& (elt->typePtr == &tclFsPathType)
|
||||
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {
|
||||
Tcl_Obj *tailObj = objv[i+1];
|
||||
&& (elt->typePtr == &tclFsPathType)
|
||||
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
|
||||
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
|
||||
Tcl_Obj *tailObj = objv[i+1];
|
||||
|
||||
type = TclGetPathType(tailObj, NULL, NULL, NULL);
|
||||
if (type == TCL_PATH_RELATIVE) {
|
||||
|
||||
+7
-20
@@ -22,7 +22,6 @@
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
int isRootEnsemble;
|
||||
Command cmd;
|
||||
ExtraFrameInfo efi;
|
||||
} ApplyExtraData;
|
||||
@@ -870,7 +869,7 @@ TclObjGetFrame(
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@@ -1088,12 +1087,10 @@ ProcWrongNumArgs(
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
|
||||
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
|
||||
} else {
|
||||
((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
|
||||
|
||||
#ifdef AVOID_HACKS_FOR_ITCL
|
||||
desiredObjs[0] = framePtr->objv[skip-1];
|
||||
#else
|
||||
desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
|
||||
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
|
||||
#endif /* AVOID_HACKS_FOR_ITCL */
|
||||
}
|
||||
Tcl_IncrRefCount(desiredObjs[0]);
|
||||
@@ -1528,6 +1525,10 @@ InitArgsAndLocals(
|
||||
*/
|
||||
|
||||
incorrectArgs:
|
||||
if ((skip != 1) &&
|
||||
TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
|
||||
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
|
||||
}
|
||||
memset(varPtr, 0,
|
||||
((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
|
||||
return ProcWrongNumArgs(interp, skip);
|
||||
@@ -2634,7 +2635,7 @@ TclNRApplyObjCmd(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Proc *procPtr = NULL;
|
||||
Tcl_Obj *lambdaPtr, *nsObjPtr;
|
||||
int result, isRootEnsemble;
|
||||
int result;
|
||||
Tcl_Namespace *nsPtr;
|
||||
ApplyExtraData *extraPtr;
|
||||
|
||||
@@ -2717,16 +2718,6 @@ TclNRApplyObjCmd(
|
||||
extraPtr->efi.fields[0].clientData = lambdaPtr;
|
||||
extraPtr->cmd.clientData = &extraPtr->efi;
|
||||
|
||||
isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
|
||||
if (isRootEnsemble) {
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = 1;
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
} else {
|
||||
iPtr->ensembleRewrite.numInsertedObjs -= 1;
|
||||
}
|
||||
extraPtr->isRootEnsemble = isRootEnsemble;
|
||||
|
||||
result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
|
||||
if (result == TCL_OK) {
|
||||
TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
|
||||
@@ -2743,10 +2734,6 @@ ApplyNR2(
|
||||
{
|
||||
ApplyExtraData *extraPtr = data[0];
|
||||
|
||||
if (extraPtr->isRootEnsemble) {
|
||||
((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
|
||||
}
|
||||
|
||||
TclStackFree(interp, extraPtr);
|
||||
return result;
|
||||
}
|
||||
|
||||
+1
-2
@@ -413,8 +413,7 @@ static int TestHashSystemHashCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
|
||||
static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
|
||||
int result);
|
||||
static Tcl_NRPostProc NREUnwind_callback;
|
||||
static int TestNREUnwind(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
|
||||
@@ -19,6 +19,7 @@
|
||||
#endif
|
||||
#include "tclInt.h"
|
||||
#include "tommath.h"
|
||||
#include "tclStringRep.h"
|
||||
|
||||
|
||||
/*
|
||||
@@ -46,13 +47,6 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
typedef struct TestString {
|
||||
int numChars;
|
||||
int allocated;
|
||||
int maxChars;
|
||||
Tcl_UniChar unicode[2];
|
||||
} TestString;
|
||||
|
||||
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
|
||||
#define NUMBER_OF_OBJECT_VARS 20
|
||||
@@ -1141,7 +1135,7 @@ TeststringobjCmd(
|
||||
int varIndex, option, i, length;
|
||||
#define MAX_STRINGS 11
|
||||
const char *index, *string, *strings[MAX_STRINGS+1];
|
||||
TestString *strPtr;
|
||||
String *strPtr;
|
||||
Tcl_Obj **varPtr;
|
||||
static const char *const options[] = {
|
||||
"append", "appendstrings", "get", "get2", "length", "length2",
|
||||
|
||||
+934
-883
File diff suppressed because it is too large
Load Diff
@@ -2634,7 +2634,19 @@ Tcl_DStringAppend(
|
||||
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
|
||||
dsPtr->string = newString;
|
||||
} else {
|
||||
int offset = -1;
|
||||
|
||||
/* See [16896d49fd] */
|
||||
if (bytes >= dsPtr->string
|
||||
&& bytes <= dsPtr->string + dsPtr->length) {
|
||||
offset = bytes - dsPtr->string;
|
||||
}
|
||||
|
||||
dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
|
||||
|
||||
if (offset >= 0) {
|
||||
bytes = dsPtr->string + offset;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2725,7 +2737,19 @@ Tcl_DStringAppendElement(
|
||||
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
|
||||
dsPtr->string = newString;
|
||||
} else {
|
||||
int offset = -1;
|
||||
|
||||
/* See [16896d49fd] */
|
||||
if (element >= dsPtr->string
|
||||
&& element <= dsPtr->string + dsPtr->length) {
|
||||
offset = element - dsPtr->string;
|
||||
}
|
||||
|
||||
dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
|
||||
|
||||
if (offset >= 0) {
|
||||
element = dsPtr->string + offset;
|
||||
}
|
||||
}
|
||||
dst = dsPtr->string + dsPtr->length;
|
||||
}
|
||||
|
||||
+23
-39
@@ -219,10 +219,6 @@ static Tcl_SetFromAnyProc PanicOnSetVarName;
|
||||
* or NULL if it is this same obj
|
||||
* twoPtrValue.ptr2: index into locals table
|
||||
*
|
||||
* nsVarName - INTERNALREP DEFINITION:
|
||||
* twoPtrValue.ptr1: pointer to the namespace containing the reference
|
||||
* twoPtrValue.ptr2: pointer to the corresponding Var
|
||||
*
|
||||
* parsedVarName - INTERNALREP DEFINITION:
|
||||
* twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a
|
||||
* scalar variable
|
||||
@@ -741,21 +737,6 @@ TclObjLookupVarEx(
|
||||
return varPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
* This flag bit should not interfere with TCL_GLOBAL_ONLY,
|
||||
* TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
|
||||
* lookup is performed for upvar (or similar) purposes, with slightly
|
||||
* different rules:
|
||||
* - Bug #696893 - variable is either proc-local or in the current
|
||||
* namespace; never follow the second (global) resolution path
|
||||
* - Bug #631741 - do not use special namespace or interp resolvers
|
||||
*
|
||||
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
|
||||
* (Bug #835020)
|
||||
*/
|
||||
|
||||
#define AVOID_RESOLVERS 0x40000
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -805,8 +786,8 @@ TclLookupSimpleVar(
|
||||
Tcl_Obj *varNamePtr, /* This is a simple variable name that could
|
||||
* represent a scalar or an array. */
|
||||
int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
|
||||
* AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
|
||||
* matter. */
|
||||
* TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
|
||||
* bits matter. */
|
||||
const int create, /* If 1, create hash table entry for varname,
|
||||
* if it doesn't already exist. If 0, return
|
||||
* error if it doesn't exist. */
|
||||
@@ -846,7 +827,7 @@ TclLookupSimpleVar(
|
||||
*/
|
||||
|
||||
if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
|
||||
&& !(flags & AVOID_RESOLVERS)) {
|
||||
&& !(flags & TCL_AVOID_RESOLVERS)) {
|
||||
resPtr = iPtr->resolverPtr;
|
||||
if (cxtNsPtr->varResProc) {
|
||||
result = cxtNsPtr->varResProc(interp, varName,
|
||||
@@ -899,7 +880,7 @@ TclLookupSimpleVar(
|
||||
*indexPtr = -1;
|
||||
flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
|
||||
} else {
|
||||
if (flags & AVOID_RESOLVERS) {
|
||||
if (flags & TCL_AVOID_RESOLVERS) {
|
||||
flags = (flags | TCL_NAMESPACE_ONLY);
|
||||
}
|
||||
if (flags & TCL_NAMESPACE_ONLY) {
|
||||
@@ -914,7 +895,7 @@ TclLookupSimpleVar(
|
||||
|
||||
varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
|
||||
(Tcl_Namespace *) cxtNsPtr,
|
||||
(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
|
||||
(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
|
||||
if (varPtr == NULL) {
|
||||
Tcl_Obj *tailPtr;
|
||||
|
||||
@@ -4396,15 +4377,15 @@ TclPtrObjMakeUpvar(
|
||||
|
||||
/*
|
||||
* Lookup and eventually create the new variable. Set the flag bit
|
||||
* AVOID_RESOLVERS to indicate the special resolution rules for upvar
|
||||
* purposes:
|
||||
* TCL_AVOID_RESOLVERS to indicate the special resolution rules for
|
||||
* upvar purposes:
|
||||
* - Bug #696893 - variable is either proc-local or in the current
|
||||
* namespace; never follow the second (global) resolution path.
|
||||
* - Bug #631741 - do not use special namespace or interp resolvers.
|
||||
*/
|
||||
|
||||
varPtr = TclLookupSimpleVar(interp, myNamePtr,
|
||||
myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
|
||||
myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
|
||||
if (varPtr == NULL) {
|
||||
TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
|
||||
@@ -4938,7 +4919,8 @@ Tcl_UpvarObjCmd(
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad level \"%s\"", TclGetString(levelObj)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
|
||||
TclGetString(levelObj), NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -5694,11 +5676,12 @@ Tcl_FindNamespaceVar(
|
||||
* Otherwise, points to namespace in which to
|
||||
* resolve name. If NULL, look up name in the
|
||||
* current namespace. */
|
||||
int flags) /* An OR'd combination of: AVOID_RESOLVERS,
|
||||
* TCL_GLOBAL_ONLY (look up name only in
|
||||
* global namespace), TCL_NAMESPACE_ONLY (look
|
||||
* up only in contextNsPtr, or the current
|
||||
* namespace if contextNsPtr is NULL), and
|
||||
int flags) /* An OR'd combination of:
|
||||
* TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
|
||||
* up name only in global namespace),
|
||||
* TCL_NAMESPACE_ONLY (look up only in
|
||||
* contextNsPtr, or the current namespace if
|
||||
* contextNsPtr is NULL), and
|
||||
* TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
|
||||
* and TCL_NAMESPACE_ONLY are given,
|
||||
* TCL_GLOBAL_ONLY is ignored. */
|
||||
@@ -5724,11 +5707,12 @@ ObjFindNamespaceVar(
|
||||
* Otherwise, points to namespace in which to
|
||||
* resolve name. If NULL, look up name in the
|
||||
* current namespace. */
|
||||
int flags) /* An OR'd combination of: AVOID_RESOLVERS,
|
||||
* TCL_GLOBAL_ONLY (look up name only in
|
||||
* global namespace), TCL_NAMESPACE_ONLY (look
|
||||
* up only in contextNsPtr, or the current
|
||||
* namespace if contextNsPtr is NULL), and
|
||||
int flags) /* An OR'd combination of:
|
||||
* TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
|
||||
* up name only in global namespace),
|
||||
* TCL_NAMESPACE_ONLY (look up only in
|
||||
* contextNsPtr, or the current namespace if
|
||||
* contextNsPtr is NULL), and
|
||||
* TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
|
||||
* and TCL_NAMESPACE_ONLY are given,
|
||||
* TCL_GLOBAL_ONLY is ignored. */
|
||||
@@ -5758,7 +5742,7 @@ ObjFindNamespaceVar(
|
||||
cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
}
|
||||
|
||||
if (!(flags & AVOID_RESOLVERS) &&
|
||||
if (!(flags & TCL_AVOID_RESOLVERS) &&
|
||||
(cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
|
||||
resPtr = iPtr->resolverPtr;
|
||||
|
||||
|
||||
+15
-21
@@ -2906,9 +2906,9 @@ ZlibTransformClose(
|
||||
}
|
||||
}
|
||||
} while (e != Z_STREAM_END);
|
||||
e = deflateEnd(&cd->outStream);
|
||||
(void) deflateEnd(&cd->outStream);
|
||||
} else {
|
||||
e = inflateEnd(&cd->inStream);
|
||||
(void) inflateEnd(&cd->inStream);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3344,10 +3344,13 @@ ZlibTransformGetOption(
|
||||
Tcl_DStringAppendElement(dsPtr, "");
|
||||
}
|
||||
} else {
|
||||
int len;
|
||||
const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
|
||||
if (cd->compDictObj) {
|
||||
int len;
|
||||
const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
|
||||
|
||||
Tcl_DStringAppend(dsPtr, str, len);
|
||||
Tcl_DStringAppend(dsPtr, str, len);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3549,7 +3552,6 @@ ZlibStackChannelTransform(
|
||||
ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
|
||||
Tcl_Channel chan;
|
||||
int wbits = 0;
|
||||
int e;
|
||||
|
||||
if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
|
||||
Tcl_Panic("unknown mode: %d", mode);
|
||||
@@ -3603,43 +3605,35 @@ ZlibStackChannelTransform(
|
||||
*/
|
||||
|
||||
if (mode == TCL_ZLIB_STREAM_INFLATE) {
|
||||
e = inflateInit2(&cd->inStream, wbits);
|
||||
if (e != Z_OK) {
|
||||
if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
cd->inAllocated = DEFAULT_BUFFER_SIZE;
|
||||
cd->inBuffer = ckalloc(cd->inAllocated);
|
||||
if (cd->flags & IN_HEADER) {
|
||||
e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
|
||||
if (e != Z_OK) {
|
||||
if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
|
||||
e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
|
||||
if (e != Z_OK) {
|
||||
if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
TclDecrRefCount(cd->compDictObj);
|
||||
cd->compDictObj = NULL;
|
||||
}
|
||||
} else {
|
||||
e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
|
||||
MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
|
||||
if (e != Z_OK) {
|
||||
if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
|
||||
MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
cd->outAllocated = DEFAULT_BUFFER_SIZE;
|
||||
cd->outBuffer = ckalloc(cd->outAllocated);
|
||||
if (cd->flags & OUT_HEADER) {
|
||||
e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
|
||||
if (e != Z_OK) {
|
||||
if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
if (cd->compDictObj) {
|
||||
e = SetDeflateDictionary(&cd->outStream, cd->compDictObj);
|
||||
if (e != Z_OK) {
|
||||
if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
|
||||
+1
-1
@@ -16,7 +16,7 @@
|
||||
if {[info commands package] == ""} {
|
||||
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
|
||||
}
|
||||
package require -exact Tcl 8.6.5
|
||||
package require -exact Tcl 8.6.6
|
||||
|
||||
# Compute the auto path to use in this interpreter.
|
||||
# The values on the path come from several locations:
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
if {([info commands ::tcl::pkgconfig] eq "")
|
||||
|| ([info sharedlibextension] ne ".dll")} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded registry 1.3.1 \
|
||||
package ifneeded registry 1.3.2 \
|
||||
[list load [file join $dir tclreg13g.dll] registry]
|
||||
} else {
|
||||
package ifneeded registry 1.3.1 \
|
||||
package ifneeded registry 1.3.2 \
|
||||
[list load [file join $dir tclreg13.dll] registry]
|
||||
}
|
||||
|
||||
@@ -9,4 +9,4 @@
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
package ifneeded tcltest 2.3.8 [list source [file join $dir tcltest.tcl]]
|
||||
package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]
|
||||
|
||||
@@ -22,7 +22,7 @@ namespace eval tcltest {
|
||||
# When the version number changes, be sure to update the pkgIndex.tcl file,
|
||||
# and the install directory in the Makefiles. When the minor version
|
||||
# changes (new feature) be sure to update the man page as well.
|
||||
variable Version 2.3.8
|
||||
variable Version 2.4.0
|
||||
|
||||
# Compatibility support for dumb variables defined in tcltest 1
|
||||
# Do not use these. Call [package provide Tcl] and [info patchlevel]
|
||||
@@ -611,16 +611,27 @@ namespace eval tcltest {
|
||||
|
||||
proc AcceptVerbose { level } {
|
||||
set level [AcceptList $level]
|
||||
set levelMap {
|
||||
l list
|
||||
p pass
|
||||
b body
|
||||
s skip
|
||||
t start
|
||||
e error
|
||||
l line
|
||||
m msec
|
||||
u usec
|
||||
}
|
||||
set levelRegexp "^([join [dict values $levelMap] |])\$"
|
||||
if {[llength $level] == 1} {
|
||||
if {![regexp {^(pass|body|skip|start|error|line)$} $level]} {
|
||||
if {![regexp $levelRegexp $level]} {
|
||||
# translate single characters abbreviations to expanded list
|
||||
set level [string map {p pass b body s skip t start e error l line} \
|
||||
[split $level {}]]
|
||||
set level [string map $levelMap [split $level {}]]
|
||||
}
|
||||
}
|
||||
set valid [list]
|
||||
foreach v $level {
|
||||
if {[regexp {^(pass|body|skip|start|error|line)$} $v]} {
|
||||
if {[regexp $levelRegexp $v]} {
|
||||
lappend valid $v
|
||||
}
|
||||
}
|
||||
@@ -1972,6 +1983,11 @@ proc tcltest::test {name description args} {
|
||||
# Only run the test body if the setup was successful
|
||||
if {!$setupFailure} {
|
||||
|
||||
# Register startup time
|
||||
if {[IsVerbose msec] || [IsVerbose usec]} {
|
||||
set timeStart [clock microseconds]
|
||||
}
|
||||
|
||||
# Verbose notification of $body start
|
||||
if {[IsVerbose start]} {
|
||||
puts [outputChannel] "---- $name start"
|
||||
@@ -2076,6 +2092,16 @@ proc tcltest::test {name description args} {
|
||||
}
|
||||
}
|
||||
|
||||
if {[IsVerbose msec] || [IsVerbose usec]} {
|
||||
set t [expr {[clock microseconds] - $timeStart}]
|
||||
if {[IsVerbose usec]} {
|
||||
puts [outputChannel] "++++ $name took $t μs"
|
||||
}
|
||||
if {[IsVerbose msec]} {
|
||||
puts [outputChannel] "++++ $name took [expr {round($t/1000.)}] ms"
|
||||
}
|
||||
}
|
||||
|
||||
# if we didn't experience any failures, then we passed
|
||||
variable numTests
|
||||
if {!($setupFailure || $cleanupFailure || $coreFailure
|
||||
@@ -2683,7 +2709,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
|
||||
DebugPuts 1 "No test directories remain after applying match\
|
||||
and skip patterns!"
|
||||
}
|
||||
return $matchDirs
|
||||
return [lsort $matchDirs]
|
||||
}
|
||||
|
||||
# tcltest::runAllTests --
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Cambridge_Bay) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-1577923200 -25200 0 MST}
|
||||
{-880210800 -21600 1 MWT}
|
||||
{-769395600 -21600 1 MPT}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Inuvik) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-536457600 -28800 0 PST}
|
||||
{-147888000 -21600 1 PDDT}
|
||||
{-131558400 -28800 0 PST}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Iqaluit) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-865296000 -14400 0 EWT}
|
||||
{-769395600 -14400 1 EPT}
|
||||
{-765396000 -18000 0 EST}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Pangnirtung) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-1546300800 -14400 0 AST}
|
||||
{-880221600 -10800 1 AWT}
|
||||
{-769395600 -10800 1 APT}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Rankin_Inlet) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-410227200 -21600 0 CST}
|
||||
{-147895200 -14400 1 CDDT}
|
||||
{-131565600 -21600 0 CST}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Resolute) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-704937600 -21600 0 CST}
|
||||
{-147895200 -14400 1 CDDT}
|
||||
{-131565600 -21600 0 CST}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:America/Yellowknife) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-1104537600 -25200 0 MST}
|
||||
{-880210800 -21600 1 MWT}
|
||||
{-769395600 -21600 1 MPT}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Casey) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-31536000 28800 0 AWST}
|
||||
{1255802400 39600 0 CAST}
|
||||
{1267714800 28800 0 AWST}
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Davis) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-409190400 25200 0 DAVT}
|
||||
{-163062000 0 0 zzz}
|
||||
{-163062000 0 0 -00}
|
||||
{-28857600 25200 0 DAVT}
|
||||
{1255806000 18000 0 DAVT}
|
||||
{1268251200 25200 0 DAVT}
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/DumontDUrville) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-725846400 36000 0 PMT}
|
||||
{-566992800 0 0 zzz}
|
||||
{-566992800 0 0 -00}
|
||||
{-415497600 36000 0 DDUT}
|
||||
}
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Macquarie) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-2214259200 36000 0 AEST}
|
||||
{-1680508800 39600 1 AEDT}
|
||||
{-1669892400 39600 0 AEDT}
|
||||
{-1665392400 36000 0 AEST}
|
||||
{-1601719200 0 0 zzz}
|
||||
{-1601719200 0 0 -00}
|
||||
{-94730400 36000 0 AEST}
|
||||
{-71136000 39600 1 AEDT}
|
||||
{-55411200 36000 0 AEST}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Mawson) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-501206400 21600 0 MAWT}
|
||||
{1255809600 18000 0 MAWT}
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Palmer) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-157766400 -14400 0 ART}
|
||||
{-152654400 -14400 0 ART}
|
||||
{-132955200 -10800 1 ARST}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Rothera) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{218246400 -10800 0 ROTT}
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Syowa) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-407808000 10800 0 SYOT}
|
||||
}
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Troll) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{1108166400 0 0 UTC}
|
||||
{1111885200 7200 1 CEST}
|
||||
{1130634000 0 0 UTC}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Antarctica/Vostok) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-380073600 21600 0 VOST}
|
||||
}
|
||||
|
||||
@@ -28,7 +28,7 @@ set TZData(:Asia/Baku) {
|
||||
{683496000 14400 0 AZST}
|
||||
{686098800 10800 0 AZT}
|
||||
{701823600 14400 1 AZST}
|
||||
{717537600 14400 0 AZT}
|
||||
{717548400 14400 0 AZT}
|
||||
{820440000 14400 0 AZT}
|
||||
{828234000 18000 1 AZST}
|
||||
{846378000 14400 0 AZT}
|
||||
|
||||
@@ -2,71 +2,70 @@
|
||||
|
||||
set TZData(:Asia/Novokuznetsk) {
|
||||
{-9223372036854775808 20928 0 LMT}
|
||||
{-1441259328 21600 0 KRAT}
|
||||
{-1247551200 25200 0 KRAMMTT}
|
||||
{354906000 28800 1 KRAST}
|
||||
{370713600 25200 0 KRAT}
|
||||
{386442000 28800 1 KRAST}
|
||||
{402249600 25200 0 KRAT}
|
||||
{417978000 28800 1 KRAST}
|
||||
{433785600 25200 0 KRAT}
|
||||
{449600400 28800 1 KRAST}
|
||||
{465332400 25200 0 KRAT}
|
||||
{481057200 28800 1 KRAST}
|
||||
{496782000 25200 0 KRAT}
|
||||
{512506800 28800 1 KRAST}
|
||||
{528231600 25200 0 KRAT}
|
||||
{543956400 28800 1 KRAST}
|
||||
{559681200 25200 0 KRAT}
|
||||
{575406000 28800 1 KRAST}
|
||||
{591130800 25200 0 KRAT}
|
||||
{606855600 28800 1 KRAST}
|
||||
{622580400 25200 0 KRAT}
|
||||
{638305200 28800 1 KRAST}
|
||||
{654634800 25200 0 KRAT}
|
||||
{670359600 21600 0 KRAMMTT}
|
||||
{670363200 25200 1 KRAST}
|
||||
{686088000 21600 0 KRAT}
|
||||
{695764800 25200 0 KRAMMTT}
|
||||
{701809200 28800 1 KRAST}
|
||||
{717534000 25200 0 KRAT}
|
||||
{733258800 28800 1 KRAST}
|
||||
{748983600 25200 0 KRAT}
|
||||
{764708400 28800 1 KRAST}
|
||||
{780433200 25200 0 KRAT}
|
||||
{796158000 28800 1 KRAST}
|
||||
{811882800 25200 0 KRAT}
|
||||
{828212400 28800 1 KRAST}
|
||||
{846356400 25200 0 KRAT}
|
||||
{859662000 28800 1 KRAST}
|
||||
{877806000 25200 0 KRAT}
|
||||
{891111600 28800 1 KRAST}
|
||||
{909255600 25200 0 KRAT}
|
||||
{922561200 28800 1 KRAST}
|
||||
{941310000 25200 0 KRAT}
|
||||
{954010800 28800 1 KRAST}
|
||||
{972759600 25200 0 KRAT}
|
||||
{985460400 28800 1 KRAST}
|
||||
{1004209200 25200 0 KRAT}
|
||||
{1017514800 28800 1 KRAST}
|
||||
{1035658800 25200 0 KRAT}
|
||||
{1048964400 28800 1 KRAST}
|
||||
{1067108400 25200 0 KRAT}
|
||||
{1080414000 28800 1 KRAST}
|
||||
{1099162800 25200 0 KRAT}
|
||||
{1111863600 28800 1 KRAST}
|
||||
{1130612400 25200 0 KRAT}
|
||||
{1143313200 28800 1 KRAST}
|
||||
{1162062000 25200 0 KRAT}
|
||||
{1174762800 28800 1 KRAST}
|
||||
{1193511600 25200 0 KRAT}
|
||||
{1206817200 28800 1 KRAST}
|
||||
{1224961200 25200 0 KRAT}
|
||||
{1238266800 28800 1 KRAST}
|
||||
{1256410800 25200 0 KRAT}
|
||||
{1269716400 21600 0 NOVMMTT}
|
||||
{1269720000 25200 1 NOVST}
|
||||
{1288468800 21600 0 NOVT}
|
||||
{1301169600 25200 0 NOVT}
|
||||
{1414263600 25200 0 KRAT}
|
||||
{-1441259328 21600 0 +06}
|
||||
{-1247551200 25200 0 +08}
|
||||
{354906000 28800 1 +08}
|
||||
{370713600 25200 0 +07}
|
||||
{386442000 28800 1 +08}
|
||||
{402249600 25200 0 +07}
|
||||
{417978000 28800 1 +08}
|
||||
{433785600 25200 0 +07}
|
||||
{449600400 28800 1 +08}
|
||||
{465332400 25200 0 +07}
|
||||
{481057200 28800 1 +08}
|
||||
{496782000 25200 0 +07}
|
||||
{512506800 28800 1 +08}
|
||||
{528231600 25200 0 +07}
|
||||
{543956400 28800 1 +08}
|
||||
{559681200 25200 0 +07}
|
||||
{575406000 28800 1 +08}
|
||||
{591130800 25200 0 +07}
|
||||
{606855600 28800 1 +08}
|
||||
{622580400 25200 0 +07}
|
||||
{638305200 28800 1 +08}
|
||||
{654634800 25200 0 +07}
|
||||
{670359600 21600 0 +07}
|
||||
{670363200 25200 1 +07}
|
||||
{686088000 21600 0 +06}
|
||||
{695764800 25200 0 +08}
|
||||
{701809200 28800 1 +08}
|
||||
{717534000 25200 0 +07}
|
||||
{733258800 28800 1 +08}
|
||||
{748983600 25200 0 +07}
|
||||
{764708400 28800 1 +08}
|
||||
{780433200 25200 0 +07}
|
||||
{796158000 28800 1 +08}
|
||||
{811882800 25200 0 +07}
|
||||
{828212400 28800 1 +08}
|
||||
{846356400 25200 0 +07}
|
||||
{859662000 28800 1 +08}
|
||||
{877806000 25200 0 +07}
|
||||
{891111600 28800 1 +08}
|
||||
{909255600 25200 0 +07}
|
||||
{922561200 28800 1 +08}
|
||||
{941310000 25200 0 +07}
|
||||
{954010800 28800 1 +08}
|
||||
{972759600 25200 0 +07}
|
||||
{985460400 28800 1 +08}
|
||||
{1004209200 25200 0 +07}
|
||||
{1017514800 28800 1 +08}
|
||||
{1035658800 25200 0 +07}
|
||||
{1048964400 28800 1 +08}
|
||||
{1067108400 25200 0 +07}
|
||||
{1080414000 28800 1 +08}
|
||||
{1099162800 25200 0 +07}
|
||||
{1111863600 28800 1 +08}
|
||||
{1130612400 25200 0 +07}
|
||||
{1143313200 28800 1 +08}
|
||||
{1162062000 25200 0 +07}
|
||||
{1174762800 28800 1 +08}
|
||||
{1193511600 25200 0 +07}
|
||||
{1206817200 28800 1 +08}
|
||||
{1224961200 25200 0 +07}
|
||||
{1238266800 28800 1 +08}
|
||||
{1256410800 25200 0 +07}
|
||||
{1269716400 21600 0 +07}
|
||||
{1269720000 25200 1 +07}
|
||||
{1288468800 21600 0 +06}
|
||||
{1301169600 25200 0 +07}
|
||||
}
|
||||
|
||||
@@ -2,71 +2,72 @@
|
||||
|
||||
set TZData(:Asia/Novosibirsk) {
|
||||
{-9223372036854775808 19900 0 LMT}
|
||||
{-1579476700 21600 0 NOVT}
|
||||
{-1247551200 25200 0 NOVMMTT}
|
||||
{354906000 28800 1 NOVST}
|
||||
{370713600 25200 0 NOVT}
|
||||
{386442000 28800 1 NOVST}
|
||||
{402249600 25200 0 NOVT}
|
||||
{417978000 28800 1 NOVST}
|
||||
{433785600 25200 0 NOVT}
|
||||
{449600400 28800 1 NOVST}
|
||||
{465332400 25200 0 NOVT}
|
||||
{481057200 28800 1 NOVST}
|
||||
{496782000 25200 0 NOVT}
|
||||
{512506800 28800 1 NOVST}
|
||||
{528231600 25200 0 NOVT}
|
||||
{543956400 28800 1 NOVST}
|
||||
{559681200 25200 0 NOVT}
|
||||
{575406000 28800 1 NOVST}
|
||||
{591130800 25200 0 NOVT}
|
||||
{606855600 28800 1 NOVST}
|
||||
{622580400 25200 0 NOVT}
|
||||
{638305200 28800 1 NOVST}
|
||||
{654634800 25200 0 NOVT}
|
||||
{670359600 21600 0 NOVMMTT}
|
||||
{670363200 25200 1 NOVST}
|
||||
{686088000 21600 0 NOVT}
|
||||
{695764800 25200 0 NOVMMTT}
|
||||
{701809200 28800 1 NOVST}
|
||||
{717534000 25200 0 NOVT}
|
||||
{733258800 28800 1 NOVST}
|
||||
{738090000 25200 0 NOVST}
|
||||
{748987200 21600 0 NOVT}
|
||||
{764712000 25200 1 NOVST}
|
||||
{780436800 21600 0 NOVT}
|
||||
{796161600 25200 1 NOVST}
|
||||
{811886400 21600 0 NOVT}
|
||||
{828216000 25200 1 NOVST}
|
||||
{846360000 21600 0 NOVT}
|
||||
{859665600 25200 1 NOVST}
|
||||
{877809600 21600 0 NOVT}
|
||||
{891115200 25200 1 NOVST}
|
||||
{909259200 21600 0 NOVT}
|
||||
{922564800 25200 1 NOVST}
|
||||
{941313600 21600 0 NOVT}
|
||||
{954014400 25200 1 NOVST}
|
||||
{972763200 21600 0 NOVT}
|
||||
{985464000 25200 1 NOVST}
|
||||
{1004212800 21600 0 NOVT}
|
||||
{1017518400 25200 1 NOVST}
|
||||
{1035662400 21600 0 NOVT}
|
||||
{1048968000 25200 1 NOVST}
|
||||
{1067112000 21600 0 NOVT}
|
||||
{1080417600 25200 1 NOVST}
|
||||
{1099166400 21600 0 NOVT}
|
||||
{1111867200 25200 1 NOVST}
|
||||
{1130616000 21600 0 NOVT}
|
||||
{1143316800 25200 1 NOVST}
|
||||
{1162065600 21600 0 NOVT}
|
||||
{1174766400 25200 1 NOVST}
|
||||
{1193515200 21600 0 NOVT}
|
||||
{1206820800 25200 1 NOVST}
|
||||
{1224964800 21600 0 NOVT}
|
||||
{1238270400 25200 1 NOVST}
|
||||
{1256414400 21600 0 NOVT}
|
||||
{1269720000 25200 1 NOVST}
|
||||
{1288468800 21600 0 NOVT}
|
||||
{1301169600 25200 0 NOVT}
|
||||
{1414263600 21600 0 NOVT}
|
||||
{-1579476700 21600 0 +06}
|
||||
{-1247551200 25200 0 +08}
|
||||
{354906000 28800 1 +08}
|
||||
{370713600 25200 0 +07}
|
||||
{386442000 28800 1 +08}
|
||||
{402249600 25200 0 +07}
|
||||
{417978000 28800 1 +08}
|
||||
{433785600 25200 0 +07}
|
||||
{449600400 28800 1 +08}
|
||||
{465332400 25200 0 +07}
|
||||
{481057200 28800 1 +08}
|
||||
{496782000 25200 0 +07}
|
||||
{512506800 28800 1 +08}
|
||||
{528231600 25200 0 +07}
|
||||
{543956400 28800 1 +08}
|
||||
{559681200 25200 0 +07}
|
||||
{575406000 28800 1 +08}
|
||||
{591130800 25200 0 +07}
|
||||
{606855600 28800 1 +08}
|
||||
{622580400 25200 0 +07}
|
||||
{638305200 28800 1 +08}
|
||||
{654634800 25200 0 +07}
|
||||
{670359600 21600 0 +07}
|
||||
{670363200 25200 1 +07}
|
||||
{686088000 21600 0 +06}
|
||||
{695764800 25200 0 +08}
|
||||
{701809200 28800 1 +08}
|
||||
{717534000 25200 0 +07}
|
||||
{733258800 28800 1 +08}
|
||||
{738090000 25200 0 +07}
|
||||
{748987200 21600 0 +06}
|
||||
{764712000 25200 1 +07}
|
||||
{780436800 21600 0 +06}
|
||||
{796161600 25200 1 +07}
|
||||
{811886400 21600 0 +06}
|
||||
{828216000 25200 1 +07}
|
||||
{846360000 21600 0 +06}
|
||||
{859665600 25200 1 +07}
|
||||
{877809600 21600 0 +06}
|
||||
{891115200 25200 1 +07}
|
||||
{909259200 21600 0 +06}
|
||||
{922564800 25200 1 +07}
|
||||
{941313600 21600 0 +06}
|
||||
{954014400 25200 1 +07}
|
||||
{972763200 21600 0 +06}
|
||||
{985464000 25200 1 +07}
|
||||
{1004212800 21600 0 +06}
|
||||
{1017518400 25200 1 +07}
|
||||
{1035662400 21600 0 +06}
|
||||
{1048968000 25200 1 +07}
|
||||
{1067112000 21600 0 +06}
|
||||
{1080417600 25200 1 +07}
|
||||
{1099166400 21600 0 +06}
|
||||
{1111867200 25200 1 +07}
|
||||
{1130616000 21600 0 +06}
|
||||
{1143316800 25200 1 +07}
|
||||
{1162065600 21600 0 +06}
|
||||
{1174766400 25200 1 +07}
|
||||
{1193515200 21600 0 +06}
|
||||
{1206820800 25200 1 +07}
|
||||
{1224964800 21600 0 +06}
|
||||
{1238270400 25200 1 +07}
|
||||
{1256414400 21600 0 +06}
|
||||
{1269720000 25200 1 +07}
|
||||
{1288468800 21600 0 +06}
|
||||
{1301169600 25200 0 +07}
|
||||
{1414263600 21600 0 +06}
|
||||
{1469304000 25200 0 +07}
|
||||
}
|
||||
|
||||
@@ -30,10 +30,10 @@ set TZData(:Europe/Minsk) {
|
||||
{606870000 14400 1 MSD}
|
||||
{622594800 10800 0 MSK}
|
||||
{631141200 10800 0 MSK}
|
||||
{670374000 10800 1 EEST}
|
||||
{670374000 7200 0 EEMMTT}
|
||||
{670377600 10800 1 EEST}
|
||||
{686102400 7200 0 EET}
|
||||
{701820000 10800 1 EEST}
|
||||
{717544800 10800 0 EEST}
|
||||
{701827200 10800 1 EEST}
|
||||
{717552000 7200 0 EET}
|
||||
{733276800 10800 1 EEST}
|
||||
{749001600 7200 0 EET}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# created by tools/tclZIC.tcl - do not edit
|
||||
|
||||
set TZData(:Indian/Kerguelen) {
|
||||
{-9223372036854775808 0 0 zzz}
|
||||
{-9223372036854775808 0 0 -00}
|
||||
{-631152000 18000 0 TFT}
|
||||
}
|
||||
|
||||
@@ -3279,6 +3279,92 @@ test assemble-51.4 {memory leak testing} memory {
|
||||
}
|
||||
}
|
||||
} 0
|
||||
|
||||
test assemble-52.1 {Bug 3154ea2759} {
|
||||
apply {{} {
|
||||
# Needs six exception ranges to force the range allocations to use the
|
||||
# malloced store.
|
||||
::tcl::unsupported::assemble {
|
||||
beginCatch @badLabel
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel
|
||||
label @badLabel
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel
|
||||
endCatch
|
||||
pop
|
||||
|
||||
beginCatch @badLabel2
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel2
|
||||
label @badLabel2
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel2
|
||||
endCatch
|
||||
pop
|
||||
|
||||
beginCatch @badLabel3
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel3
|
||||
label @badLabel3
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel3
|
||||
endCatch
|
||||
pop
|
||||
|
||||
beginCatch @badLabel4
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel4
|
||||
label @badLabel4
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel4
|
||||
endCatch
|
||||
pop
|
||||
|
||||
beginCatch @badLabel5
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel5
|
||||
label @badLabel5
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel5
|
||||
endCatch
|
||||
pop
|
||||
|
||||
beginCatch @badLabel6
|
||||
push error
|
||||
push testing
|
||||
invokeStk 2
|
||||
pop
|
||||
push 0
|
||||
jump @okLabel6
|
||||
label @badLabel6
|
||||
push 1; # should be pushReturnCode
|
||||
label @okLabel6
|
||||
endCatch
|
||||
pop
|
||||
}
|
||||
}}
|
||||
} {}; # must not crash
|
||||
|
||||
rename fillTables {}
|
||||
rename assemble {}
|
||||
|
||||
+17
-4
@@ -4160,12 +4160,20 @@ test chan-io-33.4 {Tcl_Gets with long line} -setup {
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
|
||||
test chan-io-33.5 {Tcl_Gets with long line} {
|
||||
test chan-io-33.5 {Tcl_Gets with long line} -setup {
|
||||
set f [open $path(test3) w]
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
close $f
|
||||
} -body {
|
||||
set f [open $path(test3)]
|
||||
set x [chan gets $f y]
|
||||
chan close $f
|
||||
list $x $y
|
||||
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
|
||||
} -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
|
||||
test chan-io-33.6 {Tcl_Gets and end of file} -setup {
|
||||
file delete $path(test3)
|
||||
set x {}
|
||||
@@ -6765,7 +6773,12 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
|
||||
chan close $out
|
||||
file size $path(utf8-fcopy.txt)
|
||||
} 5
|
||||
test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
|
||||
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
|
||||
set f [open $path(utf8-fcopy.txt) w]
|
||||
fconfigure $f -encoding utf-8
|
||||
puts $f "\u0410\u0410"
|
||||
close $f
|
||||
} -constraints {fcopy} -body {
|
||||
# binary to encoding => the input has to be in utf-8 to make sense to the
|
||||
# encoder
|
||||
set in [open $path(utf8-fcopy.txt) r]
|
||||
@@ -6777,7 +6790,7 @@ test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
|
||||
chan close $in
|
||||
chan close $out
|
||||
file size $path(kyrillic.txt)
|
||||
} 3
|
||||
} -result 3
|
||||
|
||||
test chan-io-53.1 {CopyData} -setup {
|
||||
file delete $path(test1)
|
||||
|
||||
+79
-17
@@ -141,9 +141,13 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
|
||||
} -cleanup {
|
||||
cd $dir
|
||||
} -result {/}
|
||||
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
|
||||
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
|
||||
set dir [pwd]
|
||||
} -returnCodes error -body {
|
||||
cd .\0
|
||||
} -result "couldn't change working directory to \".\0\": no such file or directory"
|
||||
} -cleanup {
|
||||
cd $dir
|
||||
} -match glob -result "couldn't change working directory to \".\0\": *"
|
||||
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
|
||||
concat
|
||||
} {}
|
||||
@@ -878,20 +882,20 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
|
||||
} 1
|
||||
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
|
||||
# On pc, must be a .exe, .com, etc.
|
||||
set x [file exe $gorpfile]
|
||||
set gorpexe [makeFile foo gorp.exe]
|
||||
lappend x [file exe $gorpexe]
|
||||
set x {}
|
||||
set gorpexes {}
|
||||
foreach ext {exe com cmd bat} {
|
||||
lappend x [file exe nosuchfile.$ext]
|
||||
set gorpexe [makeFile foo gorp.$ext]
|
||||
lappend gorpexes $gorpexe
|
||||
lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
|
||||
}
|
||||
set x
|
||||
} -cleanup {
|
||||
removeFile $gorpexe
|
||||
} -result {0 1}
|
||||
test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
|
||||
# On pc, must be a .exe, .com, etc.
|
||||
set x [file exe $gorpfile]
|
||||
set gorpexe [makeFile foo gorp.exe]
|
||||
lappend x [file exe [string toupper $gorpexe]]
|
||||
} -cleanup {
|
||||
removeFile $gorpexe
|
||||
} -result {0 1}
|
||||
foreach gorpexe $gorpexes {
|
||||
removeFile $gorpexe
|
||||
}
|
||||
} -result {0 1 1 0 1 1 0 1 1 0 1 1}
|
||||
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
|
||||
# Directories are always executable.
|
||||
file exe $dirfile
|
||||
@@ -1027,6 +1031,16 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
|
||||
set modatime [file atime $file $newatime]
|
||||
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
|
||||
} -result 1
|
||||
test cmdAH-20.7 {
|
||||
Tcl_FileObjCmd: atime (built-in Windows names)
|
||||
} -constraints {win} -body {
|
||||
file atime con
|
||||
} -result "could not get access time for file \"con\"" -returnCodes error
|
||||
test cmdAH-20.7.1 {
|
||||
Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
|
||||
} -constraints {win} -body {
|
||||
file atime [file join [temporaryDirectory] CON.txt]
|
||||
} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
|
||||
|
||||
if {[testConstraint unix] && [file exists /tmp]} {
|
||||
removeFile touch.me /tmp
|
||||
@@ -1258,6 +1272,16 @@ test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
|
||||
} -cleanup {
|
||||
file delete -force $dirname
|
||||
} -result {0 1}
|
||||
test cmdAH-24.14 {
|
||||
Tcl_FileObjCmd: mtime (built-in Windows names)
|
||||
} -constraints {win} -body {
|
||||
file mtime con
|
||||
} -result "could not get modification time for file \"con\"" -returnCodes error
|
||||
test cmdAH-24.14.1 {
|
||||
Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
|
||||
} -constraints {win} -body {
|
||||
file mtime [file join [temporaryDirectory] CON.txt]
|
||||
} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
|
||||
|
||||
# owned
|
||||
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
|
||||
@@ -1277,6 +1301,12 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
|
||||
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
|
||||
file owned /
|
||||
} 0
|
||||
test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body {
|
||||
file owned $env(windir)
|
||||
} -result 0
|
||||
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
|
||||
file owned nosuchfile
|
||||
} -result 0
|
||||
|
||||
# readlink
|
||||
test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
|
||||
@@ -1307,6 +1337,16 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
|
||||
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
|
||||
list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
|
||||
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
|
||||
test cmdAH-27.4 {
|
||||
Tcl_FileObjCmd: size (built-in Windows names)
|
||||
} -constraints {win} -body {
|
||||
file size con
|
||||
} -result 0
|
||||
test cmdAH-27.4.1 {
|
||||
Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
|
||||
} -constraints {win} -body {
|
||||
file size [file join [temporaryDirectory] con.txt]
|
||||
} -result 0
|
||||
|
||||
catch {testsetplatform $platform}
|
||||
removeFile $gorpfile
|
||||
@@ -1398,12 +1438,24 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
|
||||
} -cleanup {
|
||||
removeFile $filename
|
||||
} -result 1
|
||||
test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
|
||||
unset -nocomplain stat
|
||||
} -body {
|
||||
file stat con stat
|
||||
lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
|
||||
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
|
||||
test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
|
||||
unset -nocomplain stat
|
||||
} -body {
|
||||
file stat [file join [temporaryDirectory] CON.txt] stat
|
||||
lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
|
||||
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
|
||||
unset -nocomplain stat
|
||||
|
||||
# type
|
||||
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
|
||||
file size a b
|
||||
} -result {wrong # args: should be "file size name"}
|
||||
file type a b
|
||||
} -result {wrong # args: should be "file type name"}
|
||||
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
|
||||
file type $dirfile
|
||||
} directory
|
||||
@@ -1438,6 +1490,16 @@ test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
|
||||
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
|
||||
list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
|
||||
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
|
||||
test cmdAH-29.6 {
|
||||
Tcl_FileObjCmd: type (built-in Windows names)
|
||||
} -constraints {win} -body {
|
||||
file type con
|
||||
} -result "characterSpecial"
|
||||
test cmdAH-29.6.1 {
|
||||
Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
|
||||
} -constraints {win} -body {
|
||||
file type [file join [temporaryDirectory] CON.txt]
|
||||
} -result "characterSpecial"
|
||||
|
||||
# Error conditions
|
||||
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
|
||||
|
||||
+98
-1
@@ -678,7 +678,7 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
|
||||
# change without warning.
|
||||
|
||||
set disassemblables [linsert [join {
|
||||
lambda method objmethod proc script
|
||||
constructor destructor lambda method objmethod proc script
|
||||
} ", "] end-1 or]
|
||||
test compile-18.1 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::disassemble
|
||||
@@ -872,6 +872,103 @@ test compile-18.39 {disassembler - basics} -setup {
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -result "$bytecodekeys initiallinenumber sourcefile"
|
||||
test compile-18.40 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::disassemble constructor
|
||||
} -match glob -result {wrong # args: should be "* constructor className"}
|
||||
test compile-18.41 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::disassemble constructor nosuchclass
|
||||
} -result {nosuchclass does not refer to an object}
|
||||
test compile-18.42 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::object create justanobject
|
||||
} -body {
|
||||
tcl::unsupported::disassemble constructor justanobject
|
||||
} -cleanup {
|
||||
justanobject destroy
|
||||
} -result {"justanobject" is not a class}
|
||||
test compile-18.43 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::class create constructorless
|
||||
} -body {
|
||||
tcl::unsupported::disassemble constructor constructorless
|
||||
} -cleanup {
|
||||
constructorless destroy
|
||||
} -result {"constructorless" has no defined constructor}
|
||||
test compile-18.44 {disassembler - basics} -setup {
|
||||
oo::class create foo {constructor {} {set x 1}}
|
||||
} -body {
|
||||
# Allow any string: the result format is not defined anywhere!
|
||||
tcl::unsupported::disassemble constructor foo
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -match glob -result *
|
||||
test compile-18.45 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::getbytecode constructor
|
||||
} -match glob -result {wrong # args: should be "* constructor className"}
|
||||
test compile-18.46 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::getbytecode constructor nosuchobject
|
||||
} -result {nosuchobject does not refer to an object}
|
||||
test compile-18.47 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::class create constructorless
|
||||
} -body {
|
||||
tcl::unsupported::getbytecode constructor constructorless
|
||||
} -cleanup {
|
||||
constructorless destroy
|
||||
} -result {"constructorless" has no defined constructor}
|
||||
test compile-18.48 {disassembler - basics} -setup {
|
||||
oo::class create foo {constructor {} {set x 1}}
|
||||
} -body {
|
||||
dict keys [tcl::unsupported::getbytecode constructor foo]
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -result "$bytecodekeys"
|
||||
# There is no compile-18.49
|
||||
test compile-18.50 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::disassemble destructor
|
||||
} -match glob -result {wrong # args: should be "* destructor className"}
|
||||
test compile-18.51 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::disassemble destructor nosuchclass
|
||||
} -result {nosuchclass does not refer to an object}
|
||||
test compile-18.52 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::object create justanobject
|
||||
} -body {
|
||||
tcl::unsupported::disassemble destructor justanobject
|
||||
} -cleanup {
|
||||
justanobject destroy
|
||||
} -result {"justanobject" is not a class}
|
||||
test compile-18.53 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::class create constructorless
|
||||
} -body {
|
||||
tcl::unsupported::disassemble destructor constructorless
|
||||
} -cleanup {
|
||||
constructorless destroy
|
||||
} -result {"constructorless" has no defined destructor}
|
||||
test compile-18.54 {disassembler - basics} -setup {
|
||||
oo::class create foo {destructor {set x 1}}
|
||||
} -body {
|
||||
# Allow any string: the result format is not defined anywhere!
|
||||
tcl::unsupported::disassemble destructor foo
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -match glob -result *
|
||||
test compile-18.55 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::getbytecode destructor
|
||||
} -match glob -result {wrong # args: should be "* destructor className"}
|
||||
test compile-18.56 {disassembler - basics} -returnCodes error -body {
|
||||
tcl::unsupported::getbytecode destructor nosuchobject
|
||||
} -result {nosuchobject does not refer to an object}
|
||||
test compile-18.57 {disassembler - basics} -returnCodes error -setup {
|
||||
oo::class create constructorless
|
||||
} -body {
|
||||
tcl::unsupported::getbytecode destructor constructorless
|
||||
} -cleanup {
|
||||
constructorless destroy
|
||||
} -result {"constructorless" has no defined destructor}
|
||||
test compile-18.58 {disassembler - basics} -setup {
|
||||
oo::class create foo {destructor {set x 1}}
|
||||
} -body {
|
||||
dict keys [tcl::unsupported::getbytecode destructor foo]
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -result "$bytecodekeys"
|
||||
|
||||
test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
|
||||
# This will panic in a --enable-symbols=compile build, unless bug is fixed.
|
||||
|
||||
@@ -2048,6 +2048,13 @@ test dict-24.25 {dict map with huge dict (compiled)} {
|
||||
}} 100000
|
||||
} 166666666600000
|
||||
|
||||
test dict-25.1 {compiled dict update with low-refcount values [Bug d553228d9f]} {
|
||||
# Test crashes on failure
|
||||
apply {{} {
|
||||
lassign {} item
|
||||
dict update item item item two two {}
|
||||
}}
|
||||
} {}
|
||||
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
|
||||
+10
-2
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
# Some tests require the "exec" command.
|
||||
# Skip them if exec is not defined.
|
||||
testConstraint exec [llength [info commands exec]]
|
||||
|
||||
|
||||
#
|
||||
# These tests will run on any platform (and indeed crashed on the Mac). So put
|
||||
# them before you test for the existance of exec.
|
||||
@@ -147,6 +147,7 @@ test env-2.2 {adding environment variables} -setup {
|
||||
} -result {NAME1=test string}
|
||||
test env-2.3 {adding environment variables} -setup {
|
||||
encoding system iso8859-1
|
||||
set env(NAME1) "test string"
|
||||
} -constraints {exec} -body {
|
||||
set env(NAME2) "more"
|
||||
getenv
|
||||
@@ -156,6 +157,8 @@ test env-2.3 {adding environment variables} -setup {
|
||||
NAME2=more}
|
||||
test env-2.4 {adding environment variables} -setup {
|
||||
encoding system iso8859-1
|
||||
set env(NAME1) "test string"
|
||||
set env(NAME2) "more"
|
||||
} -constraints {exec} -body {
|
||||
set env(XYZZY) "garbage"
|
||||
getenv
|
||||
@@ -165,7 +168,9 @@ test env-2.4 {adding environment variables} -setup {
|
||||
NAME2=more
|
||||
XYZZY=garbage}
|
||||
|
||||
set env(NAME1) "test string"
|
||||
set env(NAME2) "new value"
|
||||
set env(XYZZY) "garbage"
|
||||
test env-3.1 {changing environment variables} -setup {
|
||||
encoding system iso8859-1
|
||||
} -constraints {exec} -body {
|
||||
@@ -177,6 +182,7 @@ test env-3.1 {changing environment variables} -setup {
|
||||
} -result {NAME1=test string
|
||||
NAME2=new value
|
||||
XYZZY=garbage}
|
||||
unset -nocomplain env(NAME2)
|
||||
|
||||
test env-4.1 {unsetting environment variables: default} -setup {
|
||||
encoding system iso8859-1
|
||||
@@ -195,6 +201,7 @@ test env-4.2 {unsetting environment variables} -setup {
|
||||
unset env(XYZZY)
|
||||
encoding system $sysenc
|
||||
} -result {XYZZY=garbage}
|
||||
unset -nocomplain env(NAME1) env(XYZZY)
|
||||
test env-4.3 {setting international environment variables} -setup {
|
||||
encoding system iso8859-1
|
||||
} -constraints {exec} -body {
|
||||
@@ -213,6 +220,7 @@ test env-4.4 {changing international environment variables} -setup {
|
||||
} -result {\u00a7=\u00a7}
|
||||
test env-4.5 {unsetting international environment variables} -setup {
|
||||
encoding system iso8859-1
|
||||
set env(\ua7) \ua7
|
||||
} -body {
|
||||
set env(\ub6) \ua7
|
||||
unset env(\ua7)
|
||||
@@ -323,7 +331,7 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
|
||||
return [info exists ::env(test7_3)]
|
||||
}}
|
||||
} -result 1
|
||||
|
||||
|
||||
# Restore the environment variables at the end of the test.
|
||||
|
||||
foreach name [array names env] {
|
||||
|
||||
@@ -583,6 +583,34 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
|
||||
removeFile $test2file
|
||||
list $x $y $z
|
||||
} {3 3 done}
|
||||
test event-11.7 {Bug 16828b3744} {
|
||||
after idle {
|
||||
set ::t::v 1
|
||||
namespace delete ::t
|
||||
}
|
||||
namespace eval ::t {
|
||||
vwait ::t::v
|
||||
}
|
||||
} {}
|
||||
test event-11.8 {Bug 16828b3744} -setup {
|
||||
oo::class create A {
|
||||
variable continue
|
||||
|
||||
method start {} {
|
||||
after idle [self] destroy
|
||||
|
||||
set continue 0
|
||||
vwait [namespace current]::continue
|
||||
}
|
||||
destructor {
|
||||
set continue 1
|
||||
}
|
||||
}
|
||||
} -body {
|
||||
[A new] start
|
||||
} -cleanup {
|
||||
A destroy
|
||||
} -result {}
|
||||
|
||||
test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
|
||||
update a b
|
||||
|
||||
@@ -682,6 +682,22 @@ test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
|
||||
} -cleanup {
|
||||
removeFile $tmpfile
|
||||
} -result 14
|
||||
|
||||
# Tests to ensure batch files and .CMD (Bug 9ece99d58b)
|
||||
# can be executed on Windows
|
||||
test exec-20.0 {exec .bat file} -constraints {win} -body {
|
||||
set log [makeFile {} exec20.log]
|
||||
exec [makeFile "echo %1> $log" exec20.bat] "Testing exec-20.0"
|
||||
viewFile $log
|
||||
} -result "\"Testing exec-20.0\""
|
||||
test exec-20.1 {exec .CMD file} -constraints {win} -body {
|
||||
set log [makeFile {} exec201.log]
|
||||
exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
|
||||
viewFile $log
|
||||
} -result "\"Testing exec-20.1\""
|
||||
|
||||
|
||||
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# cleanup
|
||||
|
||||
+8
-6
@@ -1468,14 +1468,16 @@ if {[testConstraint testsetplatform]} {
|
||||
}
|
||||
test filename-17.2 {windows specific glob with executable} -body {
|
||||
makeDirectory execglob
|
||||
makeFile contents execglob/abc.exe
|
||||
makeFile contents execglob/abc.notexecutable
|
||||
glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *
|
||||
foreach ext {exe com cmd bat notexecutable} {
|
||||
makeFile contents execglob/abc.$ext
|
||||
}
|
||||
lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
|
||||
} -constraints {win} -cleanup {
|
||||
removeFile execglob/abc.exe
|
||||
removeFile execglob/abc.notexecutable
|
||||
foreach ext {exe com cmd bat ps1 notexecutable} {
|
||||
removeFile execglob/abc.$ext
|
||||
}
|
||||
removeDirectory execglob
|
||||
} -result {abc.exe}
|
||||
} -result {abc.bat abc.cmd abc.com abc.exe}
|
||||
test filename-17.3 {Bug 2571597} win {
|
||||
set p /a
|
||||
file pathtype $p
|
||||
|
||||
@@ -233,6 +233,7 @@ if {[testConstraint history]} {
|
||||
test history-8.1 {clear option} history {catch {history clear junk}} 1
|
||||
test history-8.2 {clear option} history {history clear} {}
|
||||
if {[testConstraint history]} {
|
||||
history clear
|
||||
history add "Testing"
|
||||
}
|
||||
test history-8.3 {clear option} history {history} { 1 Testing}
|
||||
@@ -248,3 +249,7 @@ test history-9.2 {miscellaneous} history {
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
+18
-1
@@ -1841,7 +1841,7 @@ test info-30.48 {Bug 2850901} testevalex {
|
||||
# -------------------------------------------------------------------------
|
||||
# literal sharing 2, bug 2933089
|
||||
|
||||
test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
|
||||
test info-40.1 {location information not confused by literal sharing, bug 2933089} -setup {
|
||||
set result {}
|
||||
|
||||
proc print_one {} {}
|
||||
@@ -2398,6 +2398,23 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
|
||||
# -------------------------------------------------------------------------
|
||||
unset -nocomplain res
|
||||
|
||||
test info-39.1 {Bug 4b61afd660} -setup {
|
||||
proc probe {} {
|
||||
return [dict get [info frame -1] line]
|
||||
}
|
||||
set body {
|
||||
set cmd probe
|
||||
$cmd
|
||||
}
|
||||
proc demo {} $body
|
||||
} -body {
|
||||
demo
|
||||
} -cleanup {
|
||||
unset -nocomplain body
|
||||
rename demo {}
|
||||
rename probe {}
|
||||
} -result 3
|
||||
|
||||
# cleanup
|
||||
catch {namespace delete test_ns_info1 test_ns_info2}
|
||||
::tcltest::cleanupTests
|
||||
|
||||
+33
-14
@@ -71,9 +71,11 @@ test interp-2.2 {basic interpreter creation} {
|
||||
test interp-2.3 {basic interpreter creation} {
|
||||
catch {interp create -safe}
|
||||
} 0
|
||||
test interp-2.4 {basic interpreter creation} {
|
||||
list [catch {interp create a} msg] $msg
|
||||
} {1 {interpreter named "a" already exists, cannot create}}
|
||||
test interp-2.4 {basic interpreter creation} -setup {
|
||||
catch {interp create a}
|
||||
} -returnCodes error -body {
|
||||
interp create a
|
||||
} -result {interpreter named "a" already exists, cannot create}
|
||||
test interp-2.5 {basic interpreter creation} {
|
||||
interp create b -safe
|
||||
} b
|
||||
@@ -89,11 +91,13 @@ test interp-2.8 {basic interpreter creation} {
|
||||
test interp-2.9 {basic interpreter creation} {
|
||||
interp create -safe -- -froboz1
|
||||
} -froboz1
|
||||
test interp-2.10 {basic interpreter creation} {
|
||||
test interp-2.10 {basic interpreter creation} -setup {
|
||||
catch {interp create a}
|
||||
} -body {
|
||||
interp create {a x1}
|
||||
interp create {a x2}
|
||||
interp create {a x3} -safe
|
||||
} {a x3}
|
||||
} -result {a x3}
|
||||
test interp-2.11 {anonymous interps vs existing procs} {
|
||||
set x [interp create]
|
||||
regexp "interp(\[0-9]+)" $x dummy thenum
|
||||
@@ -140,19 +144,26 @@ test interp-3.5 {testing interp exists and interp slaves} -body {
|
||||
test interp-3.6 {testing interp exists and interp slaves} {
|
||||
interp exists
|
||||
} 1
|
||||
test interp-3.7 {testing interp exists and interp slaves} {
|
||||
test interp-3.7 {testing interp exists and interp slaves} -setup {
|
||||
catch {interp create a}
|
||||
} -body {
|
||||
interp slaves
|
||||
} a
|
||||
} -result a
|
||||
test interp-3.8 {testing interp exists and interp slaves} -body {
|
||||
interp slaves a b c
|
||||
} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
|
||||
test interp-3.9 {testing interp exists and interp slaves} {
|
||||
test interp-3.9 {testing interp exists and interp slaves} -setup {
|
||||
catch {interp create a}
|
||||
} -body {
|
||||
interp create {a a2} -safe
|
||||
expr {"a2" in [interp slaves a]}
|
||||
} 1
|
||||
test interp-3.10 {testing interp exists and interp slaves} {
|
||||
} -result 1
|
||||
test interp-3.10 {testing interp exists and interp slaves} -setup {
|
||||
catch {interp create a}
|
||||
catch {interp create {a a2}}
|
||||
} -body {
|
||||
interp exists {a a2}
|
||||
} 1
|
||||
} -result 1
|
||||
|
||||
# Part 3: Testing "interp delete"
|
||||
test interp-3.11 {testing interp delete} {
|
||||
@@ -222,6 +233,7 @@ test interp-6.3 {testing eval} {
|
||||
a eval {proc foo {} {expr 3 + 5}}
|
||||
a eval foo
|
||||
} 8
|
||||
catch {a eval {proc foo {} {expr 3 + 5}}}
|
||||
test interp-6.4 {testing eval} {
|
||||
interp eval a foo
|
||||
} 8
|
||||
@@ -230,6 +242,7 @@ test interp-6.5 {testing eval} {
|
||||
interp eval {a x2} {proc frob {} {expr 4 * 9}}
|
||||
interp eval {a x2} frob
|
||||
} 36
|
||||
catch {interp create {a x2}}
|
||||
test interp-6.6 {testing eval} -returnCodes error -body {
|
||||
interp eval {a x2} foo
|
||||
} -result {invalid command name "foo"}
|
||||
@@ -243,9 +256,11 @@ proc in_master {args} {
|
||||
test interp-7.1 {testing basic alias creation} {
|
||||
a alias foo in_master
|
||||
} foo
|
||||
catch {a alias foo in_master}
|
||||
test interp-7.2 {testing basic alias creation} {
|
||||
a alias bar in_master a1 a2 a3
|
||||
} bar
|
||||
catch {a alias bar in_master a1 a2 a3}
|
||||
# Test 6.3 has been deleted.
|
||||
test interp-7.3 {testing basic alias creation} {
|
||||
a alias foo
|
||||
@@ -476,9 +491,13 @@ test interp-13.4 {testing issafe arg checking} {
|
||||
} {1 {wrong # args: should be "a issafe"}}
|
||||
|
||||
# part 14: testing interp aliases
|
||||
test interp-14.1 {testing interp aliases} {
|
||||
interp aliases
|
||||
} ""
|
||||
test interp-14.1 {testing interp aliases} -setup {
|
||||
interp create abc
|
||||
} -body {
|
||||
interp eval abc {interp aliases}
|
||||
} -cleanup {
|
||||
interp delete abc
|
||||
} -result ""
|
||||
test interp-14.2 {testing interp aliases} {
|
||||
catch {interp delete a}
|
||||
interp create a
|
||||
|
||||
+33
-2
@@ -44,6 +44,7 @@ testConstraint testfevent [llength [info commands testfevent]]
|
||||
testConstraint testchannelevent [llength [info commands testchannelevent]]
|
||||
testConstraint testmainthread [llength [info commands testmainthread]]
|
||||
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
|
||||
testConstraint testobj [llength [info commands testobj]]
|
||||
|
||||
# You need a *very* special environment to do some tests. In
|
||||
# particular, many file systems do not support large-files...
|
||||
@@ -4285,6 +4286,13 @@ test io-33.4 {Tcl_Gets with long line} {
|
||||
close $f
|
||||
set x
|
||||
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
|
||||
set f [open $path(test3) w]
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
close $f
|
||||
test io-33.5 {Tcl_Gets with long line} {
|
||||
set f [open $path(test3)]
|
||||
set x [gets $f y]
|
||||
@@ -7141,7 +7149,12 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
|
||||
|
||||
file size $path(utf8-fcopy.txt)
|
||||
} 5
|
||||
test io-52.11 {TclCopyChannel & encodings} {fcopy} {
|
||||
test io-52.11 {TclCopyChannel & encodings} -setup {
|
||||
set out [open $path(utf8-fcopy.txt) w]
|
||||
fconfigure $out -encoding utf-8 -translation lf
|
||||
puts $out "\u0410\u0410"
|
||||
close $out
|
||||
} -constraints {fcopy} -body {
|
||||
# binary to encoding => the input has to be
|
||||
# in utf-8 to make sense to the encoder
|
||||
|
||||
@@ -7157,7 +7170,7 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
|
||||
close $out
|
||||
|
||||
file size $path(kyrillic.txt)
|
||||
} 3
|
||||
} -result 3
|
||||
|
||||
test io-52.12 {coverage of -translation auto} {
|
||||
file delete $path(test1) $path(test2)
|
||||
@@ -8626,6 +8639,24 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
|
||||
removeFile io-73.5
|
||||
} -result [list 1 1 more\u00a0data 1]
|
||||
|
||||
test io-74.1 {[104f2885bb] improper cache validity check} -setup {
|
||||
set fn [makeFile {} io-74.1]
|
||||
set rfd [open $fn r]
|
||||
testobj freeallvars
|
||||
interp create slave
|
||||
} -constraints testobj -body {
|
||||
teststringobj set 1 [string range $rfd 0 end]
|
||||
read [teststringobj get 1]
|
||||
testobj duplicate 1 2
|
||||
interp transfer {} $rfd slave
|
||||
catch {read [teststringobj get 1]}
|
||||
read [teststringobj get 2]
|
||||
} -cleanup {
|
||||
interp delete slave
|
||||
testobj freeallvars
|
||||
removeFile io-74.1
|
||||
} -returnCodes error -match glob -result {can not find channel named "*"}
|
||||
|
||||
# ### ### ### ######### ######### #########
|
||||
|
||||
# cleanup
|
||||
|
||||
+36
-20
@@ -124,9 +124,11 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
|
||||
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
|
||||
list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
|
||||
} {0 {}}
|
||||
test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
|
||||
list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
|
||||
} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]
|
||||
test load-4.2 {reloading package into same interpreter} -setup {
|
||||
catch {load [file join $testDir pkga$ext] pkga}
|
||||
} -constraints [list $dll $loaded] -returnCodes error -body {
|
||||
load [file join $testDir pkga$ext] pkgb
|
||||
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
|
||||
|
||||
test load-5.1 {file name not specified and no static package: pick default} \
|
||||
[list $dll $loaded] {
|
||||
@@ -169,26 +171,40 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
|
||||
load {} More
|
||||
set x
|
||||
} {not loaded}
|
||||
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
|
||||
[list teststaticpkg $dll $loaded] {
|
||||
teststaticpkg Double 0 1
|
||||
teststaticpkg Double 0 1
|
||||
info loaded
|
||||
} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
|
||||
|
||||
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
|
||||
catch {load [file join $testDir pkga$ext] pkga}
|
||||
catch {load [file join $testDir pkgb$ext] pkgb}
|
||||
catch {load [file join $testDir pkge$ext] pkge}
|
||||
set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
|
||||
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
|
||||
teststaticpkg Test 1 0
|
||||
teststaticpkg Another 0 0
|
||||
teststaticpkg More 0 1
|
||||
} -constraints [list teststaticpkg $dll $loaded] -body {
|
||||
teststaticpkg Double 0 1
|
||||
teststaticpkg Double 0 1
|
||||
info loaded
|
||||
} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
|
||||
test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
|
||||
list [catch {info loaded gorp} msg] $msg
|
||||
} {1 {could not find interpreter "gorp"}}
|
||||
test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
|
||||
list [info loaded {}] [info loaded child]
|
||||
} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
|
||||
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
|
||||
|
||||
teststaticpkg Test 1 1
|
||||
teststaticpkg Another 0 1
|
||||
teststaticpkg More 0 1
|
||||
teststaticpkg Double 0 1
|
||||
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
|
||||
lsort -index 1 [info loaded]
|
||||
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
|
||||
test load-8.2 {TclGetLoadedPackages procedure} -body {
|
||||
info loaded gorp
|
||||
} -returnCodes error -result {could not find interpreter "gorp"}
|
||||
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
|
||||
lsort -index 1 [info loaded {}]
|
||||
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
|
||||
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
|
||||
lsort -index 1 [info loaded child]
|
||||
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
|
||||
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
|
||||
load [file join $testDir pkgb$ext] pkgb
|
||||
list [info loaded {}] [lsort [info commands pkgb_*]]
|
||||
} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
|
||||
list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
|
||||
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
|
||||
interp delete child
|
||||
|
||||
test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
|
||||
|
||||
+9
-2
@@ -68,6 +68,7 @@ namespace eval ::msgcat::test {
|
||||
set result c
|
||||
}
|
||||
}
|
||||
|
||||
test msgcat-0.$count [list \
|
||||
locale initialization from environment variables $setVars \
|
||||
] -setup {
|
||||
@@ -973,7 +974,10 @@ namespace eval ::msgcat::test {
|
||||
}
|
||||
set bgerrorsaved [interp bgerror {}]
|
||||
interp bgerror {} [namespace code callbackproc]
|
||||
|
||||
|
||||
variable locale
|
||||
if {![info exist locale]} { set locale [mclocale] }
|
||||
|
||||
test msgcat-14.1 {invokation loadcmd} -setup {
|
||||
mcforgetpackage
|
||||
mclocale $locale
|
||||
@@ -1068,7 +1072,7 @@ namespace eval ::msgcat::test {
|
||||
mc k1
|
||||
} -returnCodes 1\
|
||||
-result {fail}
|
||||
|
||||
|
||||
interp bgerror {} $bgerrorsaved
|
||||
|
||||
cleanupTests
|
||||
@@ -1076,3 +1080,6 @@ namespace eval ::msgcat::test {
|
||||
namespace delete ::msgcat::test
|
||||
return
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
+140
-29
@@ -57,6 +57,12 @@ test namespace-old-1.9 {add elements to a namespace} {
|
||||
}
|
||||
}
|
||||
} {}
|
||||
namespace eval test_ns_simple {
|
||||
variable test_ns_x 0
|
||||
proc test {test_ns_x} {
|
||||
return "test: $test_ns_x"
|
||||
}
|
||||
}
|
||||
test namespace-old-1.10 {commands in a namespace} {
|
||||
namespace eval test_ns_simple { info commands [namespace current]::*}
|
||||
} {::test_ns_simple::test}
|
||||
@@ -74,6 +80,12 @@ test namespace-old-1.13 {add to an existing namespace} {
|
||||
}
|
||||
}
|
||||
} ""
|
||||
namespace eval test_ns_simple {
|
||||
variable test_ns_y 123
|
||||
proc _backdoor {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
}
|
||||
test namespace-old-1.14 {commands in a namespace} {
|
||||
lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
|
||||
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
|
||||
@@ -128,6 +140,8 @@ test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
|
||||
test namespace-old-1.27 {can create commands with null names} {
|
||||
proc test_ns_simple:: {args} {return $args}
|
||||
} {}
|
||||
# Redeclare; later tests depend on it
|
||||
proc test_ns_simple:: {args} {return $args}
|
||||
|
||||
# -----------------------------------------------------------------------
|
||||
# TEST: using "info" in namespace contexts
|
||||
@@ -212,6 +226,11 @@ test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
|
||||
}
|
||||
list [catch $cmd msg] $msg
|
||||
} {1 {unknown namespace "ns*" in namespace delete command}}
|
||||
namespace eval test_ns_delete {
|
||||
namespace eval ns1 {}
|
||||
namespace eval ns2 {}
|
||||
namespace eval another {}
|
||||
}
|
||||
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
|
||||
set cmd {
|
||||
namespace eval test_ns_delete {
|
||||
@@ -256,6 +275,24 @@ test namespace-old-5.3 {namespace qualifiers work in namespace command} {
|
||||
[namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
|
||||
[namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
|
||||
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
|
||||
set ::test_ns_var_global "var in ::"
|
||||
proc test_ns_cmd_global {} {return "cmd in ::"}
|
||||
namespace eval test_ns_hier1 {
|
||||
variable test_ns_var_hier1 "particular to hier1"
|
||||
proc test_ns_cmd_hier1 {} {return "particular to hier1"}
|
||||
variable test_ns_level 1
|
||||
proc test_ns_show {} {return "[namespace current]: 1"}
|
||||
namespace eval test_ns_hier2 {
|
||||
variable test_ns_var_hier2 "particular to hier2"
|
||||
proc test_ns_cmd_hier2 {} {return "particular to hier2"}
|
||||
variable test_ns_level 2
|
||||
proc test_ns_show {} {return "[namespace current]: 2"}
|
||||
namespace eval test_ns_hier3a {}
|
||||
namespace eval test_ns_hier3b {}
|
||||
}
|
||||
namespace eval test_ns_hier2a {}
|
||||
namespace eval test_ns_hier2b {}
|
||||
}
|
||||
test namespace-old-5.4 {nested namespaces can access global namespace} {
|
||||
list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
|
||||
[namespace eval test_ns_hier1 {test_ns_cmd_global}] \
|
||||
@@ -331,16 +368,12 @@ test namespace-old-5.21 {querying namespace parent for explicit namespace} {
|
||||
# -----------------------------------------------------------------------
|
||||
# TEST: name resolution and caching
|
||||
# -----------------------------------------------------------------------
|
||||
set trigger {namespace eval test_ns_cache2 {namespace current}}
|
||||
set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}}
|
||||
test namespace-old-6.1 {relative ns names only looked up in current ns} {
|
||||
namespace eval test_ns_cache1 {}
|
||||
namespace eval test_ns_cache2 {}
|
||||
namespace eval test_ns_cache2::test_ns_cache3 {}
|
||||
set trigger {
|
||||
namespace eval test_ns_cache2 {namespace current}
|
||||
}
|
||||
set trigger2 {
|
||||
namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
|
||||
}
|
||||
list [namespace eval test_ns_cache1 $trigger] \
|
||||
[namespace eval test_ns_cache1 $trigger2]
|
||||
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
||||
@@ -354,20 +387,19 @@ test namespace-old-6.3 {relative ns names only looked up in current ns} {
|
||||
list [namespace eval test_ns_cache1 $trigger] \
|
||||
[namespace eval test_ns_cache1 $trigger2]
|
||||
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
||||
namespace eval test_ns_cache1::test_ns_cache2 {}
|
||||
test namespace-old-6.4 {relative ns names only looked up in current ns} {
|
||||
namespace delete test_ns_cache1::test_ns_cache2
|
||||
list [namespace eval test_ns_cache1 $trigger] \
|
||||
[namespace eval test_ns_cache1 $trigger2]
|
||||
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
|
||||
namespace eval test_ns_cache1 {
|
||||
proc trigger {} {test_ns_cache_cmd}
|
||||
}
|
||||
test namespace-old-6.5 {define test commands} {
|
||||
proc test_ns_cache_cmd {} {
|
||||
return "global version"
|
||||
}
|
||||
namespace eval test_ns_cache1 {
|
||||
proc trigger {} {
|
||||
test_ns_cache_cmd
|
||||
}
|
||||
}
|
||||
test_ns_cache1::trigger
|
||||
} {global version}
|
||||
test namespace-old-6.6 {one-level check for command shadowing} {
|
||||
@@ -376,24 +408,36 @@ test namespace-old-6.6 {one-level check for command shadowing} {
|
||||
}
|
||||
test_ns_cache1::trigger
|
||||
} {cache1 version}
|
||||
test namespace-old-6.7 {renaming commands changes command epoch} {
|
||||
namespace eval test_ns_cache1 {
|
||||
rename test_ns_cache_cmd test_ns_new
|
||||
proc test_ns_cache_cmd {} {
|
||||
return "global version"
|
||||
}
|
||||
test namespace-old-6.7 {renaming commands changes command epoch} -setup {
|
||||
proc test_ns_cache1::test_ns_cache_cmd {} {
|
||||
return "cache1 version"
|
||||
}
|
||||
test_ns_cache1::trigger
|
||||
} {global version}
|
||||
test namespace-old-6.8 {renaming back handles shadowing} {
|
||||
namespace eval test_ns_cache1 {
|
||||
rename test_ns_new test_ns_cache_cmd
|
||||
} -body {
|
||||
list [test_ns_cache1::trigger] \
|
||||
[namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\
|
||||
[test_ns_cache1::trigger]
|
||||
} -result {{cache1 version} {} {global version}}
|
||||
test namespace-old-6.8 {renaming back handles shadowing} -setup {
|
||||
proc test_ns_cache1::test_ns_new {} {
|
||||
return "cache1 version"
|
||||
}
|
||||
test_ns_cache1::trigger
|
||||
} {cache1 version}
|
||||
test namespace-old-6.9 {deleting commands changes command epoch} {
|
||||
namespace eval test_ns_cache1 {
|
||||
rename test_ns_cache_cmd ""
|
||||
} -body {
|
||||
list [test_ns_cache1::trigger] \
|
||||
[namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\
|
||||
[test_ns_cache1::trigger]
|
||||
} -result {{global version} {} {cache1 version}}
|
||||
test namespace-old-6.9 {deleting commands changes command epoch} -setup {
|
||||
proc test_ns_cache1::test_ns_cache_cmd {} {
|
||||
return "cache1 version"
|
||||
}
|
||||
test_ns_cache1::trigger
|
||||
} {global version}
|
||||
} -body {
|
||||
list [test_ns_cache1::trigger] \
|
||||
[namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \
|
||||
[test_ns_cache1::trigger]
|
||||
} -result {{cache1 version} {} {global version}}
|
||||
test namespace-old-6.10 {define test namespaces} {
|
||||
namespace eval test_ns_cache2 {
|
||||
proc test_ns_cache_cmd {} {
|
||||
@@ -412,6 +456,12 @@ test namespace-old-6.10 {define test namespaces} {
|
||||
}
|
||||
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
|
||||
} {{global cache2 version} {global version}}
|
||||
namespace eval test_ns_cache1 {
|
||||
proc trigger {} { test_ns_cache2::test_ns_cache_cmd }
|
||||
namespace eval test_ns_cache2 {
|
||||
proc trigger {} { test_ns_cache_cmd }
|
||||
}
|
||||
}
|
||||
test namespace-old-6.11 {commands affect all parent namespaces} {
|
||||
proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
|
||||
return "cache2 version"
|
||||
@@ -423,18 +473,22 @@ test namespace-old-6.12 {define test variables} {
|
||||
set trigger {set test_ns_cache_var}
|
||||
namespace eval test_ns_cache1 $trigger
|
||||
} {global version}
|
||||
set trigger {set test_ns_cache_var}
|
||||
test namespace-old-6.13 {one-level check for variable shadowing} {
|
||||
namespace eval test_ns_cache1 {
|
||||
variable test_ns_cache_var "cache1 version"
|
||||
}
|
||||
namespace eval test_ns_cache1 $trigger
|
||||
} {cache1 version}
|
||||
variable ::test_ns_cache_var "global version"
|
||||
test namespace-old-6.14 {deleting variables changes variable epoch} {
|
||||
namespace eval test_ns_cache1 {
|
||||
unset test_ns_cache_var
|
||||
variable test_ns_cache_var "cache1 version"
|
||||
}
|
||||
namespace eval test_ns_cache1 $trigger
|
||||
} {global version}
|
||||
list [namespace eval test_ns_cache1 $trigger] \
|
||||
[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
|
||||
[namespace eval test_ns_cache1 $trigger]
|
||||
} {{cache1 version} {} {global version}}
|
||||
test namespace-old-6.15 {define test namespaces} {
|
||||
namespace eval test_ns_cache2 {
|
||||
variable test_ns_cache_var "global cache2 version"
|
||||
@@ -443,6 +497,7 @@ test namespace-old-6.15 {define test namespaces} {
|
||||
list [namespace eval test_ns_cache1 $trigger2] \
|
||||
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
|
||||
} {{global cache2 version} {global version}}
|
||||
set trigger2 {set test_ns_cache2::test_ns_cache_var}
|
||||
test namespace-old-6.16 {public variables affect all parent namespaces} {
|
||||
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
|
||||
list [namespace eval test_ns_cache1 $trigger2] \
|
||||
@@ -467,6 +522,7 @@ test namespace-old-6.19 {querying: namespace which -command} {
|
||||
test namespace-old-6.20 {command "namespace which" may not find commands} {
|
||||
namespace eval test_ns_cache1 {namespace which -command xyzzy}
|
||||
} {}
|
||||
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
|
||||
test namespace-old-6.21 {querying: namespace which -variable} {
|
||||
namespace eval test_ns_cache1::test_ns_cache2 {
|
||||
namespace which -variable test_ns_cache_var
|
||||
@@ -493,6 +549,18 @@ test namespace-old-7.1 {define test namespace} {
|
||||
}
|
||||
}
|
||||
} {}
|
||||
namespace eval test_ns_uplevel {
|
||||
variable x 0
|
||||
variable y 1
|
||||
proc show_vars {num} {
|
||||
return [uplevel $num {info vars}]
|
||||
}
|
||||
proc test_uplevel {num} {
|
||||
set a 0
|
||||
set b 1
|
||||
namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
|
||||
}
|
||||
}
|
||||
test namespace-old-7.2 {uplevel can access namespace call frame} {
|
||||
list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
|
||||
[expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
|
||||
@@ -526,6 +594,17 @@ test namespace-old-7.8 {namespaces are included in the call stack} {
|
||||
}
|
||||
}
|
||||
} {}
|
||||
namespace eval test_ns_upvar {
|
||||
variable scope "test_ns_upvar"
|
||||
proc show_val {var num} {
|
||||
upvar $num $var x
|
||||
return $x
|
||||
}
|
||||
proc test_upvar {num} {
|
||||
set scope "test_ns_upvar::test_upvar"
|
||||
namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
|
||||
}
|
||||
}
|
||||
test namespace-old-7.9 {upvar can access namespace call frame} {
|
||||
test_ns_upvar::test_upvar 1
|
||||
} {test_ns_upvar}
|
||||
@@ -581,6 +660,15 @@ test namespace-old-9.3 {define test namespaces for import} {
|
||||
}
|
||||
lsort [info commands test_ns_export::*]
|
||||
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1 cmd2 cmd3
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
proc cmd3 {args} {return "cmd3: $args"}
|
||||
proc cmd4 {args} {return "cmd4: $args"}
|
||||
proc cmd5 {args} {return "cmd5: $args"}
|
||||
proc cmd6 {args} {return "cmd6: $args"}
|
||||
}
|
||||
test namespace-old-9.4 {check export status} {
|
||||
set x ""
|
||||
namespace eval test_ns_import {
|
||||
@@ -592,6 +680,10 @@ test namespace-old-9.4 {check export status} {
|
||||
}
|
||||
set x
|
||||
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
|
||||
namespace eval test_ns_import {
|
||||
namespace export cmd1 cmd2
|
||||
namespace import ::test_ns_export::*
|
||||
}
|
||||
test namespace-old-9.5 {empty import list in "namespace import" command} {
|
||||
namespace eval test_ns_import_empty {
|
||||
namespace import ::test_ns_export::*
|
||||
@@ -615,6 +707,7 @@ test namespace-old-9.8 {only exported commands are imported} {
|
||||
namespace import test_ns_import::cmd*
|
||||
set x [lsort [info commands cmd*]]
|
||||
} {cmd1 cmd2}
|
||||
namespace import test_ns_import::cmd*
|
||||
test namespace-old-9.9 {imported commands work just the same as original} {
|
||||
list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
|
||||
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
|
||||
@@ -629,10 +722,19 @@ test namespace-old-9.10 {commands can be imported from many namespaces} {
|
||||
namespace import test_ns_import2::*
|
||||
lsort [concat [info commands cmd*] [info commands ncmd*]]
|
||||
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
|
||||
namespace eval test_ns_import2 {
|
||||
namespace export ncmd ncmd1 ncmd2
|
||||
proc ncmd {args} {return "ncmd: $args"}
|
||||
proc ncmd1 {args} {return "ncmd1: $args"}
|
||||
proc ncmd2 {args} {return "ncmd2: $args"}
|
||||
proc ncmd3 {args} {return "ncmd3: $args"}
|
||||
}
|
||||
namespace import test_ns_import2::*
|
||||
test namespace-old-9.11 {imported commands can be removed by deleting them} {
|
||||
rename cmd1 ""
|
||||
lsort [concat [info commands cmd*] [info commands ncmd*]]
|
||||
} {cmd2 ncmd ncmd1 ncmd2}
|
||||
catch { rename cmd1 "" }
|
||||
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
|
||||
list [catch {namespace forget xyzzy::*} msg] $msg
|
||||
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
|
||||
@@ -653,6 +755,7 @@ test namespace-old-9.15 {existing commands can't be overwritten} {
|
||||
[cmd1 3 5]
|
||||
} {1 {can't import command "cmd1": already exists} 8}
|
||||
test namespace-old-9.16 {use "-force" option to override existing commands} {
|
||||
proc cmd1 {x y} { return [expr $x+$y] }
|
||||
list [cmd1 3 5] \
|
||||
[namespace import -force test_ns_import::cmd?] \
|
||||
[cmd1 3 5]
|
||||
@@ -711,10 +814,18 @@ test namespace-old-10.6 {with many args, each "scope" adds new args} {
|
||||
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
|
||||
namespace code "$sval three"
|
||||
} {::namespace inscope ::test_ns_inscope {one two} three}
|
||||
namespace eval test_ns_inscope {
|
||||
proc show {args} {
|
||||
return "show: $args"
|
||||
}
|
||||
}
|
||||
test namespace-old-10.7 {scoped commands work with eval} {
|
||||
set cref [namespace eval test_ns_inscope {namespace code show}]
|
||||
list [eval $cref "a" "b c" "d e f"]
|
||||
} {{show: a b c d e f}}
|
||||
namespace eval test_ns_inscope {
|
||||
variable x "x-value"
|
||||
}
|
||||
test namespace-old-10.8 {scoped commands execute in namespace context} {
|
||||
set cref [namespace eval test_ns_inscope {
|
||||
namespace code {set x "some new value"}
|
||||
|
||||
+431
-117
@@ -82,12 +82,14 @@ test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
|
||||
test namespace-5.1 {Tcl_PopCallFrame, no vars} {
|
||||
namespace eval test_ns_1::blodge {} ;# pushes then pops frame
|
||||
} {}
|
||||
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
|
||||
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup {
|
||||
namespace eval test_ns_1 {}
|
||||
} -body {
|
||||
proc test_ns_1::r {} {
|
||||
set a 123
|
||||
}
|
||||
test_ns_1::r ;# pushes then pop's r's frame
|
||||
} {123}
|
||||
} -result {123}
|
||||
|
||||
test namespace-6.1 {Tcl_CreateNamespace} {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
@@ -194,7 +196,6 @@ test namespace-7.7 {Bug 1655305} -setup {
|
||||
interp delete slave
|
||||
} -result {}
|
||||
|
||||
|
||||
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
|
||||
catch {interp delete test_interp}
|
||||
interp create test_interp
|
||||
@@ -303,15 +304,24 @@ test namespace-9.4 {Tcl_Import, simple import} {
|
||||
}
|
||||
test_ns_import::p
|
||||
} {cmd1: 123}
|
||||
test namespace-9.5 {Tcl_Import, RFE 1230597} {
|
||||
test namespace-9.5 {Tcl_Import, RFE 1230597} -setup {
|
||||
namespace eval test_ns_import {}
|
||||
namespace eval test_ns_export {}
|
||||
} -body {
|
||||
list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
|
||||
} {0 {}}
|
||||
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
|
||||
} -result {0 {}}
|
||||
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup {
|
||||
namespace eval test_ns_import {}
|
||||
namespace eval ::test_ns_export {
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
namespace export cmd1
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_import {
|
||||
namespace import -force ::test_ns_export::*
|
||||
cmd1 555
|
||||
}
|
||||
} {cmd1: 555}
|
||||
} -result {cmd1: 555}
|
||||
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_export {
|
||||
@@ -329,7 +339,6 @@ test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
|
||||
[test_ns_import::cmd1 g h i] \
|
||||
[test_ns_export::cmd1 j k l]
|
||||
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
|
||||
|
||||
test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
|
||||
namespace eval one {
|
||||
namespace export cmd
|
||||
@@ -354,7 +363,6 @@ test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
|
||||
} -cleanup {
|
||||
namespace delete one two three
|
||||
} -match glob -result *::one::cmd
|
||||
|
||||
test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
|
||||
namespace eval one {
|
||||
namespace export cmd
|
||||
@@ -388,7 +396,13 @@ test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
|
||||
namespace forget ::test_ns_export::wombat
|
||||
}
|
||||
} {}
|
||||
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
|
||||
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup {
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_import {
|
||||
namespace import ::test_ns_export::*
|
||||
proc p {} {return [cmd1 123]}
|
||||
@@ -398,8 +412,7 @@ test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
|
||||
lappend l [info commands ::test_ns_import::*]
|
||||
lappend l [catch {cmd1 777} msg] $msg
|
||||
}
|
||||
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
|
||||
|
||||
} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
|
||||
test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -417,7 +430,6 @@ test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
} -cleanup {
|
||||
namespace delete origin unrelated my
|
||||
}
|
||||
|
||||
test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -433,7 +445,6 @@ test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
} -cleanup {
|
||||
namespace delete origin my
|
||||
} -returnCodes error -match glob -result *
|
||||
|
||||
test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -450,7 +461,6 @@ test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
} -cleanup {
|
||||
namespace delete origin my your
|
||||
} -returnCodes error -match glob -result *
|
||||
|
||||
test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -471,7 +481,6 @@ test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
} -cleanup {
|
||||
namespace delete origin link link2 my
|
||||
} -returnCodes error -match glob -result *
|
||||
|
||||
test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -492,7 +501,6 @@ test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
} -cleanup {
|
||||
namespace delete origin link link2 my
|
||||
}
|
||||
|
||||
test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace eval origin {
|
||||
namespace export cmd
|
||||
@@ -514,29 +522,47 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
|
||||
namespace delete origin link link2 my
|
||||
} -returnCodes error -match glob -result *
|
||||
|
||||
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
|
||||
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
}
|
||||
list [namespace origin set] [namespace origin test_ns_export::cmd1]
|
||||
} {::set ::test_ns_export::cmd1}
|
||||
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
|
||||
} -result {::set ::test_ns_export::cmd1}
|
||||
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_import1 {
|
||||
namespace import ::test_ns_export::*
|
||||
namespace export *
|
||||
proc p {} {namespace origin cmd1}
|
||||
}
|
||||
list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
|
||||
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
|
||||
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
|
||||
} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1}
|
||||
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
}
|
||||
namespace eval test_ns_import1 {
|
||||
namespace import ::test_ns_export::*
|
||||
namespace export *
|
||||
proc p {} {namespace origin cmd1}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_import2 {
|
||||
namespace import ::test_ns_import1::*
|
||||
proc q {} {return [cmd1 123]}
|
||||
}
|
||||
list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
|
||||
} {{cmd1: 123} ::test_ns_export::cmd1}
|
||||
} -result {{cmd1: 123} ::test_ns_export::cmd1}
|
||||
|
||||
test namespace-12.1 {InvokeImportedCmd} {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
@@ -550,14 +576,23 @@ test namespace-12.1 {InvokeImportedCmd} {
|
||||
list [test_ns_import::cmd1]
|
||||
} {::test_ns_export}
|
||||
|
||||
test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
|
||||
test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_export {
|
||||
namespace export cmd1
|
||||
proc cmd1 {args} {namespace current}
|
||||
}
|
||||
namespace eval test_ns_import {
|
||||
namespace import ::test_ns_export::*
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_import {
|
||||
set l {}
|
||||
lappend l [info commands ::test_ns_import::*]
|
||||
namespace forget ::test_ns_export::cmd1
|
||||
lappend l [info commands ::test_ns_import::*]
|
||||
}
|
||||
} {::test_ns_import::cmd1 {}}
|
||||
} -result {::test_ns_import::cmd1 {}}
|
||||
test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
|
||||
# Will panic if still buggy
|
||||
namespace eval src {namespace export foo; proc foo {} {}}
|
||||
@@ -568,7 +603,7 @@ test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
|
||||
namespace delete src
|
||||
} {}
|
||||
|
||||
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
|
||||
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
variable v 10
|
||||
namespace eval test_ns_1::test_ns_2 {
|
||||
@@ -577,22 +612,41 @@ test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
|
||||
namespace eval test_ns_2 {
|
||||
variable v 30
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
|
||||
[lsort [namespace children :: test_ns_*]]
|
||||
}
|
||||
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
|
||||
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
|
||||
} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
|
||||
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
variable v 10
|
||||
namespace eval test_ns_1::test_ns_2 {
|
||||
variable v 20
|
||||
}
|
||||
namespace eval test_ns_2 {
|
||||
variable v 30
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
list [catch {set ::test_ns_777::v} msg] $msg \
|
||||
[catch {namespace children test_ns_777} msg] $msg
|
||||
}
|
||||
} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
|
||||
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
|
||||
} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
|
||||
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
variable v 10
|
||||
namespace eval test_ns_1::test_ns_2 {
|
||||
variable v 20
|
||||
}
|
||||
namespace eval test_ns_2 {
|
||||
variable v 30
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
list $v $test_ns_2::v
|
||||
}
|
||||
} {10 20}
|
||||
} -result {10 20}
|
||||
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
|
||||
namespace eval test_ns_1::test_ns_2 {
|
||||
namespace eval foo {}
|
||||
@@ -619,57 +673,72 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl
|
||||
[catch {namespace children test_ns_1} msg] $msg
|
||||
}
|
||||
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
|
||||
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
|
||||
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
|
||||
namespace eval test_ns_1::test_ns_2::foo {}
|
||||
} -body {
|
||||
namespace children test_ns_1:::
|
||||
} {::test_ns_1::test_ns_2}
|
||||
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
|
||||
} -result {::test_ns_1::test_ns_2}
|
||||
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
|
||||
namespace eval test_ns_1::test_ns_2::foo {}
|
||||
} -body {
|
||||
namespace children :::test_ns_1:::::test_ns_2:::
|
||||
} {::test_ns_1::test_ns_2::foo}
|
||||
} -result {::test_ns_1::test_ns_2::foo}
|
||||
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
||||
set l {}
|
||||
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
|
||||
namespace eval test_ns_1::test_ns_2 {variable {} 2525}
|
||||
lappend l [set test_ns_1::test_ns_2::]
|
||||
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
|
||||
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
||||
catch {unset test_ns_1::test_ns_2::}
|
||||
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
|
||||
namespace eval test_ns_1::test_ns_2::foo {}
|
||||
unset -nocomplain test_ns_1::test_ns_2::
|
||||
set l {}
|
||||
} -body {
|
||||
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
|
||||
set test_ns_1::test_ns_2:: 314159
|
||||
lappend l [set test_ns_1::test_ns_2::]
|
||||
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
|
||||
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
|
||||
} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
|
||||
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
|
||||
namespace eval test_ns_1::test_ns_2::foo {}
|
||||
catch {rename test_ns_1::test_ns_2:: {}}
|
||||
set l {}
|
||||
} -body {
|
||||
lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
|
||||
proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
|
||||
lappend l [test_ns_1::test_ns_2:: hello]
|
||||
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
|
||||
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
|
||||
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
|
||||
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
variable {}
|
||||
set test_ns_1::(x) y
|
||||
}
|
||||
set test_ns_1::(x)
|
||||
} y
|
||||
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
|
||||
} -result y
|
||||
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
|
||||
} {1 {can't create namespace "": only global namespace can have empty name}}
|
||||
} -returnCodes error -body {
|
||||
namespace eval test_ns_1 {
|
||||
proc {} {} {}
|
||||
namespace eval {} {}
|
||||
{}
|
||||
}
|
||||
} -result {can't create namespace "": only global namespace can have empty name}
|
||||
|
||||
test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
|
||||
test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_delete {
|
||||
namespace eval test_ns_delete2 {}
|
||||
proc cmd {args} {namespace current}
|
||||
}
|
||||
list [namespace delete ::test_ns_delete::test_ns_delete2] \
|
||||
[namespace children ::test_ns_delete]
|
||||
} {{} {}}
|
||||
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
|
||||
list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
|
||||
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
|
||||
} -result {{} {}}
|
||||
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body {
|
||||
namespace delete ::test_ns_delete::test_ns_delete2
|
||||
} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}
|
||||
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
|
||||
namespace eval test_ns_delete {
|
||||
namespace eval test_ns_delete2 {}
|
||||
@@ -685,17 +754,24 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
|
||||
}
|
||||
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
|
||||
|
||||
test namespace-16.1 {Tcl_FindCommand, absolute name found} {
|
||||
test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd {args} {return "[namespace current]::cmd: $args"}
|
||||
variable v "::test_ns_1::cmd"
|
||||
eval $v one
|
||||
}
|
||||
} {::test_ns_1::cmd: one}
|
||||
test namespace-16.2 {Tcl_FindCommand, absolute name found} {
|
||||
} -result {::test_ns_1::cmd: one}
|
||||
test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd {args} {return "[namespace current]::cmd: $args"}
|
||||
variable v "::test_ns_1::cmd"
|
||||
}
|
||||
} -body {
|
||||
eval $test_ns_1::v two
|
||||
} {::test_ns_1::cmd: two}
|
||||
} -result {::test_ns_1::cmd: two}
|
||||
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
|
||||
namespace eval test_ns_1 {
|
||||
variable v2 "::test_ns_1::ladidah"
|
||||
@@ -724,11 +800,16 @@ test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
|
||||
catch {rename unknown {}}
|
||||
catch {rename unknown.old unknown}
|
||||
|
||||
test namespace-16.8 {Tcl_FindCommand, relative name found} {
|
||||
test namespace-16.8 {Tcl_FindCommand, relative name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd {args} {return "[namespace current]::cmd: $args"}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
cmd a b c
|
||||
}
|
||||
} {::test_ns_1::cmd: a b c}
|
||||
} -result {::test_ns_1::cmd: a b c}
|
||||
test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
|
||||
proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
|
||||
namespace eval test_ns_1 {
|
||||
@@ -750,20 +831,22 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current
|
||||
} -cleanup {
|
||||
catch {rename cmd2 {}}
|
||||
} -result {::::cmd2: a b c}
|
||||
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
|
||||
test namespace-16.11 {Tcl_FindCommand, relative name not found} -body {
|
||||
namespace eval test_ns_1 {
|
||||
list [catch {cmd3 a b c} msg] $msg
|
||||
cmd3 a b c
|
||||
}
|
||||
} {1 {invalid command name "cmd3"}}
|
||||
} -returnCodes error -result {invalid command name "cmd3"}
|
||||
|
||||
catch {unset x}
|
||||
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
|
||||
unset -nocomplain x
|
||||
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
set x 314159
|
||||
namespace eval test_ns_1 {
|
||||
set ::x
|
||||
}
|
||||
} {314159}
|
||||
} -result {314159}
|
||||
variable ::x 314159
|
||||
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
|
||||
namespace eval test_ns_1 {
|
||||
variable x 777
|
||||
@@ -778,46 +861,54 @@ test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
|
||||
set ::test_ns_1::test_ns_2::x
|
||||
}
|
||||
} {1111}
|
||||
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
|
||||
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace eval test_ns_2 {
|
||||
variable x 1111
|
||||
}
|
||||
list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
|
||||
set ::test_ns_1::test_ns_2::y
|
||||
}
|
||||
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
|
||||
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
|
||||
} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable}
|
||||
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
|
||||
namespace eval ::test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace eval test_ns_3 {
|
||||
variable ::test_ns_1::test_ns_2::x 2222
|
||||
}
|
||||
}
|
||||
set ::test_ns_1::test_ns_2::x
|
||||
} {2222}
|
||||
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
|
||||
} -result {2222}
|
||||
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
|
||||
namespace eval test_ns_1 {
|
||||
variable x 777
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
set x
|
||||
}
|
||||
} {777}
|
||||
} -result {777}
|
||||
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
|
||||
namespace eval test_ns_1 {
|
||||
variable x 777
|
||||
unset x
|
||||
set x ;# must be global x now
|
||||
}
|
||||
} {314159}
|
||||
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
|
||||
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
|
||||
namespace eval test_ns_1 {
|
||||
list [catch {set wuzzat} msg] $msg
|
||||
set wuzzat
|
||||
}
|
||||
} {1 {can't read "wuzzat": no such variable}}
|
||||
} -returnCodes error -result {can't read "wuzzat": no such variable}
|
||||
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
|
||||
namespace eval test_ns_1 {
|
||||
variable a hello
|
||||
}
|
||||
set test_ns_1::a
|
||||
} {hello}
|
||||
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
|
||||
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
|
||||
namespace eval test_ns_1 {}
|
||||
} -body {
|
||||
proc test_ns {} {
|
||||
set ::test_ns_1::a 0
|
||||
}
|
||||
@@ -828,14 +919,15 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
|
||||
namespace eval test_ns_1 set a 1
|
||||
namespace delete test_ns_1
|
||||
return $a
|
||||
} 1
|
||||
} -result 1
|
||||
catch {unset a}
|
||||
catch {unset x}
|
||||
|
||||
catch {unset l}
|
||||
catch {rename foo {}}
|
||||
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
|
||||
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
proc foo {} {return "global foo"}
|
||||
namespace eval test_ns_1 {
|
||||
proc trigger {} {
|
||||
@@ -849,7 +941,7 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow
|
||||
proc foo {} {return "foo in test_ns_1"}
|
||||
}
|
||||
lappend l [test_ns_1::trigger]
|
||||
} {{global foo} {foo in test_ns_1}}
|
||||
} -result {{global foo} {foo in test_ns_1}}
|
||||
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
|
||||
namespace eval test_ns_2 {
|
||||
proc foo {} {return "foo in ::test_ns_2"}
|
||||
@@ -873,22 +965,31 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado
|
||||
catch {unset l}
|
||||
catch {rename foo {}}
|
||||
|
||||
test namespace-19.1 {GetNamespaceFromObj, global name found} {
|
||||
test namespace-19.1 {GetNamespaceFromObj, global name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
namespace children ::test_ns_1
|
||||
} {::test_ns_1::test_ns_2}
|
||||
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
|
||||
} -result {::test_ns_1::test_ns_2}
|
||||
test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace children test_ns_2
|
||||
}
|
||||
} {}
|
||||
test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
|
||||
} -result {}
|
||||
test namespace-19.3 {GetNamespaceFromObj, name not found} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace children test_ns_99
|
||||
}
|
||||
} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
|
||||
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
|
||||
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
proc foo {} {
|
||||
return [namespace children test_ns_2]
|
||||
@@ -900,7 +1001,7 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
|
||||
namespace delete test_ns_1::test_ns_2
|
||||
namespace eval test_ns_1::test_ns_2::test_ns_3 {}
|
||||
lappend l [test_ns_1::foo]
|
||||
} {{} ::test_ns_1::test_ns_2::test_ns_3}
|
||||
} -result {{} ::test_ns_1::test_ns_2::test_ns_3}
|
||||
|
||||
test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
@@ -913,24 +1014,34 @@ test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
|
||||
namespace ch :: test_ns_*
|
||||
} {}
|
||||
|
||||
test namespace-21.1 {NamespaceChildrenCmd, no args} {
|
||||
test namespace-21.1 {NamespaceChildrenCmd, no args} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
expr {"::test_ns_1" in [namespace children]}
|
||||
} -result {1}
|
||||
test namespace-21.2 {NamespaceChildrenCmd, no args} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
expr {[string first ::test_ns_1 [namespace children]] != -1}
|
||||
} {1}
|
||||
test namespace-21.2 {NamespaceChildrenCmd, no args} {
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace children
|
||||
}
|
||||
} {::test_ns_1::test_ns_2}
|
||||
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
|
||||
} -result {::test_ns_1::test_ns_2}
|
||||
test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace children ::test_ns_1
|
||||
} {::test_ns_1::test_ns_2}
|
||||
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
|
||||
} -result {::test_ns_1::test_ns_2}
|
||||
test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace children test_ns_2
|
||||
}
|
||||
} {}
|
||||
} -result {}
|
||||
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
|
||||
namespace eval test_ns_1 {
|
||||
list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
|
||||
@@ -940,10 +1051,13 @@ test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
|
||||
namespace eval test_ns_1::test_ns_foo {}
|
||||
namespace children test_ns_1 *f*
|
||||
} {::test_ns_1::test_ns_foo}
|
||||
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
|
||||
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
namespace eval test_ns_1::test_ns_2 {}
|
||||
} -body {
|
||||
namespace eval test_ns_1::test_ns_foo {}
|
||||
lsort [namespace children test_ns_1 test*]
|
||||
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
|
||||
} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
|
||||
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
|
||||
namespace eval test_ns_1 {}
|
||||
namespace children [namespace current] [fq test_ns_1]
|
||||
@@ -1038,15 +1152,25 @@ test namespace-25.3 {NamespaceEvalCmd, new namespace} {
|
||||
}
|
||||
test_ns_1::p
|
||||
} {314159}
|
||||
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
|
||||
test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup {
|
||||
namespace eval test_ns_1 {
|
||||
variable v 314159
|
||||
proc p {} {
|
||||
variable v
|
||||
return $v
|
||||
}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
proc q {} {return [expr {[p]+1}]}
|
||||
}
|
||||
test_ns_1::q
|
||||
} {314160}
|
||||
test namespace-25.5 {NamespaceEvalCmd, multiple args} {
|
||||
} -result {314160}
|
||||
test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup {
|
||||
namespace eval test_ns_1 {variable v 314159}
|
||||
} -body {
|
||||
namespace eval test_ns_1 "set" "v"
|
||||
} {314159}
|
||||
} -result {314159}
|
||||
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
|
||||
list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
|
||||
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
|
||||
@@ -1097,21 +1221,50 @@ test namespace-26.4 {NamespaceExportCmd, one pattern} {
|
||||
}
|
||||
list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
|
||||
} {::test_ns_2::cmd1 {cmd1: hello}}
|
||||
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
|
||||
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
proc cmd3 {args} {return "cmd3: $args"}
|
||||
proc cmd4 {args} {return "cmd4: $args"}
|
||||
namespace export cmd1 cmd3
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_2 {
|
||||
namespace import -force ::test_ns_1::*
|
||||
}
|
||||
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
|
||||
} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
|
||||
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
|
||||
} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
|
||||
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
proc cmd3 {args} {return "cmd3: $args"}
|
||||
proc cmd4 {args} {return "cmd4: $args"}
|
||||
namespace export cmd1 cmd3
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace export
|
||||
}
|
||||
} {cmd1 cmd3}
|
||||
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
|
||||
} -result {cmd1 cmd3}
|
||||
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
proc cmd3 {args} {return "cmd3: $args"}
|
||||
proc cmd4 {args} {return "cmd4: $args"}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
namespace export cmd1 cmd3
|
||||
}
|
||||
namespace eval test_ns_2 {
|
||||
namespace import ::test_ns_1::*
|
||||
}
|
||||
namespace eval test_ns_1 {
|
||||
namespace export -clear cmd4
|
||||
}
|
||||
@@ -1119,7 +1272,7 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
|
||||
namespace import ::test_ns_1::*
|
||||
}
|
||||
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
|
||||
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
|
||||
} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
|
||||
test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
|
||||
catch {namespace delete foo}
|
||||
namespace eval foo {
|
||||
@@ -1202,14 +1355,23 @@ test namespace-29.4 {NamespaceInscopeCmd, simple case} {
|
||||
}
|
||||
namespace inscope test_ns_1 cmd
|
||||
} {::test_ns_1::cmd: v=747, args=}
|
||||
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
|
||||
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup {
|
||||
namespace eval test_ns_1 {
|
||||
variable v 747
|
||||
proc cmd {args} {
|
||||
variable v
|
||||
return "[namespace current]::cmd: v=$v, args=$args"
|
||||
}
|
||||
}
|
||||
} -body {
|
||||
list [namespace inscope test_ns_1 cmd x y z] \
|
||||
[namespace eval test_ns_1 [concat cmd [list x y z]]]
|
||||
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
|
||||
test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
|
||||
} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
|
||||
test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup {
|
||||
namespace eval test_ns_1 {}
|
||||
} -body {
|
||||
namespace inscope test_ns_1 {info level 0}
|
||||
} {namespace inscope test_ns_1 {info level 0}}
|
||||
|
||||
} -result {namespace inscope test_ns_1 {info level 0}}
|
||||
|
||||
test namespace-30.1 {NamespaceOriginCmd, bad args} {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
@@ -1330,7 +1492,8 @@ test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
|
||||
test namespace-34.4 {NamespaceWhichCmd, bad args} {
|
||||
list [catch {namespace which a b} msg] $msg
|
||||
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
|
||||
test namespace-34.5 {NamespaceWhichCmd, command lookup} {
|
||||
test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
namespace export cmd*
|
||||
variable v1 111
|
||||
@@ -1343,6 +1506,7 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
|
||||
variable v2 222
|
||||
proc p {} {}
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_3 {
|
||||
namespace import ::test_ns_2::*
|
||||
variable v3 333
|
||||
@@ -1352,26 +1516,59 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
|
||||
[namespace which -command ::test_ns_2::cmd2] \
|
||||
[catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
|
||||
}
|
||||
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
|
||||
test namespace-34.6 {NamespaceWhichCmd, -command is default} {
|
||||
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
|
||||
test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
namespace export cmd*
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
}
|
||||
namespace eval test_ns_2 {
|
||||
namespace export *
|
||||
namespace import ::test_ns_1::*
|
||||
proc p {} {}
|
||||
}
|
||||
namespace eval test_ns_3 {
|
||||
namespace import ::test_ns_2::*
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_3 {
|
||||
list [namespace which foreach] \
|
||||
[namespace which p] \
|
||||
[namespace which cmd1] \
|
||||
[namespace which ::test_ns_2::cmd2]
|
||||
}
|
||||
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
|
||||
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
|
||||
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
|
||||
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
|
||||
catch {namespace delete {*}[namespace children test_ns_*]}
|
||||
namespace eval test_ns_1 {
|
||||
namespace export cmd*
|
||||
proc cmd1 {args} {return "cmd1: $args"}
|
||||
proc cmd2 {args} {return "cmd2: $args"}
|
||||
}
|
||||
namespace eval test_ns_2 {
|
||||
namespace export *
|
||||
namespace import ::test_ns_1::*
|
||||
variable v2 222
|
||||
proc p {} {}
|
||||
}
|
||||
namespace eval test_ns_3 {
|
||||
variable v3 333
|
||||
namespace import ::test_ns_2::*
|
||||
}
|
||||
} -body {
|
||||
namespace eval test_ns_3 {
|
||||
list [namespace which -variable env] \
|
||||
[namespace which -variable v3] \
|
||||
[namespace which -variable ::test_ns_2::v2] \
|
||||
[catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
|
||||
}
|
||||
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
|
||||
} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
|
||||
|
||||
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
|
||||
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
|
||||
catch {namespace delete {*}[namespace children :: test_ns_*]}
|
||||
} -body {
|
||||
namespace eval test_ns_1 {
|
||||
proc p {} {
|
||||
namespace delete [namespace current]
|
||||
@@ -1379,7 +1576,7 @@ test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
|
||||
}
|
||||
}
|
||||
test_ns_1::p
|
||||
} {::test_ns_1}
|
||||
} -result {::test_ns_1}
|
||||
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
|
||||
namespace eval test_ns_1 {
|
||||
proc q {} {
|
||||
@@ -2107,6 +2304,68 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
|
||||
rename a {}
|
||||
rename c {}
|
||||
}
|
||||
test namespace-50.5 {[4402cfa58c]} -setup {
|
||||
proc bar {ev} {}
|
||||
proc bingo {xx} {}
|
||||
namespace ensemble create -command launch -map {foo bar event bingo}
|
||||
set result {}
|
||||
} -body {
|
||||
catch {launch foo} m; lappend result $m
|
||||
catch {launch ev} m; lappend result $m
|
||||
catch {launch foo} m; lappend result $m
|
||||
} -cleanup {
|
||||
rename launch {}
|
||||
rename bingo {}
|
||||
rename bar {}
|
||||
} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}}
|
||||
test namespace-50.6 {[4402cfa58c]} -setup {
|
||||
proc target {x y} {}
|
||||
namespace ensemble create -command e2 -map {s2 target}
|
||||
namespace ensemble create -command e1 -map {s1 e2}
|
||||
set result {}
|
||||
} -body {
|
||||
set s s
|
||||
catch {e1 s1 s2 a} m; lappend result $m
|
||||
catch {e1 $s s2 a} m; lappend result $m
|
||||
catch {e1 s1 $s a} m; lappend result $m
|
||||
catch {e1 $s $s a} m; lappend result $m
|
||||
} -cleanup {
|
||||
rename e1 {}
|
||||
rename e2 {}
|
||||
rename target {}
|
||||
} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}}
|
||||
test namespace-50.7 {[4402cfa58c]} -setup {
|
||||
proc target {x y} {}
|
||||
namespace ensemble create -command e2 -map {s2 target}
|
||||
namespace ensemble create -command e1 -map {s1 e2} -parameters foo
|
||||
set result {}
|
||||
} -body {
|
||||
set s s
|
||||
catch {e1 s2 s1 a} m; lappend result $m
|
||||
catch {e1 $s s1 a} m; lappend result $m
|
||||
catch {e1 s2 $s a} m; lappend result $m
|
||||
catch {e1 $s $s a} m; lappend result $m
|
||||
} -cleanup {
|
||||
rename e1 {}
|
||||
rename e2 {}
|
||||
rename target {}
|
||||
} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
|
||||
test namespace-50.8 {[f961d7d1dd]} -setup {
|
||||
proc target {} {}
|
||||
namespace ensemble create -command e -map {s target} -parameters {{a b}}
|
||||
} -body {
|
||||
e
|
||||
} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup {
|
||||
rename e {}
|
||||
rename target {}
|
||||
}
|
||||
test namespace-50.9 {[cea0344a51]} -body {
|
||||
namespace eval foo {
|
||||
namespace eval bar {
|
||||
namespace delete foo
|
||||
}
|
||||
}
|
||||
} -returnCodes error -result {unknown namespace "foo" in namespace delete command}
|
||||
|
||||
test namespace-51.1 {name resolution path control} -body {
|
||||
namespace eval ::test_ns_1 {
|
||||
@@ -2928,6 +3187,22 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
|
||||
0 {1 v}\
|
||||
1 {wrong # args: should be "ns v x z2 a2"}\
|
||||
0 {2 v v2}}
|
||||
test namespace-53.11 {ensembles: nested rewrite} -setup {
|
||||
namespace eval ns {
|
||||
namespace export x
|
||||
namespace eval x {
|
||||
proc z2 {a1 a2} {list 2 $a1 $a2}
|
||||
namespace export z*
|
||||
namespace ensemble create -parameter p
|
||||
}
|
||||
namespace ensemble create
|
||||
}
|
||||
} -body {
|
||||
list [catch {ns x 1 z2} msg] $msg
|
||||
} -cleanup {
|
||||
namespace delete ns
|
||||
unset -nocomplain msg
|
||||
} -result {1 {wrong # args: should be "ns x 1 z2 a2"}}
|
||||
|
||||
test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
|
||||
-setup {
|
||||
@@ -2953,6 +3228,45 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
|
||||
test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
|
||||
info class [format %s constructor] oo::object
|
||||
} ""
|
||||
|
||||
test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
|
||||
namespace eval ::testing {
|
||||
proc abc {} {}
|
||||
proc def {} {}
|
||||
trace add command abc delete "rename ::testing::def {}; #"
|
||||
trace add command def delete "rename ::testing::abc {}; #"
|
||||
}
|
||||
namespace delete ::testing
|
||||
} {}
|
||||
test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
|
||||
namespace eval ::testing {
|
||||
namespace eval abc {proc xyz {} {}}
|
||||
namespace eval def {proc xyz {} {}}
|
||||
trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
|
||||
trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
|
||||
}
|
||||
namespace delete ::testing
|
||||
} {}
|
||||
test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
|
||||
namespace eval ::testing {
|
||||
variable gone {}
|
||||
oo::class create CB {
|
||||
variable cmd
|
||||
constructor other {set cmd $other}
|
||||
destructor {rename $cmd {}; lappend ::testing::gone $cmd}
|
||||
}
|
||||
namespace eval abc {
|
||||
::testing::CB create def ::testing::abc::ghi
|
||||
::testing::CB create ghi ::testing::abc::def
|
||||
}
|
||||
namespace delete abc
|
||||
try {
|
||||
return [lsort $gone]
|
||||
} finally {
|
||||
namespace delete ::testing
|
||||
}
|
||||
}
|
||||
} {::testing::abc::def ::testing::abc::ghi}
|
||||
|
||||
# cleanup
|
||||
catch {rename cmd1 {}}
|
||||
|
||||
@@ -2017,6 +2017,12 @@ test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
|
||||
test oo-16.1 {OO: object introspection} -body {
|
||||
info object
|
||||
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
|
||||
test oo-16.1.1 {OO: object introspection} -body {
|
||||
catch {info object} m o
|
||||
dict get $o -errorinfo
|
||||
} -result "wrong \# args: should be \"info object subcommand ?arg ...?\"
|
||||
while executing
|
||||
\"info object\""
|
||||
test oo-16.2 {OO: object introspection} -body {
|
||||
info object class NOTANOBJECT
|
||||
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
|
||||
@@ -2156,6 +2162,12 @@ test oo-16.14 {OO: object introspection: TIP #436} -setup {
|
||||
test oo-17.1 {OO: class introspection} -body {
|
||||
info class
|
||||
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
|
||||
test oo-17.1.1 {OO: class introspection} -body {
|
||||
catch {info class} m o
|
||||
dict get $o -errorinfo
|
||||
} -result "wrong \# args: should be \"info class subcommand ?arg ...?\"
|
||||
while executing
|
||||
\"info class\""
|
||||
test oo-17.2 {OO: class introspection} -body {
|
||||
info class superclass NOTANOBJECT
|
||||
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
|
||||
@@ -3412,6 +3424,38 @@ test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
|
||||
} -cleanup {
|
||||
foo destroy
|
||||
} -result {v t}
|
||||
test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
|
||||
oo::class create Super
|
||||
oo::class create Master {
|
||||
superclass Super
|
||||
variable member1 member2
|
||||
constructor {} {
|
||||
set member1 master1
|
||||
set member2 master2
|
||||
}
|
||||
method getChild {} {
|
||||
Child new [self]
|
||||
}
|
||||
}
|
||||
oo::class create Child {
|
||||
superclass Super
|
||||
variable member1 result
|
||||
constructor {m} {
|
||||
set [namespace current]::member1 child1
|
||||
set ns [info object namespace $m]
|
||||
namespace upvar $ns member1 l1 member2 l2
|
||||
upvar 1 member1 l3 member2 l4
|
||||
[format namespace] upvar $ns member1 l5 member2 l6
|
||||
[format upvar] 1 member1 l7 member2 l8
|
||||
set result [list $l1 $l2 $l3 $l4 $l5 $l6 $l7 $l8]
|
||||
}
|
||||
method result {} {return $result}
|
||||
}
|
||||
} -body {
|
||||
[[Master new] getChild] result
|
||||
} -cleanup {
|
||||
Super destroy
|
||||
} -result {master1 master2 master1 master2 master1 master2 master1 master2}
|
||||
|
||||
# A feature that's not supported because the mechanism may change without
|
||||
# warning, but is supposed to work...
|
||||
|
||||
+10
-3
@@ -13,7 +13,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require tcltest
|
||||
package require tcltest 2
|
||||
namespace import ::tcltest::*
|
||||
|
||||
::tcltest::loadTestedCommands
|
||||
@@ -37,7 +37,7 @@ proc getArgs args {
|
||||
global argv
|
||||
set argv $args
|
||||
}
|
||||
|
||||
|
||||
# Basic argument parsing.
|
||||
|
||||
test parseOld-1.1 {basic argument parsing} {
|
||||
@@ -296,6 +296,7 @@ test parseOld-8.4 {semi-colons} {
|
||||
# The following checks are to ensure that the interpreter's result
|
||||
# gets re-initialized by Tcl_Eval in all the right places.
|
||||
|
||||
set a 22
|
||||
test parseOld-9.1 {result initialization} {concat abc} abc
|
||||
test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}
|
||||
test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}
|
||||
@@ -408,6 +409,8 @@ test parseOld-11.7 {long values} {
|
||||
set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
|
||||
llength $b
|
||||
} 43
|
||||
# Duplicate action of previous test
|
||||
llength [set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]]
|
||||
test parseOld-11.8 {long values} {
|
||||
set b
|
||||
} $a
|
||||
@@ -538,8 +541,12 @@ test parseOld-15.4 {TclScriptEnd procedure} {
|
||||
test parseOld-15.5 {TclScriptEnd procedure} {
|
||||
info complete "xyz \[abc"
|
||||
} {0}
|
||||
|
||||
|
||||
# cleanup
|
||||
set argv $savedArgv
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
+2
-2
@@ -19,7 +19,7 @@ testConstraint reg 0
|
||||
if {[testConstraint win]} {
|
||||
if {![catch {
|
||||
::tcltest::loadTestedCommands
|
||||
set ::regver [package require registry 1.3.1]
|
||||
set ::regver [package require registry 1.3.2]
|
||||
}]} {
|
||||
testConstraint reg 1
|
||||
}
|
||||
@@ -33,7 +33,7 @@ testConstraint english [expr {
|
||||
|
||||
test registry-1.0 {check if we are testing the right dll} {win reg} {
|
||||
set ::regver
|
||||
} {1.3.1}
|
||||
} {1.3.2}
|
||||
test registry-1.1 {argument parsing for registry command} {win reg} {
|
||||
list [catch {registry} msg] $msg
|
||||
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
|
||||
|
||||
@@ -135,6 +135,9 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
|
||||
z
|
||||
}
|
||||
}
|
||||
namespace eval :: {
|
||||
variable r2 ""
|
||||
}
|
||||
} -constraints testinterpresolver -body {
|
||||
set r0 [namespace eval ::ns2 {x}]
|
||||
set r1 [namespace eval ::ns2 {z}]
|
||||
|
||||
+6
-14
@@ -211,8 +211,8 @@ test safe-7.3 {check that safe subinterpreters work} {
|
||||
} {ok {} 0}
|
||||
|
||||
# test source control on file name
|
||||
set i "a"
|
||||
test safe-8.1 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
} -body {
|
||||
safe::interpCreate $i
|
||||
@@ -221,7 +221,6 @@ test safe-8.1 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "source ?-encoding E? fileName"}
|
||||
test safe-8.2 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
} -body {
|
||||
safe::interpCreate $i
|
||||
@@ -230,7 +229,6 @@ test safe-8.2 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "source ?-encoding E? fileName"}
|
||||
test safe-8.3 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set log {}
|
||||
proc safe-test-log {str} {lappend ::log $str}
|
||||
@@ -245,7 +243,6 @@ test safe-8.3 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
|
||||
test safe-8.4 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set log {}
|
||||
proc safe-test-log {str} {global log; lappend log $str}
|
||||
@@ -260,7 +257,6 @@ test safe-8.4 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
|
||||
test safe-8.5 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set log {}
|
||||
proc safe-test-log {str} {global log; lappend log $str}
|
||||
@@ -279,7 +275,6 @@ test safe-8.5 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
|
||||
test safe-8.6 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set log {}
|
||||
proc safe-test-log {str} {global log; lappend log $str}
|
||||
@@ -296,7 +291,6 @@ test safe-8.6 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
|
||||
test safe-8.7 {safe source control on file} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set log {}
|
||||
proc safe-test-log {str} {global log; lappend log $str}
|
||||
@@ -315,7 +309,6 @@ test safe-8.7 {safe source control on file} -setup {
|
||||
safe::interpDelete $i
|
||||
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
|
||||
test safe-8.8 {safe source forbids -rsrc} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
safe::interpCreate $i
|
||||
} -body {
|
||||
@@ -349,8 +342,8 @@ test safe-8.10 {safe source and return} -setup {
|
||||
removeFile $returnScript
|
||||
} -result ok
|
||||
|
||||
set i "a"
|
||||
test safe-9.1 {safe interps' deleteHook} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set res {}
|
||||
} -body {
|
||||
@@ -365,7 +358,6 @@ test safe-9.1 {safe interps' deleteHook} -setup {
|
||||
list [interp eval $i exit] $res
|
||||
} -result {{} {arg1 arg2 a}}
|
||||
test safe-9.2 {safe interps' error in deleteHook} -setup {
|
||||
set i "a"
|
||||
catch {safe::interpDelete $i}
|
||||
set res {}
|
||||
set log {}
|
||||
@@ -531,14 +523,14 @@ test safe-11.7.1 {testing safe encoding} -setup {
|
||||
} -body {
|
||||
catch {interp eval $i encoding convertfrom} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
} -returnCodes ok -match glob -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
|
||||
while executing
|
||||
"encoding convertfrom"
|
||||
invoked from within
|
||||
"::interp invokehidden interp1 encoding convertfrom"
|
||||
"::interp invokehidden interp* encoding convertfrom"
|
||||
invoked from within
|
||||
"encoding convertfrom"
|
||||
invoked from within
|
||||
@@ -555,14 +547,14 @@ test safe-11.8.1 {testing safe encoding} -setup {
|
||||
} -body {
|
||||
catch {interp eval $i encoding convertto} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
} -returnCodes ok -match glob -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertto ?encoding? data"
|
||||
while executing
|
||||
"encoding convertto"
|
||||
invoked from within
|
||||
"::interp invokehidden interp1 encoding convertto"
|
||||
"::interp invokehidden interp* encoding convertto"
|
||||
invoked from within
|
||||
"encoding convertto"
|
||||
invoked from within
|
||||
|
||||
+3
-1
@@ -14,7 +14,7 @@
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
if {[lsearch [namespace children] ::tcltest] == -1} {
|
||||
package require tcltest
|
||||
package require tcltest 2
|
||||
namespace import -force ::tcltest::*
|
||||
}
|
||||
|
||||
@@ -865,6 +865,8 @@ test set-old-10.13 {array enumeration errors} {
|
||||
list [catch {array done a b c} msg] $msg
|
||||
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
|
||||
test set-old-10.14 {array enumeration errors} {
|
||||
catch {unset a}
|
||||
set a(a) a
|
||||
list [catch {array done a b} msg] $msg
|
||||
} {1 {illegal search identifier "b"}}
|
||||
test set-old-10.15 {array enumeration errors} {
|
||||
|
||||
+71
-42
@@ -22,7 +22,7 @@ testConstraint testset2 [llength [info commands testset2]]
|
||||
|
||||
catch {unset x}
|
||||
catch {unset i}
|
||||
|
||||
|
||||
test set-1.1 {TclCompileSetCmd: missing variable name} {
|
||||
list [catch {set} msg] $msg
|
||||
} {1 {wrong # args: should be "set varName ?newValue?"}}
|
||||
@@ -39,16 +39,18 @@ test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
|
||||
set i 17
|
||||
list [set "i"] $i
|
||||
} {17 17}
|
||||
test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
|
||||
test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup {
|
||||
catch {unset {a simple var}}
|
||||
} -body {
|
||||
set {a simple var} 27
|
||||
list [set {a simple var}] ${a simple var}
|
||||
} {27 27}
|
||||
test set-1.6 {TclCompileSetCmd: simple array variable name} {
|
||||
} -result {27 27}
|
||||
test set-1.6 {TclCompileSetCmd: simple array variable name} -setup {
|
||||
catch {unset a}
|
||||
} -body {
|
||||
set a(foo) 37
|
||||
list [set a(foo)] $a(foo)
|
||||
} {37 37}
|
||||
} -result {37 37}
|
||||
test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
|
||||
set x "i"
|
||||
set i 77
|
||||
@@ -149,22 +151,24 @@ test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
|
||||
}
|
||||
260locals
|
||||
} {1234}
|
||||
test set-1.15 {TclCompileSetCmd: variable is array} {
|
||||
test set-1.15 {TclCompileSetCmd: variable is array} -setup {
|
||||
catch {unset a}
|
||||
} -body {
|
||||
set x 27
|
||||
set x [set a(foo) 11]
|
||||
catch {unset a}
|
||||
set x
|
||||
} 11
|
||||
test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
|
||||
} -result 11
|
||||
test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup {
|
||||
catch {unset a}
|
||||
} -body {
|
||||
set i 5
|
||||
set x 789
|
||||
set a(foo5) 27
|
||||
set x [set a(foo$i)]
|
||||
catch {unset a}
|
||||
set x
|
||||
} 27
|
||||
} -result 27
|
||||
|
||||
test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
|
||||
set i 5
|
||||
@@ -211,7 +215,7 @@ test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
|
||||
test set-1.26 {TclCompileSetCmd: various array constructs} {
|
||||
# Test all kinds of array constructs that TclCompileSetCmd
|
||||
# may feel inclined to tamper with.
|
||||
proc p {} {
|
||||
apply {{} {
|
||||
set a x
|
||||
set be(hej) 1 ; # hej
|
||||
set be($a) 1 ; # x
|
||||
@@ -230,28 +234,33 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
|
||||
set [string range bet 0 1](foo) 1 ; # foo
|
||||
set be([set be(a:$a)][set b\e($a)]) 1 ; # 51
|
||||
return [lsort [array names be]]
|
||||
}
|
||||
p
|
||||
}}
|
||||
} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
|
||||
{b c} foo 51}]; # " just a matching end quote
|
||||
|
||||
test set-2.1 {set command: runtime error, bad variable name} {
|
||||
test set-2.1 {set command: runtime error, bad variable name} -setup {
|
||||
unset -nocomplain {"foo}
|
||||
} -body {
|
||||
list [catch {set {"foo}} msg] $msg $::errorInfo
|
||||
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
|
||||
} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
|
||||
while executing
|
||||
"set {"foo}"}}
|
||||
test set-2.2 {set command: runtime error, not array variable} {
|
||||
catch {unset b}
|
||||
# Stop my editor highlighter " from being confused
|
||||
test set-2.2 {set command: runtime error, not array variable} -setup {
|
||||
unset -nocomplain b
|
||||
} -body {
|
||||
set b 44
|
||||
list [catch {set b(123)} msg] $msg
|
||||
} {1 {can't read "b(123)": variable isn't array}}
|
||||
test set-2.3 {set command: runtime error, errors in reading variables} {
|
||||
catch {unset a}
|
||||
} -result {1 {can't read "b(123)": variable isn't array}}
|
||||
test set-2.3 {set command: runtime error, errors in reading variables} -setup {
|
||||
unset -nocomplain a
|
||||
} -body {
|
||||
set a(6) 44
|
||||
list [catch {set a(18)} msg] $msg
|
||||
} {1 {can't read "a(18)": no such element in array}}
|
||||
test set-2.4 {set command: runtime error, readonly variable} -body {
|
||||
} -result {1 {can't read "a(18)": no such element in array}}
|
||||
test set-2.4 {set command: runtime error, readonly variable} -setup {
|
||||
unset -nocomplain x
|
||||
} -body {
|
||||
proc readonly args {error "variable is read-only"}
|
||||
set x 123
|
||||
trace var x w readonly
|
||||
@@ -260,12 +269,18 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
|
||||
while executing
|
||||
*
|
||||
"set x 1"}}
|
||||
test set-2.5 {set command: runtime error, basic array operations} {
|
||||
test set-2.5 {set command: runtime error, basic array operations} -setup {
|
||||
unset -nocomplain a
|
||||
} -body {
|
||||
array set a {}
|
||||
list [catch {set a(other)} msg] $msg
|
||||
} {1 {can't read "a(other)": no such element in array}}
|
||||
test set-2.6 {set command: runtime error, basic array operations} {
|
||||
} -result {1 {can't read "a(other)": no such element in array}}
|
||||
test set-2.6 {set command: runtime error, basic array operations} -setup {
|
||||
unset -nocomplain a
|
||||
} -body {
|
||||
array set a {}
|
||||
list [catch {set a} msg] $msg
|
||||
} {1 {can't read "a": variable is array}}
|
||||
} -result {1 {can't read "a": variable is array}}
|
||||
|
||||
# Test the uncompiled version of set
|
||||
|
||||
@@ -479,25 +494,29 @@ test set-3.24 {uncompiled set command: too many arguments} {
|
||||
$z msg
|
||||
} {wrong # args: should be "set varName ?newValue?"}
|
||||
|
||||
test set-4.1 {uncompiled set command: runtime error, bad variable name} {
|
||||
test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
|
||||
unset -nocomplain {"foo}
|
||||
} -body {
|
||||
set z set
|
||||
list [catch {$z {"foo}} msg] $msg $::errorInfo
|
||||
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
|
||||
} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
|
||||
while executing
|
||||
"$z {"foo}"}}
|
||||
test set-4.2 {uncompiled set command: runtime error, not array variable} {
|
||||
set z set
|
||||
# Stop my editor highlighter " from being confused
|
||||
test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
|
||||
catch {unset b}
|
||||
} -body {
|
||||
set z set
|
||||
$z b 44
|
||||
list [catch {$z b(123)} msg] $msg
|
||||
} {1 {can't read "b(123)": variable isn't array}}
|
||||
test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
|
||||
set z set
|
||||
catch {unset a}
|
||||
} -result {1 {can't read "b(123)": variable isn't array}}
|
||||
test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
|
||||
catch {unset a}
|
||||
} -body {
|
||||
set z set
|
||||
$z a(6) 44
|
||||
list [catch {$z a(18)} msg] $msg
|
||||
} {1 {can't read "a(18)": no such element in array}}
|
||||
} -result {1 {can't read "a(18)": no such element in array}}
|
||||
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
|
||||
set z set
|
||||
proc readonly args {error "variable is read-only"}
|
||||
@@ -508,27 +527,33 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
|
||||
while executing
|
||||
*
|
||||
"$z x 1"}}
|
||||
test set-4.5 {uncompiled set command: runtime error, basic array operations} {
|
||||
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
|
||||
unset -nocomplain a
|
||||
array set a {}
|
||||
} -body {
|
||||
set z set
|
||||
list [catch {$z a(other)} msg] $msg
|
||||
} {1 {can't read "a(other)": no such element in array}}
|
||||
test set-4.6 {set command: runtime error, basic array operations} {
|
||||
} -result {1 {can't read "a(other)": no such element in array}}
|
||||
test set-4.6 {set command: runtime error, basic array operations} -setup {
|
||||
unset -nocomplain a
|
||||
array set a {}
|
||||
} -body {
|
||||
set z set
|
||||
list [catch {$z a} msg] $msg
|
||||
} {1 {can't read "a": variable is array}}
|
||||
} -result {1 {can't read "a": variable is array}}
|
||||
|
||||
test set-5.1 {error on malformed array name} testset2 {
|
||||
test set-5.1 {error on malformed array name} -constraints testset2 -setup {
|
||||
unset -nocomplain z
|
||||
} -body {
|
||||
catch {testset2 z(a) b} msg
|
||||
catch {testset2 z(b) a} msg1
|
||||
list $msg $msg1
|
||||
} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
|
||||
|
||||
} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
|
||||
# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
|
||||
test set-5.2 {Bug 3602706} -body {
|
||||
testset2 ::tcl_platform not-in-there
|
||||
} -returnCodes error -result * -match glob
|
||||
|
||||
|
||||
# cleanup
|
||||
catch {unset a}
|
||||
catch {unset b}
|
||||
@@ -537,3 +562,7 @@ catch {unset x}
|
||||
catch {unset z}
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
@@ -1782,7 +1782,6 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
|
||||
set i 0
|
||||
vwait x
|
||||
close $f
|
||||
thread::wait
|
||||
}]]
|
||||
set port [thread::send $serverthread {set listen}]
|
||||
set s [socket $localhost $port]
|
||||
|
||||
+6
-1
@@ -46,6 +46,7 @@ makeFile {
|
||||
|
||||
cd [temporaryDirectory]
|
||||
testConstraint exec [llength [info commands exec]]
|
||||
|
||||
# test -help
|
||||
# Child processes because -help [exit]s.
|
||||
test tcltest-1.1 {tcltest -help} {exec} {
|
||||
@@ -1824,9 +1825,13 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
|
||||
---- errorInfo: body error
|
||||
*
|
||||
---- errorInfo(cleanup): cleanup error*}
|
||||
|
||||
|
||||
cleanupTests
|
||||
}
|
||||
|
||||
namespace delete ::tcltest::test
|
||||
return
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
+119
-51
@@ -45,6 +45,14 @@ testConstraint teststaticpkg [llength [info commands teststaticpkg]]
|
||||
testConstraint testsimplefilesystem \
|
||||
[llength [info commands testsimplefilesystem]]
|
||||
|
||||
proc loadIfNotPresent {pkg args} {
|
||||
global testDir ext
|
||||
set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
|
||||
if {[string totitle $pkg] ni $loaded} {
|
||||
load [file join $testDir $pkg$ext]
|
||||
}
|
||||
}
|
||||
|
||||
# Basic tests: parameter testing...
|
||||
test unload-1.1 {basic errors} -returnCodes error -body {
|
||||
unload
|
||||
@@ -73,7 +81,7 @@ set pkgua_detached {}
|
||||
set pkgua_unloaded {}
|
||||
# Tests for loading/unloading in trusted (non-safe) interpreters...
|
||||
test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
|
||||
load [file join $testDir pkga$ext]
|
||||
loadIfNotPresent pkga
|
||||
list [pkga_eq abc def] [lsort [info commands pkga_*]]
|
||||
} {0 {pkga_eq pkga_quote}}
|
||||
test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
|
||||
@@ -82,28 +90,43 @@ test unload-2.2 {basic loading of unloadable package, with guess for package nam
|
||||
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
|
||||
$pkgua_loaded $pkgua_detached $pkgua_unloaded
|
||||
} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
|
||||
test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
|
||||
list [catch {unload [file join $testDir pkga$ext]} msg] \
|
||||
[string map [list [file join $testDir pkga$ext] file] $msg]
|
||||
} {1 {file "file" cannot be unloaded under a trusted interpreter}}
|
||||
test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
|
||||
test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup {
|
||||
loadIfNotPresent pkga
|
||||
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
|
||||
unload [file join $testDir pkga$ext]
|
||||
} -result {file "*" cannot be unloaded under a trusted interpreter}
|
||||
test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup {
|
||||
loadIfNotPresent pkgua
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
|
||||
[unload [file join $testDir pkgua$ext]] \
|
||||
[info commands pkgua_*] \
|
||||
$pkgua_loaded $pkgua_detached $pkgua_unloaded
|
||||
} {. {} {} {} {} . . .}
|
||||
test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
|
||||
} -result {. {} {} {} {} . . .}
|
||||
test unload-2.5 {reloading of unloaded package, with guess for package name} -setup {
|
||||
if {$pkgua_loaded eq ""} {
|
||||
loadIfNotPresent pkgua
|
||||
unload [file join $testDir pkgua$ext]
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
|
||||
[load [file join $testDir pkgua$ext]] \
|
||||
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
|
||||
$pkgua_loaded $pkgua_detached $pkgua_unloaded
|
||||
} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
|
||||
test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
|
||||
} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
|
||||
test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup {
|
||||
# Establish expected state
|
||||
if {$pkgua_loaded eq ""} {
|
||||
loadIfNotPresent pkgua
|
||||
unload [file join $testDir pkgua$ext]
|
||||
load [file join $testDir pkgua$ext]
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
|
||||
[unload [file join $testDir pkgua$ext]] \
|
||||
[info commands pkgua_*] \
|
||||
$pkgua_loaded $pkgua_detached $pkgua_unloaded
|
||||
} {.. . . {} {} .. .. ..}
|
||||
} -result {.. . . {} {} .. .. ..}
|
||||
|
||||
# Tests for loading/unloading in safe interpreters...
|
||||
interp create -safe child
|
||||
@@ -127,38 +150,52 @@ test unload-3.2 {basic loading of unloadable package in a safe interpreter, with
|
||||
[lsort [child eval info commands pkgua_*]] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
|
||||
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
|
||||
[list $dll $loaded] {
|
||||
list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
|
||||
[string map [list [file join $testDir pkga$ext] file] $msg]
|
||||
} {1 {file "file" has never been loaded in this interpreter}}
|
||||
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
|
||||
[string map [list [file join $testDir pkgb$ext] file] $msg]
|
||||
} {1 {file "file" cannot be unloaded under a safe interpreter}}
|
||||
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
|
||||
loadIfNotPresent pkga
|
||||
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
|
||||
unload [file join $testDir pkga$ext] {} child
|
||||
} -result {file "*" has never been loaded in this interpreter}
|
||||
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
|
||||
if {[lsearch -index 1 [info loaded child] Pkgb] == -1} {
|
||||
load [file join $testDir pkgb$ext] pKgB child
|
||||
}
|
||||
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
|
||||
unload [file join $testDir pkgb$ext] {} child
|
||||
} -result {file "*" cannot be unloaded under a safe interpreter}
|
||||
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
|
||||
if {[lsearch -index 1 [info loaded child] Pkgua] == -1} {
|
||||
load [file join $testDir pkgua$ext] pkgua child
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[unload [file join $testDir pkgua$ext] {} child] \
|
||||
[child eval info commands pkgua_*] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{. {} {}} {} {} {. . .}}
|
||||
test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
} -result {{. {} {}} {} {} {. . .}}
|
||||
test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup {
|
||||
if {[child eval set pkgua_loaded] eq ""} {
|
||||
load [file join $testDir pkgua$ext] {} child
|
||||
unload [file join $testDir pkgua$ext] {} child
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[load [file join $testDir pkgua$ext] {} child] \
|
||||
[child eval pkgua_eq abc def] \
|
||||
[lsort [child eval info commands pkgua_*]] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
|
||||
test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
|
||||
[list $dll $loaded] {
|
||||
} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
|
||||
test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup {
|
||||
if {[child eval set pkgua_loaded] eq ""} {
|
||||
load [file join $testDir pkgua$ext] {} child
|
||||
unload [file join $testDir pkgua$ext] {} child
|
||||
load [file join $testDir pkgua$ext] {} child
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[unload [file join $testDir pkgua$ext] pKgUa child] \
|
||||
[child eval info commands pkgua_*] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{.. . .} {} {} {.. .. ..}}
|
||||
} -result {{.. . .} {} {} {.. .. ..}}
|
||||
|
||||
# Tests for loading/unloading of a package among multiple interpreters...
|
||||
interp create child-trusted
|
||||
@@ -167,56 +204,89 @@ child-trusted eval {
|
||||
set pkgua_detached {}
|
||||
set pkgua_unloaded {}
|
||||
}
|
||||
array set load {M 0 C 0 T 0}
|
||||
## Load package in main trusted interpreter...
|
||||
test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup {
|
||||
set pkgua_loaded ""
|
||||
set pkgua_detached ""
|
||||
set pkgua_unloaded ""
|
||||
incr load(M)
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
|
||||
[load [file join $testDir pkgua$ext]] \
|
||||
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
|
||||
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
|
||||
} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
|
||||
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
|
||||
## Load package in child-safe interpreter...
|
||||
test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
|
||||
child eval {
|
||||
set pkgua_loaded ""
|
||||
set pkgua_detached ""
|
||||
set pkgua_unloaded ""
|
||||
}
|
||||
incr load(C)
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[load [file join $testDir pkgua$ext] pKgUA child] \
|
||||
[child eval pkgua_eq abc def] \
|
||||
[lsort [child eval info commands pkgua_*]] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
|
||||
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
|
||||
## Load package in child-trusted interpreter...
|
||||
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
|
||||
incr load(T)
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[load [file join $testDir pkgua$ext] pkguA child-trusted] \
|
||||
[child-trusted eval pkgua_eq abc def] \
|
||||
[lsort [child-trusted eval info commands pkgua_*]] \
|
||||
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
|
||||
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
|
||||
## Unload the package from the main trusted interpreter...
|
||||
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
|
||||
if {!$load(M)} {
|
||||
load [file join $testDir pkgua$ext]
|
||||
}
|
||||
if {!$load(C)} {
|
||||
load [file join $testDir pkgua$ext] {} child
|
||||
incr load(C)
|
||||
}
|
||||
if {!$load(T)} {
|
||||
load [file join $testDir pkgua$ext] {} child-trusted
|
||||
incr load(T)
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
|
||||
[unload [file join $testDir pkgua$ext]] \
|
||||
[info commands pkgua_*] \
|
||||
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
|
||||
} {{... .. ..} {} {} {... ... ..}}
|
||||
} -result {{. {} {}} {} {} {. . {}}}
|
||||
## Unload the package from the child safe interpreter...
|
||||
test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
|
||||
if {!$load(C)} {
|
||||
load [file join $testDir pkgua$ext] {} child
|
||||
}
|
||||
if {!$load(T)} {
|
||||
load [file join $testDir pkgua$ext] {} child-trusted
|
||||
incr load(T)
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[unload [file join $testDir pkgua$ext] {} child] \
|
||||
[child eval info commands pkgua_*] \
|
||||
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{... .. ..} {} {} {... ... ..}}
|
||||
} -result {{. {} {}} {} {} {. . {}}}
|
||||
## Unload the package from the child trusted interpreter...
|
||||
test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
|
||||
[list $dll $loaded] {
|
||||
test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
|
||||
if {!$load(T)} {
|
||||
load [file join $testDir pkgua$ext] {} child-trusted
|
||||
}
|
||||
} -constraints [list $dll $loaded] -body {
|
||||
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
|
||||
[unload [file join $testDir pkgua$ext] {} child-trusted] \
|
||||
[child-trusted eval info commands pkgua_*] \
|
||||
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
|
||||
} {{. {} {}} {} {} {. . .}}
|
||||
} -result {{. {} {}} {} {} {. . .}}
|
||||
|
||||
test unload-5.1 {unload a module loaded from vfs} \
|
||||
-constraints [list $dll $loaded testsimplefilesystem] \
|
||||
@@ -230,9 +300,7 @@ test unload-5.1 {unload a module loaded from vfs} \
|
||||
list [catch {unload simplefs:/pkgua$ext} msg] $msg
|
||||
} \
|
||||
-result {0 {}}
|
||||
|
||||
|
||||
|
||||
|
||||
# cleanup
|
||||
interp delete child
|
||||
interp delete child-trusted
|
||||
|
||||
+35
-17
@@ -44,10 +44,12 @@ test var-1.1 {TclLookupVar, Array handling} -setup {
|
||||
set arr(foo) 37
|
||||
list [$x i] $i [$x arr(foo)] $arr(foo)
|
||||
} -result {11 11 38 38}
|
||||
set ::x "global value"
|
||||
namespace eval test_ns_var {
|
||||
variable x "namespace value"
|
||||
}
|
||||
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
|
||||
set x "global value"
|
||||
namespace eval test_ns_var {
|
||||
variable x "namespace value"
|
||||
proc p {} {
|
||||
global x ;# specifies TCL_GLOBAL_ONLY to get global x
|
||||
return $x
|
||||
@@ -167,7 +169,9 @@ test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array:
|
||||
set result
|
||||
}
|
||||
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
|
||||
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
|
||||
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
|
||||
unset -nocomplain test_ns_var::x
|
||||
} -body {
|
||||
namespace eval test_ns_var {
|
||||
variable result {}
|
||||
variable x
|
||||
@@ -179,7 +183,7 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
|
||||
namespace delete [namespace current]
|
||||
set result
|
||||
}
|
||||
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
|
||||
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
|
||||
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
|
||||
[format set] thisvar(doesntexist)
|
||||
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
|
||||
@@ -261,6 +265,7 @@ test var-3.7 {MakeUpvar, my var has ::s} -setup {
|
||||
}
|
||||
} -result {789789}
|
||||
test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
|
||||
upvar #0 aaaaa xxxxx
|
||||
catch {unset aaaaa}
|
||||
catch {unset xxxxx}
|
||||
} -body {
|
||||
@@ -274,6 +279,8 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
|
||||
} -returnCodes error -body {
|
||||
set aaaaa 789789
|
||||
upvar #0 aaaaa test_ns_fred::lnk
|
||||
} -cleanup {
|
||||
unset ::aaaaa
|
||||
} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
|
||||
test var-3.10 {MakeUpvar, between namespaces} -body {
|
||||
namespace eval {} {
|
||||
@@ -282,8 +289,6 @@ test var-3.10 {MakeUpvar, between namespaces} -body {
|
||||
set foo::bar 1
|
||||
list $bar $foo::bar
|
||||
}
|
||||
} -cleanup {
|
||||
unset ::aaaaa
|
||||
} -result {1 1}
|
||||
test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
|
||||
catch {unset aaaaa}
|
||||
@@ -322,9 +327,11 @@ test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
|
||||
namespace which -variable martha
|
||||
}
|
||||
} {::test_ns_var::martha}
|
||||
test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
|
||||
test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
|
||||
namespace eval test_ns_var {variable martha}
|
||||
} -body {
|
||||
namespace which -variable test_ns_var::martha
|
||||
} {::test_ns_var::martha}
|
||||
} -result {::test_ns_var::martha}
|
||||
|
||||
test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
|
||||
namespace eval test_ns_var {
|
||||
@@ -348,6 +355,7 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
|
||||
test_ns_var::p
|
||||
} {java}
|
||||
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
|
||||
namespace eval ::test_ns_var::test_ns_nested {}
|
||||
set ::test_ns_var::test_ns_nested:: 24
|
||||
apply {{} {
|
||||
global ::test_ns_var::test_ns_nested::
|
||||
@@ -389,20 +397,26 @@ test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
|
||||
}
|
||||
list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
|
||||
} {0 1 {can't read "test_ns_var::two": no such variable}}
|
||||
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
|
||||
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
|
||||
catch {namespace delete test_ns_var}
|
||||
namespace eval test_ns_var {variable one 1}
|
||||
} -body {
|
||||
namespace eval test_ns_var {
|
||||
variable two 2
|
||||
}
|
||||
list [lsort [info vars test_ns_var::*]] \
|
||||
[namespace eval test_ns_var {set two}]
|
||||
} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
|
||||
test var-7.4 {Tcl_VariableObjCmd, list of vars} {
|
||||
} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
|
||||
test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
|
||||
catch {namespace delete test_ns_var}
|
||||
namespace eval test_ns_var {variable one 1; variable two 2}
|
||||
} -body {
|
||||
namespace eval test_ns_var {
|
||||
variable three 3 four 4
|
||||
}
|
||||
list [lsort [info vars test_ns_var::*]] \
|
||||
[namespace eval test_ns_var {expr $three+$four}]
|
||||
} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
|
||||
} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
|
||||
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
|
||||
catch {unset a}
|
||||
catch {unset five}
|
||||
@@ -476,7 +490,9 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
|
||||
[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
|
||||
{1 {can't unset "test_ns_var2::z": no such variable}}\
|
||||
{}]
|
||||
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
||||
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
|
||||
namespace eval test_ns_var { variable eight 8 }
|
||||
} -body {
|
||||
namespace eval test_ns_var {
|
||||
proc p {} {
|
||||
variable eight
|
||||
@@ -484,14 +500,16 @@ test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
|
||||
}
|
||||
p
|
||||
}
|
||||
} {8 eight}
|
||||
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
||||
} -result {8 eight}
|
||||
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
|
||||
namespace eval test_ns_var { variable eight 8 }
|
||||
} -body {
|
||||
proc p {} { ;# note this proc is at global :: scope
|
||||
variable test_ns_var::eight
|
||||
list [set eight] [info vars]
|
||||
}
|
||||
p
|
||||
} {8 eight}
|
||||
} -result {8 eight}
|
||||
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
||||
namespace eval test_ns_var {
|
||||
variable {} {My name is empty}
|
||||
@@ -774,7 +792,7 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
|
||||
|
||||
test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
|
||||
set already 0
|
||||
unset x
|
||||
unset -nocomplain x
|
||||
} -body {
|
||||
array set x {e 1 i 1}
|
||||
trace add variable x unset {apply {args {
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user