Compare commits

...
Author SHA1 Message Date
Joe Mistachkin ea11870f5b Fix the generated copyright sections in the HTML help file. 2016-11-02 01:42:49 +00:00
dgp 27696b490b a few test & docs fixes 2016-07-26 13:54:57 +00:00
dkf d0af5aa92c [db0a5f6417] Make a few tests resilient to differences in semantics of pipes between OSs. 2016-07-26 10:08:29 +00:00
dkf 9faead9d18 [6a19dedc2e] "Clarified" what the units are that [chan copy] uses for -size and that synchronous copying returns. 2016-07-24 13:09:40 +00:00
dkf 404eadfdaf Make a few tests more resilient to differences in the semantics of pipes between operating systems. 2016-07-24 12:45:07 +00:00
dgp 722ba1aa44 test repairs 2016-07-22 15:28:50 +00:00
dgp 4cead413c9 Set release date 2016-07-22 14:00:01 +00:00
dgp 2501dbb8d0 Update changes file. 2016-07-21 16:20:38 +00:00
dgp acb9c613f1 merge 8.6 2016-07-20 11:48:44 +00:00
venkat ad4538af95 Merge tzdata 2016f from ietf.org 2016-07-20 03:05:31 +00:00
venkat c2e7b1ce36 Update tzdata to 2016f from ietf.org 2016-07-20 03:05:01 +00:00
dgp f846b3f965 Remove outdated comment. 2016-07-19 15:00:51 +00:00
dgp a22b8736ec merge 8.6 2016-07-18 17:47:23 +00:00
dgp f5bf1de995 [104f2885bb] Rework the "chan" Tcl_ObjType to properly validate cached channel name lookups. 2016-07-18 16:46:34 +00:00
dgp 6f9ac81ae9 [104f2885bb] Rework the "chan" Tcl_ObjType to properly validate cached
channel name lookups.
2016-07-18 16:26:44 +00:00
dgp c947326c4a merge mark 2016-07-18 16:14:30 +00:00
dkf 9b1a5dc878 [77d58e3a7a] Test case independence: var. 2016-07-17 12:02:27 +00:00
dkf 4bc50a0a12 [77d58e3a7a] Test case independence: unload. 2016-07-17 11:56:28 +00:00
dgp 26532df53f merge 8.6 2016-07-16 20:50:03 +00:00
dkf 0b8d92332a [77d58e3a7a] Test case independence: io, load, msgcat, namespace, safe. 2016-07-16 11:42:38 +00:00
dkf 67a6300cc4 [77d58e3a7a] Test case independence: interp. 2016-07-15 05:39:09 +00:00
ashok fd72878261 Fix docs and test failures. I had rolled back .PS1 (Powershell files) as being executable without fixing tests and docs. 2016-07-15 03:12:09 +00:00
dkf 2edc274601 [77d58e3a7a] Test case independence: chanio, cmdah, env, history. 2016-07-14 08:31:00 +00:00
dkf 89796adf9c [3606125] Make parser-related tests work on their own. 2016-07-12 21:30:34 +00:00
dkf 11b61660d2 [3606388] Make variable-related tests work on their own. 2016-07-12 21:25:27 +00:00
dgp d214692a28 tzdata2016f 2016-07-12 16:46:08 +00:00
dgp eec270dc08 Dup test name. Bump to TclOO 1.0.5. 2016-07-12 16:24:35 +00:00
dgp 34d3a97939 merge 8.6 2016-07-12 14:15:48 +00:00
jan.nijtmans c3c52cf7b0 Fix "file owned" for Cygwin: st_uid is only 16-bit there. 2016-07-12 14:02:17 +00:00
dgp 96d7deb99b Start RC branch for Tcl 8.6.6 2016-07-12 13:23:21 +00:00
dgp 0ceae7a885 [cea0344a1] Restore a clearing of the ensemble rewrite in one execution path
so attempts to use the data after free are not made.
Test namespace-50.9 demonstrates the need for this.
2016-07-11 21:56:32 +00:00
dgp e19d125606 Avoid memory leak in test. 2016-07-11 17:13:09 +00:00
dgp 68432b7ed1 [96fe2f1cc7] Plug memory leak. 2016-07-10 19:28:57 +00:00
dkf f1f3820560 [3606121] Making tests less cross-dependent. 2016-07-10 14:15:12 +00:00
dkf 363cf0a6f1 Fixes to namespace-old.test 2016-07-10 14:14:28 +00:00
dkf 508b6fc60d Fix to resolver.test 2016-07-10 12:45:34 +00:00
dkf 75f3cb9d07 Fixes to namespace.test 2016-07-10 07:59:52 +00:00
ashok 31ec149e21 Bugfix [da340d4f32]. clock-55.9 and clock-55.10 test failures. 2016-07-10 06:41:54 +00:00
ashok 6076256c3f Fix compiler warnings (const-ness and unused label) that did not show up
in the non-optimized build before last checkin.
2016-07-10 06:33:20 +00:00
ashok 25f7d3b86e Fix missing constraints for Windows-specific tests 2016-07-09 14:30:54 +00:00
dgp 464153fecd Revise INST_INVOKE_REPLACE to call EvalObjv with TCL_EVAL_INVOKE and
no longer call EvalObjEx which does not support it reliably.  Also
convert to conventional list operations.
2016-07-09 14:26:56 +00:00
ashok 139a16f600 Fixed docs for prior check-in (exec of .CMD files on Windows) 2016-07-09 14:23:24 +00:00
ashok 600487a9d6 Bugfix [9ece99d58b]. Make exec understand .CMD files on Windows. 2016-07-09 14:18:22 +00:00
dkf a2962cc586 [1493a43044] Make [namespace upvar] ignore variable resolvers; the previous situation was completely unintuitive. 2016-07-09 13:26:46 +00:00
ashok d6ae741f7f Bugfix [3613671]. file owned implementation for Windows. 2016-07-09 11:13:48 +00:00
ashok 48e3873f19 Bugfix [ae61a67192]. file {stat, type, size} etc. support for built-in special Windows files/devices like CON. 2016-07-09 08:27:00 +00:00
dgp 57a42f683c Repair some memory corruption problems in EnsembleCmdRep. 2016-07-08 14:19:23 +00:00
jan.nijtmans b2e1bb03b1 (cherry-pick): Bugfix [5d7ea04580]. Treat .cmd and .ps1 files are executable on Windows. 2016-07-08 12:38:35 +00:00
ashok 47620e4ba8 Bug [a47641a031]. TclJoinPath was calling TclNewFSPathObj with a
first argument that was not an absolute path. Added a check for that.
Fixes Windows test failures fileSystem-1.{3,4}
2016-07-08 07:58:00 +00:00
dgp f290d19b27 Missed a cleanup line, which created a memleak. 2016-07-07 19:50:02 +00:00
dgp 1446838d71 To use a Tcl_Command token [aka (Command *)] for epoch checking, we must not
permit it to be freed while we hold it or else it could be mistaken for another
token allocated later that just happens to reside at the same address.

(Command *) preservation machinery already exists, just need to use it.

An extension facing the same problem might have to rely on command delete
traces.  

Earlier revisions used (Namespace *) lifetime to achieve the same
results, but that's really an indirect (possibly non-robust) path to achieving
the proper goal.

Valgrind is happy now.
2016-07-07 18:44:56 +00:00
dkf 8c8c1a6415 Expose the AVOID_RESOLVERS flag to [namespace upvar] implementations, which seem to need it. 2016-07-07 10:08:44 +00:00
dkf 07f3d3e393 Also test the interpreted path. 2016-07-07 08:35:30 +00:00
ashok 85d1666247 Bugfix [5d7ea04580]. Treat .cmd and .ps1 files are executable on Windows. 2016-07-07 06:30:58 +00:00
dgp bf0a1dc6c5 Create and use a utility Tcl_NRPostProc when decr ref count of values is
all that is needed.
2016-07-06 16:47:37 +00:00
dgp 31e1e2a8c4 Simplify all the Tcl_NRPostProc declarations. 2016-07-06 15:50:34 +00:00
dgp 8f4ed81159 [bd7f17bce8] Revise ensemble dispatch to call TclNREvalObjv() which supports
the TCL_EVAL_INVOKE flag that is needed.
2016-07-06 15:12:53 +00:00
dkf 966906b7ae Demonstrate that there is a problem. 2016-07-05 22:05:16 +00:00
dgp 20e8eaedc8 New tests to demo the remaining flaw in ensemble dispatch revisions.
Itcl 4 also demonstrated these problems.
2016-07-05 17:03:59 +00:00
jan.nijtmans 7b6eaf23e9 Fixup the ensemble rewrite conversions (merge fork) 2016-07-05 08:53:17 +00:00
dgp bf33e5524b Fixup the ensemble rewrite conversions. 2016-07-04 20:39:43 +00:00
jan.nijtmans 23c3438aee typo and end-of-line spacing 2016-07-04 08:36:41 +00:00
dkf 21124cf6ab Add ability to disassemble TclOO constructors and destructors ([1493a43044] motivates) 2016-07-04 08:18:53 +00:00
dgp 1694cf05a6 Use conventional list operations for ensemble dispatch. 2016-07-03 14:09:45 +00:00
dgp 65bd912b77 [09fabeb1fd] test subdirs in sorted order. 2016-07-02 17:55:51 +00:00
dgp dd879c794d [f961d7d1dd] Repair usage message for ensemble parameters with spaces. 2016-07-02 17:21:53 +00:00
dgp 1481e6f3da [4402cfa58c] Rework the spell check machinery into something that will not be foiled by value sharing.
Valgrind is not happy with this commit.
Likely suspect is the removal of the nsPtr
field and checking against it.

dkf tried to warn me.
2016-07-01 20:14:14 +00:00
dgp 42c2792287 The EnsembleCmdRep struct that is the internal rep for caching ensemble
dispatches and spelling corrections can now be file static.
2016-07-01 19:42:38 +00:00
dgp 08826b79fe merge 8.6 2016-07-01 19:20:36 +00:00
dgp d5617720bb Add some tests 2016-07-01 19:16:56 +00:00
dgp e95143affd [4402cfa58c] Rework the spell check machinery into something that will not be
foiled by value sharing.
2016-07-01 18:54:36 +00:00
dgp ced0d271ff Encapsulate the fetching of the ensemble rewrite root, used by [namespace]. 2016-07-01 14:08:22 +00:00
jan.nijtmans 38e85a2dbe Use same internal representation for unicode strings in test-cases than in reality, in order to prevent surprises. 2016-07-01 13:32:19 +00:00
dgp 221b47806c merge 8.6 2016-07-01 12:58:37 +00:00
dgp 286034431c Use the utility routines to eliminate the last bit of intrusion into the
ensembleRewrite area.
2016-07-01 12:21:15 +00:00
dgp 04633c731b merge 8.6 2016-06-28 22:49:22 +00:00
dgp b28ae0fbb5 Route all ensemble rewrite activity through a few utility routines. 2016-06-28 21:17:28 +00:00
dgp 6c2c1397ff merge 8.6 2016-06-28 14:26:11 +00:00
dkf 16dc425318 [dd260aaf72] Allow the -dictionary option to be read from a pushed transform. 2016-06-27 14:27:43 +00:00
dkf 7a41668df0 [c3d956be5b] Clearer text about positioning of optional arguments. 2016-06-27 13:46:15 +00:00
jan.nijtmans ef99853da4 (cherry-pick) [c30087b04f] Install man pages with permissions 644 instead of 444. 2016-06-26 09:01:26 +00:00
jan.nijtmans cb9a441bb9 (cherry-pick) [c30087b04f] Install man pages with permissions 644 instead of 444. 2016-06-26 09:00:06 +00:00
dgp 3619c13393 merge 8.6 2016-06-23 13:18:33 +00:00
dkf f05e229780 [d553228d9f] Stop crashes in [dict update] with low refcount dictionaries. 2016-06-23 08:20:16 +00:00
dkf 5cae882ff3 [c95b9fc0e3] Make errorcodes out of level parsing more consistent. 2016-06-22 20:57:18 +00:00
dgp 0592038cf9 merge 8.6 2016-06-22 18:57:07 +00:00
dgp fab681eb11 [16896d49fd] Tcl_DStrings should tolerate appends to self. 2016-06-22 18:04:23 +00:00
dgp 01e94e53ed [16896d49fd] Tcl_DStrings should tolerate appends to self. 2016-06-22 17:38:31 +00:00
dgp e5320ae0d5 Repair earlier bug fix. Stopped crash, but botched the logic for multiple
glob patterns.
2016-06-21 11:10:10 +00:00
jan.nijtmans eccf18644f Upgrade internal Unicode tables to Unicode 9.0 2016-06-21 09:58:54 +00:00
jan.nijtmans e4b872fc07 Upgrade internal Unicode tables to Unicode 9.0 2016-06-21 09:57:14 +00:00
dgp 8445a00210 [c383ebb5e4] Match DStringInit and DStringFree properly. 2016-06-20 19:23:17 +00:00
dgp 345d7cf628 merge 8.6 2016-06-17 00:53:04 +00:00
dgp 482ab2e9dc [4b61afd660] Allow [info frame] to record line info for substituted command names. 2016-06-16 17:15:00 +00:00
dgp 751453253c [4b61afd660] Allow [info frame] to record line info for substituted command names. 2016-06-16 17:12:45 +00:00
dgp fa88074963 [16828b3744] [vwait] *must* successfully undo its variable trace, or else
it risks corrupting memory.  Namespace teardown complexities were giving
the traces an opportunity to survive.  Added another (arguably better)
Tcl_UntraceVar() call to be sure we avoid this problem.
2016-06-16 17:06:25 +00:00
dgp d418226edb Improve fix and add test. 2016-06-16 16:59:09 +00:00
dgp bdfafd3539 merge 8.5 2016-06-16 16:41:50 +00:00
dgp 819b87f1df [16828b3744] [vwait] *must* successfully undo its variable trace, or else
it risks corrupting memory.  Namespace teardown complexities were giving
the traces an opportunity to survive.  Added another (arguably better)
Tcl_UntraceVar() call to be sure we avoid this problem.
2016-06-16 16:38:36 +00:00
dgp b36880503c Merge tip of core-8-6-branch 2016-06-16 16:27:01 +00:00
dgp 3c2b67a4d3 Correct the patch. 2016-06-16 16:14:28 +00:00
dgp 08c3a9b76b Merge ec51e0603e. Segfaults again. 2016-06-16 15:25:55 +00:00
dgp dd519c7dac Merge up to a197e6853e. Still works. Next checkin restarts the segfaults. 2016-06-16 15:19:41 +00:00
dgp f67a341fce Merge up to the 8.6.0 release. 2016-06-16 14:48:35 +00:00
dgp c755ef0815 [16828b3744] Prototype fix for merging forward. 2016-06-16 14:23:15 +00:00
jan.nijtmans 99d3f3c9f3 Fix [7393be0be6e7f91cbb2016fa777896e3895929e3|7393be0be6]: Tcl Thread library doesn't work in Debug build on Windows_x64 2016-06-14 09:57:54 +00:00
jan.nijtmans 0b3a8804eb Fix [7393be0be6e7f91cbb2016fa777896e3895929e3|7393be0be6]: Tcl Thread library doesn't work in Debug build on Windows_x64 2016-06-14 09:55:03 +00:00
jan.nijtmans 92a9b04a12 (cherry-pick): Fix [e14c77b845]: Compilation error over typedef. 2016-06-14 09:12:46 +00:00
dgp a4532de5a0 Corrects reported bug, but makes many tests fail. Something subtle about
what we should expect when recording the line of a command that isn't
known until runtime.
2016-06-10 13:43:13 +00:00
jan.nijtmans b4024d86d1 Fix [e14c77b845] for MSVC6: Compilation error over typedef 2016-06-09 11:38:54 +00:00
dgp 58f5175075 merge 8.6 2016-06-03 13:32:04 +00:00
jan.nijtmans 5aee84a3f3 Fix [e14c77b845]: Compilation error over typedef. 2016-06-02 14:54:38 +00:00
jan.nijtmans e52789c557 (cherry-pick) Merge TIP #447: Execution Time Verbosity Levels in tcltest::configure. Tcltest 2.3.8 -> 2.4.0. 2016-06-02 12:27:55 +00:00
dgp 67cfc8e178 merge 8.6 2016-06-01 18:25:50 +00:00
jan.nijtmans dca8fae05f Fix [3bd69eba99a395ee]: 'make dist' fails when tclsh9.0 is on $PATH 2016-06-01 12:02:02 +00:00
jan.nijtmans 5512629c55 Fix [3bd69eba99a395ee]: 'make dist' fails when tclsh9.0 is on $PATH 2016-06-01 11:56:37 +00:00
dgp af7e16b8e4 excise debug scaffolding 2016-05-26 17:29:34 +00:00
dgp 63e94b434f constructor invocation ensemble rewrite shenanigans also fit into the
refactored routines.
2016-05-26 17:27:56 +00:00
dgp 41a668a515 Reduce to minimum set of TclResetRewriteEnsemble() calls. 2016-05-26 16:33:37 +00:00
dgp d0a8ae5cf7 Another missing reset 2016-05-26 00:00:37 +00:00
dgp 7f43feafd5 Put in some missing Resets. 2016-05-25 18:19:27 +00:00
dgp 2b502a4b2b Refactor all iPtr->ensembleRewrite setting code into TclInitRewriteEnsemble()
calls.  This likely fixes many weird corner case bugs, and definitly makes
future development and maintenance easier.
2016-05-25 17:27:49 +00:00
dgp f95100b44a Adapt and tidy up the bug fix. 2016-05-24 20:39:25 +00:00
dgp 0d4e358f5e Merge the bug fix and test case. 2016-05-24 20:29:35 +00:00
dgp 5f7157f3a2 Now fix the bug. 2016-05-24 20:23:15 +00:00
dgp 7cde8a22a1 New test namespace-53.11 demonstrates the bug. 2016-05-24 20:16:10 +00:00
dgp 535895e577 The handling of ensemble rewriting here is not right, but I've not yet
found the test case to demonstrate it.  Checking in debugging code to
spread to other dev platforms.
2016-05-24 19:29:58 +00:00
dgp 366828918a Appears that the TclInitRewriteEnsemble() routine was created with an intent
to refactor, but never actually got used.  Work on continuing that effort.
2016-05-24 19:28:50 +00:00
dkf 1195cdbd77 Fix for [f97d4ee020]; use a two-stage approach to avoid quadratic behavior. 2016-05-21 09:27:30 +00:00
dkf 5330c4e5d3 Make the tests pass. 2016-05-21 09:26:07 +00:00
dkf 52799e58d6 Added tests that show that this branch isn't ready to be committed back yet. 2016-05-20 05:14:37 +00:00
dgp 46d0e89d6e merge 8.6 2016-05-17 11:45:44 +00:00
dkf c9bd1f3334 Possible fix for [f97d4ee020]; uses a two-stage approach to avoid quadratic behaviour. 2016-05-16 10:57:36 +00:00
dkf 6d990b9c83 Tweak a test to not leave around extra commands. 2016-05-14 06:38:52 +00:00
dgp 84f95a3ef4 merge 8.6 2016-05-13 15:55:44 +00:00
jan.nijtmans 008944a5c3 result/sendResult could be 64-bit, so account for that 2016-05-13 09:07:43 +00:00
jan.nijtmans 7a4ad0872e Make tclreg13.dll work in any Unicode environment (either with 32-bit or 64-bit characters). Adopted from Androwish. Thanks to Christian Werner. version -> 1.3.2 2016-05-13 07:49:50 +00:00
Kevin B Kenny 885379e2cc Bug fix: Assembler dereferences a rogue pointer when unstacking an empty exception range. 2016-05-13 00:45:55 +00:00
dgp 76d0eb32fc Don't see why the intrep should make and keep copies of things already
stored in the hash table.
2016-05-12 20:23:23 +00:00
dgp 76f6131b81 The "ensembleCommand" Tcl_ObjType has no need for an UpdateString routine.
It is entirely a caching type.  No "pure" value can exist.
2016-05-12 19:49:06 +00:00
dgp 1438a1b7f7 Remove the nsPtr field from the EnsembleCmdRep struct. Cannot see any
justification for keeping it (can get via token), and test suite doesn't care.
2016-05-12 19:44:41 +00:00
dgp 024bab4116 Bug fix. Have to arrange to only close a catch once. After the space
has been returned to placeholder values, closing with them as data leads
to memory corruption.

There's probably a better fix available because the error here feels like
it's rooted somewhere else, having us continue to check values we ought to
know have already been closed.
2016-05-06 16:03:15 +00:00
123 changed files with 3829 additions and 2296 deletions
+1 -1
View File
@@ -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.
+74
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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"
/*
*----------------------------------------------------------------------------
+6 -4
View File
@@ -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
View File
@@ -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;
}
+12
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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);
+3 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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, &copyObjc, &copyObjv);
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;
}
/*
+2
View File
@@ -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
View File
@@ -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);
+2 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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;
}
+7 -3
View File
@@ -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
View File
@@ -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
View File
@@ -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[]);
+2 -8
View File
@@ -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
View File
File diff suppressed because it is too large Load Diff
+24
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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:
+2 -2
View File
@@ -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]
}
+1 -1
View File
@@ -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]]
+32 -6
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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}
+2 -2
View File
@@ -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}
+2 -2
View File
@@ -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}
}
+2 -2
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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 -1
View File
@@ -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}
}
+1 -1
View File
@@ -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}
+66 -67
View File
@@ -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}
}
+68 -67
View File
@@ -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}
}
+3 -3
View File
@@ -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 -1
View File
@@ -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}
}
+86
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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.
+7
View File
@@ -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
View File
@@ -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] {
+28
View File
@@ -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
+16
View File
@@ -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
View File
@@ -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
+5
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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 {}}
+44
View File
@@ -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
View File
@@ -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
View File
@@ -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 ...?"}}
+3
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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:
-1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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