Compare commits

...
163 Commits
Author SHA1 Message Date
dkf 8841ba90ee Use C enums instead of clusters of #defines 2021-04-17 23:26:50 +00:00
jan.nijtmans 8f67ae04ad Merge 8.6 2021-04-16 13:16:25 +00:00
jan.nijtmans baa813085d Document Tcl_GetMemoryInfo() and Tcl_MainEx()/Tcl_MainExW(). Backported from [063d44b0beea237e] (Thanks, Harald!) 2021-04-16 13:14:55 +00:00
jan.nijtmans e06feb86b1 Document Tcl_GetMemoryInfo(). Backported from [063d44b0beea237e] (Thanks, Harald!) 2021-04-16 12:58:47 +00:00
jan.nijtmans 3ec8472d74 Revert [e59df7e9a3]: after a better look, the original code respected the expectation better and doesn't force appendObjPtr to Unicode, so it was actually better 2021-04-15 12:43:36 +00:00
jan.nijtmans 8a0a2779c2 Merge 8.6 2021-04-15 09:09:19 +00:00
jan.nijtmans 1c6fae0193 Fix [85d1fa7d07]: Duplicate file extension check in [file executable] on Windows 2021-04-15 09:08:23 +00:00
jan.nijtmans 871fc208e1 Fix [85d1fa7d07]: Duplicate file extension check in [file executable] on Windows. It looks like checking for "ps1" is a mistake. 2021-04-15 09:06:13 +00:00
jan.nijtmans 374f5c6e1a Restore expectation of callers to Tcl_AppendObjToObj that the appendObj never shimmers 2021-04-15 06:37:56 +00:00
dgp fc702f65d2 merge 8.6 2021-04-14 19:19:44 +00:00
jan.nijtmans 60169c7187 Restore expectation for Tcl_AppendObjToObj() 2021-04-14 19:15:52 +00:00
dgp 9cb33ddcc5 merge 8.5; adapt fix for 8.6 2021-04-14 18:58:54 +00:00
dgp c942ef369b [26649439c7] EIAS bug in [concat] 2021-04-14 18:39:12 +00:00
dgp bf055cc0d8 Bug fix 2021-04-14 18:37:35 +00:00
dgp 32a76688f6 Test demonstrating bug [26649439c7]. 2021-04-14 18:23:07 +00:00
jan.nijtmans ccfe3f47fd Complete fix for [7f1162a867]. Re-enable compilation of "string cat" (TclCompileStringCatCmd), since it now works again. 2021-04-14 08:14:23 +00:00
pooryorick c993263332 Remove unnecessary reference counting. 2021-04-13 22:44:04 +00:00
jan.nijtmans 28ddee7d18 Merge-mark 8.6. Missing/superflouous testConstraint 2021-04-13 13:48:53 +00:00
jan.nijtmans 0b6db319f0 Update to latest "rules.vc" 2021-04-13 13:44:33 +00:00
jan.nijtmans 845442b102 Merge 8.7 2021-04-13 11:51:58 +00:00
jan.nijtmans c89d776dce Fix testcase utf-1.18 2021-04-13 11:51:16 +00:00
jan.nijtmans 09b6123a09 Merge 8.6. More missing ::tcltest::loadTestedCommands 2021-04-13 10:16:31 +00:00
jan.nijtmans 06464aa3be Missing ::tcltest::loadTestedCommands 2021-04-13 10:01:37 +00:00
jan.nijtmans f23820c00b Missing ::tcltest::loadTestedCommands 2021-04-13 09:13:58 +00:00
jan.nijtmans 87508b74e0 missing constraint 2021-04-13 08:20:54 +00:00
jan.nijtmans 16ddac314c eol-spacing 2021-04-13 08:15:50 +00:00
jan.nijtmans 9f61e10cf9 Unbreak build 2021-04-13 08:05:45 +00:00
dkf a396843006 Zero out memory allocated on stack 2021-04-12 19:12:29 +00:00
jan.nijtmans c614920819 Fix [f566e1c817]: macOS: -DTCL_NO_DEPRECATED 2021-04-12 15:33:08 +00:00
jan.nijtmans 051a1473cb Merge-mark 2021-04-12 10:06:11 +00:00
jan.nijtmans 571eeda5cf Merge 8.5 2021-04-12 10:05:31 +00:00
jan.nijtmans cf9fc355f8 Backport utf testcase tweaks from 8.7. No change for ucs-2 2021-04-12 10:04:46 +00:00
jan.nijtmans 7deb6f2082 Fix [7f1162a867]. Don't compile "string cat" any more, since there still is a bug in it, demonstrated by utf-1.18 testcase 2021-04-12 09:26:27 +00:00
jan.nijtmans b1e4f0fa23 Merge 8.7 2021-04-09 15:35:17 +00:00
jan.nijtmans c318d73bd3 Document that Tcl 8.7 no longer uses a (modified) CESU-8 as internal format, but a (modified) WTF-8. 2021-04-09 15:32:25 +00:00
jan.nijtmans 459073607d Fix TclStringCat() functions. This makes allmost all testcases pass, one left to go: utf-1.18 2021-04-09 13:01:19 +00:00
jan.nijtmans 0d7132ebb2 Rename macro to ISCONTINUATION() 2021-04-09 10:57:36 +00:00
jan.nijtmans 2e06c053b4 new macro ISCONTBYTEORLOWERSURROGATE() 2021-04-09 09:14:10 +00:00
jan.nijtmans 4f93205802 Fix append-3.4, append-3.7 and utf-1.18 testcases 2021-04-09 07:33:40 +00:00
jan.nijtmans 023286a7fd Merge 8.7 2021-04-09 06:37:14 +00:00
jan.nijtmans 7bb103b64e More test-cases, involving \xC0 \x80 2021-04-09 06:36:45 +00:00
jan.nijtmans 3ed1f7b055 Remove TclpCreateFileHandler/TclpDeleteFileHandler on windows. The linker should complain when even trying to create something calling those functions. 2021-04-08 12:29:49 +00:00
jan.nijtmans 67e4ed2290 TIP #598: export TclWinConvertError 2021-04-08 12:22:16 +00:00
jan.nijtmans e287e35105 Fix compiler warning when using select notifier 2021-04-08 11:36:19 +00:00
jan.nijtmans 0b8bd54063 Merge 8.6 2021-04-08 08:47:18 +00:00
jan.nijtmans a463bf5525 Backport dde 1.4.4 from Tcl 8.7. Doesn't conflict with installed Tcl 9.0 version of dde any more.
(don't bother doing this for the "registry" extension, because the Tcl 8.7+ version installs in a different directory)
2021-04-08 08:45:12 +00:00
jan.nijtmans 6c72d33ef1 Make "registry" and "dde" dll's for 8.x and 9.0 installable in the same directory. See TIP #595 2021-04-08 07:56:45 +00:00
jan.nijtmans ee577ebd90 There is no "eq" command any more 2021-04-07 12:38:56 +00:00
jan.nijtmans 2b508d7964 Merge fork 2021-04-07 12:30:56 +00:00
jan.nijtmans 0dcddf9cf0 More test-cases showing the bug 2021-04-07 12:30:33 +00:00
jan.nijtmans 79fd04384a A few more Package -> Library renamings (testcases only) 2021-04-07 11:50:03 +00:00
jan.nijtmans 6792b8a53c A few missing renamings 2021-04-07 10:44:29 +00:00
jan.nijtmans 06813163a8 TIP #595 (for Tcl 8.7) part 1: just rename Tcl_StaticPackage to Tcl_StaticLibrary, Tcl_PackageInitProc to Tcl_LibraryInitProc and Tcl_PackageUnloadProc to Tcl_LibraryUnloadProc. Adapt documentation, mentioning that the old names are now deprecated. 2021-04-07 09:55:24 +00:00
jan.nijtmans a1ab68d1ea Revert previous commit, and add comments why it's wrong. 2021-04-07 09:01:55 +00:00
pooryorick 83025a44e0 Replace simple refCount decrement with the proper decrementing function. 2021-04-05 21:07:00 +00:00
jan.nijtmans 85d1500c50 tclZipfs.c:1857:33: warning: request for implicit conversion from ‘void *’ to ‘char *’ not permitted in C++ [-Wc++-compat] 2021-04-05 17:58:13 +00:00
jan.nijtmans 15b5f31caf Rename exported symbol "Tcl_StaticPackage" to "Tcl_StaticLibrary". Still undocumented, to be formalized by TIP #595. Tcl_StaticPackage() still works the same 2021-04-04 16:56:26 +00:00
jan.nijtmans 226bb13f4e Fix [https://github.com/tcltk/tcl/runs/2263266926|failing test-cases] with --enable-symbols=mem build by reverting the series of commits that caused the memory-leak 2021-04-04 14:31:43 +00:00
pooryorick 7f4cc308f3 Update code comments. 2021-04-03 17:58:03 +00:00
pooryorick 42c960506d Changes to code comments. 2021-04-03 13:20:14 +00:00
pooryorick 970479b4ee When a namesapce is deleted delete all namespaces under it before making any
modifictions to it.
2021-04-03 12:48:54 +00:00
pooryorick 55f8e3ac01 Remove suspected inadvertent copypasta from test. 2021-04-03 12:36:10 +00:00
pooryorick c494f8045e Use TclCleanupCommandMacro instead of just decrementing the reference count. 2021-04-03 12:33:58 +00:00
pooryorick 756e0c234a OO cleanup fix that passes test 11.7. 2021-04-03 12:33:00 +00:00
pooryorick 1c4c352fe9 New test for OO cleanup: routine for object gets deleted before namespace deletion
is complete.
2021-04-03 12:17:40 +00:00
dkf 743881d3ce Clean up the notifier code to not spread the hooks quite so widely 2021-04-03 11:09:47 +00:00
dkf 3628bed3ba Don't do double definition; code was moved to tclInt.h previously. 2021-04-02 18:41:36 +00:00
jan.nijtmans d1bd0f28ef Merge 8.6 2021-04-01 10:19:56 +00:00
jan.nijtmans e5991250e0 Follow-up to [15c7b4f93e]: "Implement TCL_ENCODING_STOPONERROR flag for UtfToUtf encoder/decoder". Only do this check when pureNullMode == 0, otherwise we violate EIAS. 2021-04-01 09:47:33 +00:00
dkf 55bb44b8be Forgot a place to #ifndef out 2021-04-01 08:18:38 +00:00
dkf 5ca6887e66 Don't define Tcl_CreateFileHandler or Tcl_DeleteFileHandler on Windows. 2021-03-31 10:45:40 +00:00
dkf 4c25696376 merge core-8-branch 2021-03-31 10:38:25 +00:00
jan.nijtmans 9406745440 Add 3 undocumented #defines. To be formalized by TIP #595 (currently being voted on) 2021-03-31 10:09:32 +00:00
jan.nijtmans 9b5af56932 RFE 4b4830eb54: reflected channel truncate method 2021-03-30 16:30:31 +00:00
dkf 107f7173d2 Improve documentation for exec and open, especially in relation to binary pipelines 2021-03-30 10:17:09 +00:00
dkf 73953be8b1 Improve documentation for exec and open, especially in relation to binary pipelines 2021-03-30 10:14:20 +00:00
dkf 63f4be3aa2 Improve documentation for exec and open, especially in relation to binary pipelines 2021-03-30 09:03:19 +00:00
dkf 2dab8fa488 Refactoring, ahoy 2021-03-30 08:22:26 +00:00
jan.nijtmans 1f1f43fcd2 Thanks to TIP #587, convert many escapes in the testcases into the actual (UTF-8) character. 2021-03-30 07:11:18 +00:00
jan.nijtmans c8617b374b merge-mark 2021-03-30 06:12:18 +00:00
jan.nijtmans 9eb5b14a3c remove useless save/restore 2021-03-30 06:10:23 +00:00
jan.nijtmans 79b9ab1039 Change TCL_ENCODING_EXTERNAL flag into TCL_ENCODING_MODIFIED, but with opposite meaning. Simplify code. 2021-03-28 20:09:51 +00:00
jan.nijtmans 6c6a470c2b Rename MODULESCOPE TclGetLoadedPackagesEx() to TclGetLoadedLibraries() 2021-03-22 17:07:01 +00:00
jan.nijtmans 3b6d7d6119 merge-mark 2021-03-22 10:08:10 +00:00
jan.nijtmans 0f632bd1c5 Merge 8.5 2021-03-22 10:06:36 +00:00
jan.nijtmans d63f456a83 Fix incorrect comment: underscore ('_') is allowed in a packageName 2021-03-22 10:04:12 +00:00
jan.nijtmans 9e6945739a Rename internal variables, making it more clear that tclLoad.c is not part of Tcl's "package" mechanism. 2021-03-22 10:00:06 +00:00
dkf c49b98fa6b Start of doing a clean up of the notifier code.
This originated as trying to stop macOS builds from doing silly warnings during
a static build, but I noticed that there were common patterns that belong in
generic code instead of being repeated in each of the platform-specific pieces.
2021-03-21 13:07:15 +00:00
jan.nijtmans 8a9eba41a2 merge-mark 2021-03-21 09:30:06 +00:00
jan.nijtmans dd9f3c1246 Implement TCL_ENCODING_STOPONERROR flag for UtfToUtf encoder/decoder. Backported from 8.7 2021-03-21 09:27:07 +00:00
jan.nijtmans 4e90ccc6db Fix [0221b993a1]: Tcl command [update idletasks] doesn't skip main loop in Tcl_DoOneEvent 2021-03-19 14:55:25 +00:00
jan.nijtmans d5479489aa Fully implement TCL_ENCODING_STOPONERROR flag for Utf2Utf encoder/decoder. 2021-03-19 12:58:41 +00:00
jan.nijtmans c39345b47a Merge 8.6 2021-03-19 10:49:13 +00:00
jan.nijtmans fff5060d94 Change Tcl_StaticPackage's "pkgName" argument to "prefix" and improve documentation, describing better what this argument does. 2021-03-19 09:20:26 +00:00
dkf f2cb38dda9 Handle the encoding of filenames in ZIPs correctly. (This is awful. The awful isn't Tcl's fault. Terrible spec...) 2021-03-18 21:35:09 +00:00
dkf e6d6e2962d Delete some useless code. Was only place where we fed an uncontrolled value to %f, and it was actually a conversion we didn't need to do at all. 2021-03-18 21:17:46 +00:00
jan.nijtmans 80af639d39 Merge 8.6 2021-03-18 14:49:01 +00:00
jan.nijtmans 8390478dbf Fix [8663689908]. Final documentation fix, implementation was already fixed earlier. 2021-03-18 14:46:57 +00:00
jan.nijtmans 2b7eb65f53 Suggested fix for [0221b993a1]: Tcl command [update idletasks] doesn't skip main loop in Tcl_DoOneEvent 2021-03-18 13:20:47 +00:00
jan.nijtmans 260c7e595a Merge 8.6 2021-03-18 12:07:38 +00:00
jan.nijtmans a3ae9d7e57 Fix [2860859e84]: Misleading description in README file 2021-03-18 12:05:56 +00:00
jan.nijtmans 8df980fc3e Merge 8.6 2021-03-18 09:51:49 +00:00
jan.nijtmans 3aa4b20ea8 Remove incorrect/useless comment 2021-03-18 09:36:27 +00:00
jan.nijtmans 6da553ec22 Proposed implementation of RFE [4b4830eb54] 2021-03-18 09:26:03 +00:00
jan.nijtmans c84e03a7a8 More simplification of UtfToUtfProc(). Get rid of wrapper functions UtfIntToUtfExtProc/UtfExtToUtfIntProc. This can be handled by additional flags. 2021-03-18 09:12:18 +00:00
jan.nijtmans 4b3814f752 Simplify UtfToUtfProc() and UtfToUtf16Proc(): Using TclUtfToUCS4() internally means that we don't have to keep track of internal state any more (Tcl_EncodingState)
Also, add (HMODULE) cast (back) in tclZipfs.c
2021-03-17 15:01:54 +00:00
jan.nijtmans 15849c859a Fix MSVC build 2021-03-17 08:50:28 +00:00
dkf 90040e0573 More cleaning up of zipfs
Don't put straight binary data in a Tcl string, and other better API uses.
2021-03-16 20:45:39 +00:00
jan.nijtmans 0013597b33 Fix gcc warnings 2021-03-16 09:16:39 +00:00
jan.nijtmans c54d29df06 Tweak usage of TCL_NO_DEPRECATED 2021-03-15 13:17:54 +00:00
jan.nijtmans 6e657cfb83 Implement TIP #575: Switchable Tcl_UtfCharComplete()/Tcl_UtfNext()/Tcl_UtfPrev() 2021-03-15 11:52:09 +00:00
dkf 57bf9fe12f More refactoring to reduce the choked-up complexity of tclZipfs.c 2021-03-15 09:52:02 +00:00
dkf 1f2858fefd Flipped a test 2021-03-14 20:53:39 +00:00
jan.nijtmans 2d6586915f merge-mark 2021-03-14 18:28:47 +00:00
jan.nijtmans a132514652 Merge 8.5 2021-03-14 16:13:44 +00:00
jan.nijtmans b0e0d4b618 Document that Tcl_UtfCharComplete() can (now) be used to protect Tcl_UtfNext() calls against overflow, if the string being handled is not NULL-terminated. 2021-03-14 16:12:25 +00:00
dkf 58fb98d8a9 More on making tclZipfs.c comprehensible. Refactoring to the rescue! 2021-03-14 15:26:44 +00:00
jan.nijtmans be3426d527 merge-mark 2021-03-11 12:20:11 +00:00
jan.nijtmans 2ea2ef0609 Backport Tcl_UtfCharComplete() functionality from 8.6 for TCL_UTF_MAX>3. This makes Tcl_UtfCharComplete() usable to protect Tcl_UtfNext() calls for overflow. No change for TCL_UTF_MAX=3 (default build) 2021-03-11 12:19:14 +00:00
jan.nijtmans d0443e229f Merge 8.6 2021-03-10 16:16:08 +00:00
jan.nijtmans f223db50fd Repair Tcl_UniCharNcasecmp() in the same way as Tcl_UniCharNcmp() for fix [4c591fa487]. Also put back minor optimization for big-endian machines removed in the previous commit 2021-03-10 16:12:01 +00:00
jan.nijtmans 07c6dc0d49 Merge 8.6 2021-03-10 15:47:34 +00:00
jan.nijtmans 0834bb4547 Fix [4c591fa487]: [string compare] EIAS violation 2021-03-10 15:39:15 +00:00
jan.nijtmans 50b24193de Compatibility tweak wrt 8.6 2021-03-09 15:38:06 +00:00
jan.nijtmans a2b56f4c74 TclWinConvertError -> Tcl_WinConvertError 2021-03-09 15:28:40 +00:00
jan.nijtmans 0255b9c343 Merge 8.7 2021-03-09 15:13:08 +00:00
jan.nijtmans 764ef9b409 Merge 8.6 2021-03-09 09:19:25 +00:00
jan.nijtmans 8aca3246ab Fix [8419c55e2c]: Tclsh read loop does not handle EINTR 2021-03-09 09:14:04 +00:00
jan.nijtmans c197ddb3b2 Merge 8.6. Remove end-of-line spacing 2021-03-09 08:37:47 +00:00
jan.nijtmans 3b584dd13f Remove end-of-line spacing 2021-03-09 08:36:11 +00:00
dkf 25bbbbf3ee Fix SEGV in zipfs mounting, and try to make that code more comprehensible 2021-03-08 16:53:51 +00:00
dkf b9bc37e2b8 Added some tests for [zipfs lmkimg] 2021-03-07 18:42:27 +00:00
dkf a1d8e47ea7 Document that [zipfs mkimg] strips an existing ZIP. We ought to merge instead, but we don't yet. 2021-03-06 16:28:43 +00:00
jan.nijtmans dd7f073e8b Merge 8.6 2021-03-04 16:10:29 +00:00
jan.nijtmans a085ffdd43 In man2html, use consistant color-names (6-char, uppercase), encoding (utf-8) and translation (lf) independant from platform 2021-03-04 15:53:15 +00:00
jan.nijtmans 063e006111 Merge 8.6 2021-03-04 10:36:23 +00:00
jan.nijtmans 19bfe564de Merge 8.5. Add unused stub table entries 2021-03-04 10:22:40 +00:00
jan.nijtmans 3f89004e37 Add some more unused entries to the stub table, keeping up with the table size increase of higher Tcl versions 2021-03-04 09:53:10 +00:00
jan.nijtmans bebf0454f6 cleanup genStubs.tcl, e.g. "==" -> "eq" and "!=" -> "ne". No change in output 2021-03-04 09:42:47 +00:00
jan.nijtmans 4355668c80 Merge 8.6. Basically re-number testcases so they align with the 8.6 test-cases 2021-03-03 15:06:08 +00:00
jan.nijtmans 5a2a021cd4 Merge 8.5. Just split some testcases 2021-03-03 14:44:03 +00:00
jan.nijtmans 6433d6a30b Backport improvements in UTF-8 handling for Tcl_UtfPrev/Tcl_UtfNext from 8.7 (through 8.6). No change for TCL_UTF_MAX=3. Adapt test-cases accordingly 2021-03-03 14:31:37 +00:00
jan.nijtmans ae9d23eae8 Merge 8.6 2021-03-02 10:59:25 +00:00
jan.nijtmans 773a30a541 Using 0xFC00 is more readable here than ~0x3FF. It's sufficient becauwe ch1 and ch2 are only 16-bit. Backported from 8.7 2021-03-02 10:53:30 +00:00
jan.nijtmans 895a4597bc Merge 8.6 2021-03-02 10:38:36 +00:00
jan.nijtmans b697c844ad Backport some UTF-8-related changed from 8.7 to 8.6, only for TCL_UTF_MAX > 3. No change for TCL_UTF_MAX=3.
Also adapt test-cases accordingly, and add comments why the changes were done.
2021-03-02 10:10:54 +00:00
oehhar 7c54d7ca1d Ticket [87082587c4]: typo in msgcat man page 2021-02-27 11:21:34 +00:00
oehhar 1ac55b7d3f Ticket [87082587c4]: typo in msgcat man page 2021-02-27 11:19:28 +00:00
jan.nijtmans 6293939296 Further internal variable upgrade from long -> size_t 2021-02-26 14:52:14 +00:00
jan.nijtmans a97e3eef6d Increase some (internal) variables from int/long to long/size_t. On the way to allow bigger blocks in the threaded allocator 2021-02-26 13:18:50 +00:00
jan.nijtmans d134d35fef Fix "make checkstubs": A few more MODULE_SCOPE libtommath functions 2021-02-24 11:56:53 +00:00
jan.nijtmans e5153a8d0c Fix typo, eliminate type-cast 2021-02-24 08:58:15 +00:00
jan.nijtmans 5c8ce61f79 Merge 8.6. Fix Cygwin compile 2021-02-23 13:30:01 +00:00
jan.nijtmans 4723df2a35 Merge 8.5 2021-02-23 13:03:28 +00:00
jan.nijtmans c0f6db4b81 Revise buffer-sizes used in GetModuleFileNameW() calls. Available buffer-size reported to GetModuleFileNameW() was not always accurate 2021-02-23 12:34:58 +00:00
jan.nijtmans 06ea55d820 Simplify implementation on Cygwin: No need to use CFG_RUNTIME_BINDIR any more 2021-02-23 10:08:46 +00:00
jan.nijtmans eb9f949b2c Merge 8.6 2021-02-23 07:39:34 +00:00
jan.nijtmans 8242d1a544 Use _wgetenv() in stead of getenv() on Windows: The wide environment is not always well-synchonized with the locale environment. Problem detected on the sebres-8-6-clock-speedup-cr2, but this branch only exposed the bug, it did not cause it. 2021-02-23 07:23:29 +00:00
jan.nijtmans e3afa12420 Merge 8.6 2021-02-19 07:20:52 +00:00
jan.nijtmans 7bfe776283 Fix [7c64aa5e1a]: Another uninitialized-variable bug in BRE-mode parsing. Thanks to Tom Lane for the bug-report and the fix 2021-02-19 07:20:06 +00:00
jan.nijtmans bdd6e3f4df Fix [7c64aa5e1a]: Another uninitialized-variable bug in BRE-mode parsing. Thanks to Tom Lane for the bug-report and the fix. 2021-02-19 07:18:13 +00:00
jan.nijtmans 0c788cde5c publicize TclWinConvertError 2020-12-10 15:45:44 +00:00
dgp e4c1bf052f Tests demonstrating the bug. Work on a fix can go here. 2020-04-26 20:49:43 +00:00
168 changed files with 7920 additions and 6093 deletions
+2 -2
View File
@@ -9018,8 +9018,8 @@ in this changeset (new minor version) rather than bug fixes:
2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)
2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
=> registry 1.4.3
=> dde 1.3.5
=> registry 1.3.5
=> dde 1.4.3
2020-03-05 (new) Update to Unicode-13 (nijtmans)
+10 -1
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -28,6 +28,9 @@ char *
char *
\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
.sp
void
\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
.sp
char *
\fBckalloc\fR(\fIsize\fR)
.sp
@@ -48,6 +51,8 @@ char *
Size in bytes of the memory block to allocate.
.AP char *ptr in
Pointer to memory block to free or realloc.
.AP Tcl_DString *dsPtr in
Initialized DString pointer.
.BE
.SH DESCRIPTION
@@ -88,5 +93,9 @@ these macros are redefined to be special debugging versions
of these procedures. To support Tcl's memory debugging within a
module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc.
\fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the
provided DString. This function cannot be used in stub-enabled extensions,
and it is only available if Tcl is compiled with the threaded memory allocator.
.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG
+2 -2
View File
@@ -241,9 +241,9 @@ The structure that contains the result of a stat or lstat operation.
Name of a procedure to look up in the file's symbol table
.AP "const char" *sym2 in
Name of a procedure to look up in the file's symbol table
.AP Tcl_PackageInitProc **proc1Ptr out
.AP Tcl_LibraryInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **proc2Ptr out
.AP Tcl_LibraryInitProc **proc2Ptr out
Filled with the safe-init function for this code.
.AP ClientData *clientDataPtr out
Filled with the clientData value to pass to this code's unload
+1 -1
View File
@@ -94,4 +94,4 @@ compatibility and translate their invocations to this form.
.SH KEYWORDS
package, present, provide, require, version
.SH "SEE ALSO"
package(n), Tcl_StaticPackage(3)
package(n), Tcl_StaticLibrary(3)
+4 -4
View File
@@ -28,7 +28,7 @@ configuration as ASCII string. This means that this information is in
UTF-8 too. Must not be NULL.
.AP "const Tcl_Config" *configuration in
Refers to an array of Tcl_Config entries containing the information
embedded in the binary library. Must not be NULL. The end of the array
embedded in the library. Must not be NULL. The end of the array
is signaled by either a key identical to NULL, or a key referring to
the empty string.
.AP "const char" *valEncoding in
@@ -40,10 +40,10 @@ too. Must not be NULL.
.PP
The function described here has its base in TIP 59 and provides
extensions with support for the embedding of configuration
information into their binary library and the generation of a
information into their library and the generation of a
Tcl-level interface for querying this information.
.PP
To embed configuration information into their binary library an
To embed configuration information into their library an
extension has to define a non-volatile array of Tcl_Config entries in
one if its source files and then call \fBTcl_RegisterConfig\fR to
register that information.
@@ -108,4 +108,4 @@ typedef struct Tcl_Config {
.\" No cross references yet.
.\" .SH "SEE ALSO"
.SH KEYWORDS
embedding, configuration, binary library
embedding, configuration, library
+78
View File
@@ -0,0 +1,78 @@
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_StaticLibrary 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StaticLibrary, Tcl_StaticPackage \- make a statically linked library available via the 'load' command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
.sp
\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
.SH ARGUMENTS
.AS Tcl_LibraryInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the library has
already been incorporated (i.e., the caller has already invoked the
appropriate initialization procedure). NULL means the library
has not yet been incorporated into any interpreter.
.AP "const char" *prefix in
Prefix for library initialization function; should be properly
capitalized (first letter upper-case, all others lower-case).
.AP Tcl_LibraryInitProc *initProc in
Procedure to invoke to incorporate this library into a trusted
interpreter.
.AP Tcl_LibraryInitProc *safeInitProc in
Procedure to call to incorporate this library into a safe interpreter
(one that will execute untrusted scripts). NULL means the library
cannot be used in safe interpreters.
.BE
.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a library has been
linked statically with a Tcl application and, optionally, that it
has already been incorporated into an interpreter.
Once \fBTcl_StaticLibrary\fR has been invoked for a library, it
may be incorporated into interpreters using the \fBload\fR command.
\fBTcl_StaticLibrary\fR is normally invoked only by the \fBTcl_AppInit\fR
procedure for the application, not by libraries for themselves
(\fBTcl_StaticLibrary\fR should only be invoked for statically
linked libraries, and code in the library itself should not need
to know whether the library is dynamically loaded or statically linked).
.PP
When the \fBload\fR command is used later to incorporate the library into
an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
be invoked, depending on whether the target interpreter is safe
or not.
\fIinitProc\fR and \fIsafeInitProc\fR must both match the
following prototype:
.PP
.CS
typedef int \fBTcl_LibraryInitProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the library
is to be incorporated. The initialization procedure must return \fBTCL_OK\fR or
\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
the event of an error it should set the interpreter's result to point to an
error message. The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
.PP
\fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and
earlier, but the old name is deprecated now.
.PP
\fBTcl_StaticLibrary\fR can not be used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
load(n), package(n), Tcl_PkgRequire(3)
-73
View File
@@ -1,73 +0,0 @@
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StaticPackage \- make a statically linked package available via the 'load' command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_StaticPackage\fR(\fIinterp, pkgName, initProc, safeInitProc\fR)
.SH ARGUMENTS
.AS Tcl_PackageInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the package has
already been loaded (i.e., the caller has already invoked the
appropriate initialization procedure). NULL means the package
has not yet been incorporated into any interpreter.
.AP "const char" *pkgName in
Name of the package; should be properly capitalized (first letter
upper-case, all others lower-case).
.AP Tcl_PackageInitProc *initProc in
Procedure to invoke to incorporate this package into a trusted
interpreter.
.AP Tcl_PackageInitProc *safeInitProc in
Procedure to call to incorporate this package into a safe interpreter
(one that will execute untrusted scripts). NULL means the package
cannot be used in safe interpreters.
.BE
.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a package has been
linked statically with a Tcl application and, optionally, that it
has already been loaded into an interpreter.
Once \fBTcl_StaticPackage\fR has been invoked for a package, it
may be loaded into interpreters using the \fBload\fR command.
\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
procedure for the application, not by packages for themselves
(\fBTcl_StaticPackage\fR should only be invoked for statically
loaded packages, and code in the package itself should not need
to know whether the package is dynamically or statically loaded).
.PP
When the \fBload\fR command is used later to load the package into
an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
be invoked, depending on whether the target interpreter is safe
or not.
\fIinitProc\fR and \fIsafeInitProc\fR must both match the
following prototype:
.PP
.CS
typedef int \fBTcl_PackageInitProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the package
is to be loaded. The initialization procedure must return \fBTCL_OK\fR or
\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
the event of an error it should set the interpreter's result to point to an
error message. The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
.PP
\fBTcl_StaticPackage\fR can not be used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
load(n), package(n), Tcl_PkgRequire(3)
+11 -1
View File
@@ -10,13 +10,17 @@
.so man.macros
.BS
.SH NAME
Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
Tcl_Main, Tcl_MainEx, Tcl_MainExW, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_Main\fR(\fIargc, argv, appInitProc\fR)
.sp
\fBTcl_MainEx\fR(\fIargc, charargv, appInitProc, interp\fR)
.sp
\fBTcl_MainExW\fR(\fIargc, wideargv, appInitProc, interp\fR)
.sp
\fBTcl_SetStartupScript\fR(\fIpath, encoding\fR)
.sp
Tcl_Obj *
@@ -30,6 +34,10 @@ Number of elements in \fIargv\fR.
.AP char *argv[] in
Array of strings containing command-line arguments. On Windows, when
using -DUNICODE, the parameter type changes to wchar_t *.
.AP char *charargv[] in
As argv, but does not change type to wchar_t.
.AP char *wideargv[] in
As argv, but type is always wchar_t.
.AP Tcl_AppInitProc *appInitProc in
Address of an application-specific initialization procedure.
The value for this argument is usually \fBTcl_AppInit\fR.
@@ -42,6 +50,8 @@ If non-NULL, location to write a copy of the (const char *)
pointing to the encoding name.
.AP Tcl_MainLoopProc *mainLoopProc in
Address of an application-specific event loop procedure.
.AP Tcl_Interp *interp in
Already created Tcl Interpreter.
.BE
.SH DESCRIPTION
.PP
+2 -2
View File
@@ -275,12 +275,12 @@ always a pointer to a location in the string. It always returns a pointer to
a byte that begins a character when scanning for characters beginning
from \fIstart\fR. When \fIsrc\fR is greater than \fIstart\fR, it
always returns a pointer less than \fIsrc\fR and greater than or
equal to (\fIsrc\fR - \fBTCL_UTF_MAX\fR). The character that begins
equal to (\fIsrc\fR - 4). The character that begins
at the returned pointer is the first one that either includes the
byte \fIsrc[-1]\fR, or might include it if the right trail bytes are
present at \fIsrc\fR and greater. \fBTcl_UtfPrev\fR never reads the
byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
\fIsrc[-\fBTCL_UTF_MAX\fI-1]\fR.
\fIsrc[-5]\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function. It returns the Unicode character represented at the
+6
View File
@@ -22,6 +22,10 @@ of one or more subprocesses to execute.
The arguments take the form of a standard shell pipeline
where each \fIarg\fR becomes one word of a command, and
each distinct command becomes a subprocess.
The result of the command is the standard output of the final subprocess in
the pipeline, interpreted using the system \fBencoding\fR; to use any other
encoding (especially including binary data), the pipeline must be
\fBopen\fRed, configured and read explicitly.
.PP
If the initial arguments to \fBexec\fR start with \fB\-\fR then
they are treated as command-line switches and are not part
@@ -411,7 +415,9 @@ With the file \fIcmp.bat\fR looking something like:
.CS
@gcc %*
.CE
.PP
or like another variant using single parameters:
.PP
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
+39 -40
View File
@@ -13,22 +13,21 @@ load \- Load machine code and initialize new commands
.SH SYNOPSIS
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
.br
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix\fR
.br
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix interp\fR
.BE
.SH DESCRIPTION
.PP
This command loads binary code from a file into the
application's address space and calls an initialization procedure
in the package to incorporate it into an interpreter. \fIfileName\fR
in the library to incorporate it into an interpreter. \fIfileName\fR
is the name of the file containing the code; its exact form varies
from system to system but on most systems it is a shared library,
such as a \fB.so\fR file under Solaris or a DLL under Windows.
\fIpackageName\fR is the name of the package, and is used to
compute the name of an initialization procedure.
\fIprefix\fR is used to compute the name of an initialization procedure.
\fIinterp\fR is the path name of the interpreter into which to load
the package (see the \fBinterp\fR manual entry for details);
the library (see the \fBinterp\fR manual entry for details);
if \fIinterp\fR is omitted, it defaults to the
interpreter in which the \fBload\fR command was invoked.
.PP
@@ -37,32 +36,32 @@ one of two initialization procedures will be invoked in the new code.
Typically the initialization procedure will add new commands to a
Tcl interpreter.
The name of the initialization procedure is determined by
\fIpackageName\fR and whether or not the target interpreter
\fIprefix\fR and whether or not the target interpreter
is a safe one. For normal interpreters the name of the initialization
procedure will have the form \fIpkg\fB_Init\fR, where \fIpkg\fR
is the same as \fIpackageName\fR except that the first letter is
procedure will have the form \fIpfx\fB_Init\fR, where \fIpfx\fR
is the same as \fIprefix\fR except that the first letter is
converted to upper case and all other letters
are converted to lower case. For example, if \fIpackageName\fR is
are converted to lower case. For example, if \fIprefix\fR is
\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
be \fBFoo_Init\fR.
.PP
If the target interpreter is a safe interpreter, then the name
of the initialization procedure will be \fIpkg\fB_SafeInit\fR
instead of \fIpkg\fB_Init\fR.
The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
of the initialization procedure will be \fIpfx\fB_SafeInit\fR
instead of \fIpfx\fB_Init\fR.
The \fIpfx\fB_SafeInit\fR function should be written carefully, so that it
initializes the safe interpreter only with partial functionality provided
by the package that is safe for use by untrusted code. For more information
by the library that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_PackageInitProc\fR(
typedef int \fBTcl_LibraryInitProc\fR(
Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the
package is to be loaded. The initialization procedure must return
library is to be loaded. The initialization procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
successfully; in the event of an error it should set the interpreter's result
to point to an error message. The result of the \fBload\fR command
@@ -74,37 +73,37 @@ interpreters, then the first \fBload\fR will load the code and
call the initialization procedure; subsequent \fBload\fRs will
call the initialization procedure without loading the code again.
For Tcl versions lower than 8.5, it is not possible to unload or reload a
package. From version 8.5 however, the \fBunload\fR command allows the unloading
library. From version 8.5 however, the \fBunload\fR command allows the unloading
of libraries loaded with \fBload\fR, for libraries that are aware of the
Tcl's unloading mechanism.
.PP
The \fBload\fR command also supports packages that are statically
linked with the application, if those packages have been registered
by calling the \fBTcl_StaticPackage\fR procedure.
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
The \fBload\fR command also supports libraries that are statically
linked with the application, if those libraries have been registered
by calling the \fBTcl_StaticLibrary\fR procedure.
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
This may be done differently on different platforms.
The default guess, which is used on most UNIX platforms, is to
take the last element of \fIfileName\fR, strip off the first
three characters if they are \fBlib\fR, then strip off the next
three characters if they are \fBtcl\fR, and use any following
alphabetic and underline characters as the module name.
For example, the command \fBload libtclxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
module name \fBlast\fR.
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix. This may be done differently on
different platforms. The default guess, which is used on most
UNIX platforms, is to take the last element of
\fIfileName\fR, strip off the first three characters if they
are \fBlib\fR, then strip off the next three characters if they
are \fBtcl\fR, and use any following alphabetic and
underline characters, converted to titlecase as the prefix.
For example, the command \fBload libxyz4.2.so\fR uses the prefix
\fBXyz\fR and the command \fBload bin/last.so {}\fR uses the
prefix \fBLast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR
The \fBload\fR command first searches for a statically loaded library
(one that has been registered by calling the \fBTcl_StaticLibrary\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
package by that name, and uses it if it is found. If several
library by that name, and uses it if it is found. If several
different files have been \fBload\fRed with different versions of
the package, Tcl picks the file that was loaded first.
the library, Tcl picks the file that was loaded first.
.PP
If \fB\-global\fR is specified preceding the filename, all symbols
found in the shared library are exported for global use by other
@@ -112,7 +111,7 @@ libraries. The option \fB\-lazy\fR delays the actual loading of
symbols until their first actual use. The options may be abbreviated.
The option \fB\-\-\fR indicates the end of the options, and should
be used if you wish to use a filename which starts with \fB\-\fR
and you provide a packageName to the \fBload\fR command.
and you provide a prefix to the \fBload\fR command.
.PP
On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
options, the options still exist but have no effect. Note that use
@@ -155,7 +154,7 @@ The following is a minimal extension:
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(ClientData clientData,
static int fooCmd(void *clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
printf("called with %d arguments\en", objc);
return TCL_OK;
@@ -189,7 +188,7 @@ switch $tcl_platform(platform) {
foo
.CE
.SH "SEE ALSO"
info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n)
info sharedlibextension, package(n), Tcl_StaticLibrary(3), safe(n)
.SH KEYWORDS
binary code, dynamic library, load, safe interpreter, shared library
'\"Local Variables:
+1 -1
View File
@@ -219,7 +219,7 @@ As an example, the user may prefer French or English text. This may be configure
.PP
.VS "TIP 499"
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
This group of commands manage the list of loaded locales for packages not setting a package locale.
.PP
+32 -1
View File
@@ -72,7 +72,7 @@ indicate that the opened channel should be configured as if with the
reading or writing of binary data.
.PP
In the second form, \fIaccess\fR consists of a list of any of the
following flags, all of which have the standard POSIX meanings.
following flags, most of which have the standard POSIX meanings.
One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
.TP 15
\fBRDONLY\fR
@@ -453,6 +453,12 @@ application are competing for the console at the same time. If the command
pipeline is started from a script, so that Tcl is not accessing the console,
or if the command pipeline does not use standard input or output, but is
redirected from or to a file, then the above problems do not occur.
.PP
Files opened in the
.QW \fBa\fR
mode or with the \fBAPPEND\fR flag set are implemented by seeking immediately
before each write, which is not an atomic operation and does not carry the
guarantee of strict appending that is present on POSIX platforms.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
@@ -527,6 +533,19 @@ Note that the equivalent options exist on Unix, but are on the serial channel
type.
.VE "8.7, TIP 160"
.SH "EXAMPLES"
Open a file for writing, forcing it to be created and raising an error if it
already exists.
.PP
.CS
set myNewFile [\fBopen\fR filename.txt {WRONLY CREAT EXCL}]
.CE
.PP
Open a file for writing as a log file.
.PP
.CS
set myLogFile [\fBopen\fR filename.log "a"]
fconfigure $myLogFile -buffering line
.CE
.PP
Open a command pipeline and catch any errors:
.PP
@@ -538,6 +557,18 @@ if {[catch {close $fl} err]} {
}
.CE
.PP
Open a command pipeline and read binary data from it. Note the unusual form
with
.QW |[list
that handles non-trivial edge cases with arguments that potentially have
spaces in.
.PP
.CS
set fl [\fBopen\fR |[list create_image_data $input] "rb"]
set binData [read $fl]
close $fl
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
+1 -1
View File
@@ -29,7 +29,7 @@ This parameter specifies the name of the package. It is required.
This parameter specifies the version of the package. It is required.
.TP
\fB\-load \fIfilespec\fR
This parameter specifies a binary library that must be loaded with the
This parameter specifies a library that must be loaded with the
\fBload\fR command. \fIfilespec\fR is a list with two elements. The
first element is the name of the file to load. The second, optional
element is a list of commands supplied by loading that file. If the
+2 -2
View File
@@ -446,7 +446,7 @@ commonly-used character classes:
.TP
\fB\ew\fR
.
\fB[[:alnum:]_]\fR (note underscore)
\fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
.TP
\fB\eD\fR
.
@@ -458,7 +458,7 @@ commonly-used character classes:
.TP
\fB\eW\fR
.
\fB[^[:alnum:]_]\fR (note underscore)
\fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
.RE
.PP
Within bracket expressions,
+13
View File
@@ -322,6 +322,19 @@ invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to
have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
etc.) is treated as and converted to an error.
.RE
.TP
\fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR
.
This \fIoptional\fR subcommand handles changing the length of the
underlying data stream for the channel \fIchannelId\fR. Its length
gets set to \fIlength\fR.
.RS
.PP
If the subcommand throws an error the command which caused its
invocation (usually \fBchan truncate\fR) will appear to have thrown
this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
etc.) is treated as and converted to an error.
.RE
.SH NOTES
Some of the functions supported in channels defined in Tcl's C
interface are not available to channels reflected to the Tcl level.
+1 -1
View File
@@ -404,7 +404,7 @@ Formally, the \fBstring bytelength\fR operation returns the content of
the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
encoding is not strict UTF\-8, but rather a modified WTF\-8 with a
denormalized NUL (identical to that used in a number of places by
Java's serialization mechanism) to enable basic processing with
non-Unicode-aware C functions. As this representation should only
+20 -19
View File
@@ -13,9 +13,9 @@ unload \- Unload machine code
.SH SYNOPSIS
\fBunload \fR?\fIswitches\fR? \fIfileName\fR
.br
\fBunload \fR?\fIswitches\fR? \fIfileName packageName\fR
\fBunload \fR?\fIswitches\fR? \fIfileName prefix\fR
.br
\fBunload \fR?\fIswitches\fR? \fIfileName packageName interp\fR
\fBunload \fR?\fIswitches\fR? \fIfileName prefix interp\fR
.BE
.SH DESCRIPTION
.PP
@@ -24,7 +24,7 @@ with \fBload\fR from the application's address space. \fIfileName\fR
is the name of the file containing the library file to be unload; it
must be the same as the filename provided to \fBload\fR for
loading the library.
The \fIpackageName\fR argument is the name of the package (as
The \fIprefix\fR argument is the prefix (as
determined by or passed to \fBload\fR), and is used to
compute the name of the unload procedure; if not supplied, it is
computed from \fIfileName\fR in the same manner as \fBload\fR.
@@ -66,12 +66,12 @@ proper reference count.
\fBunload\fR works in the opposite direction. As a first step, \fBunload\fR
will check whether the library is unloadable: an unloadable library exports
a special unload procedure. The name of the unload procedure is determined by
\fIpackageName\fR and whether or not the target interpreter
\fIprefix\fR and whether or not the target interpreter
is a safe one. For normal interpreters the name of the initialization
procedure will have the form \fIpkg\fB_Unload\fR, where \fIpkg\fR
is the same as \fIpackageName\fR except that the first letter is
procedure will have the form \fIpfx\fB_Unload\fR, where \fIpfx\fR
is the same as \fIprefix\fR except that the first letter is
converted to upper case and all other letters
are converted to lower case. For example, if \fIpackageName\fR is
are converted to lower case. For example, if \fIprefix\fR is
\fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
be \fBFoo_Unload\fR.
If the target interpreter is a safe interpreter, then the name
@@ -90,7 +90,7 @@ detached from the process.
The unload procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_PackageUnloadProc\fR(
typedef int \fBTcl_LibraryUnloadProc\fR(
Tcl_Interp *\fIinterp\fR,
int \fIflags\fR);
.CE
@@ -114,19 +114,20 @@ the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
.PP
The \fBunload\fR command cannot unload libraries that are statically
linked with the application.
If \fIfileName\fR is an empty string, then the \fIpackageName\fR argument must
If \fIfileName\fR is an empty string, then the \fIprefix\fR argument must
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
This may be done differently on different platforms.
The default guess, which is used on most UNIX platforms, is to
take the last element of \fIfileName\fR, strip off the first
three characters if they are \fBlib\fR, and use any following
alphabetic and underline characters as the module name.
For example, the command \fBunload libxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBunload bin/last.so {}\fR uses the
module name \fBlast\fR.
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix. This may be done differently on
different platforms. The default guess, which is used on most
UNIX platforms, is to take the last element of
\fIfileName\fR, strip off the first three characters if they
are \fBlib\fR, then strip off the next three characters if they
are \fBtcl\fR, and use any following alphabetic and
underline characters, converted to titlecase as the prefix.
For example, the command \fBunload libxyz4.2.so\fR uses the prefix
\fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the
prefix \fBLast\fR.
.SH "PORTABILITY ISSUES"
.TP
\fBUnix\fR\0\0\0\0\0
+3 -1
View File
@@ -84,7 +84,7 @@ Return a list of all files in the mounted zipfs, or just those matching
\fIpattern\fR (optionally controlled by the option parameters). The order of
the names in the list is arbitrary.
.TP
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
.
The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
filesystem at \fImountpoint\fR. After this command executes, files contained
@@ -146,6 +146,8 @@ the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
output file and the contents of the ZIP chunk are protected with that
password.
If the starting image has a ZIP archive already attached to it, it is removed
from the copy in \fIoutfile\fR before the new ZIP archive is added.
.PP
If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
archive and the image file that the archive is attached to is a \fBtclsh\fR
+1 -1
View File
@@ -427,7 +427,7 @@ next(
if (INCON(L_BBND) && NEXT1('}')) {
v->now++;
INTOCON(L_BRE);
RET('}');
RETV('}', 1);
} else {
FAILW(REG_BADBR);
}
+12 -6
View File
@@ -860,8 +860,8 @@ declare 243 {
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
declare 245 {deprecated {No longer in use, changed to macro}} {
int Tcl_StringMatch(const char *str, const char *pattern)
@@ -1581,8 +1581,8 @@ declare 443 {
}
declare 444 {
int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1,
const char *sym2, Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
const char *sym2, Tcl_LibraryInitProc **proc1Ptr,
Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
Tcl_FSUnloadFileProc **unloadProcPtr)
}
declare 445 {
@@ -2448,6 +2448,9 @@ declare 0 win {
declare 1 win {
char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}
declare 3 win {
void Tcl_WinConvertError(unsigned errCode)
}
################################
# Mac OS X specific functions
@@ -2478,8 +2481,8 @@ export {
Tcl_Interp *interp)
}
export {
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
export {
void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
@@ -2508,6 +2511,9 @@ export {
export {
void Tcl_InitSubsystems(void)
}
export {
int TclZipfs_AppHook(int *argc, char ***argv)
}
# Local Variables:
# mode: tcl
+400 -329
View File
@@ -527,33 +527,38 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
* Flag values passed to Tcl_StringCaseMatch.
*/
#define TCL_MATCH_NOCASE (1<<0)
enum TclStringCaseMatchFlags {
TCL_MATCH_NOCASE = (1<<0)
};
/*
* Flag values passed to Tcl_GetRegExpFromObj.
*/
#define TCL_REG_BASIC 000000 /* BREs (convenience). */
#define TCL_REG_EXTENDED 000001 /* EREs. */
#define TCL_REG_ADVF 000002 /* Advanced features in EREs. */
#define TCL_REG_ADVANCED 000003 /* AREs (which are also EREs). */
#define TCL_REG_QUOTE 000004 /* No special characters, none. */
#define TCL_REG_NOCASE 000010 /* Ignore case. */
#define TCL_REG_NOSUB 000020 /* Don't care about subexpressions. */
#define TCL_REG_EXPANDED 000040 /* Expanded format, white space &
* comments. */
#define TCL_REG_NLSTOP 000100 /* \n doesn't match . or [^ ] */
#define TCL_REG_NLANCH 000200 /* ^ matches after \n, $ before. */
#define TCL_REG_NEWLINE 000300 /* Newlines are line terminators. */
#define TCL_REG_CANMATCH 001000 /* Report details on partial/limited
* matches. */
enum TclRegExpObjFlags {
TCL_REG_BASIC = 00000, /* BREs (convenience). */
TCL_REG_EXTENDED = 00001, /* EREs. */
TCL_REG_ADVF = 00002, /* Advanced features in EREs. */
TCL_REG_ADVANCED = 00003, /* AREs (which are also EREs). */
TCL_REG_QUOTE = 00004, /* No special characters, none. */
TCL_REG_NOCASE = 00010, /* Ignore case. */
TCL_REG_NOSUB = 00020, /* Don't care about subexpressions. */
TCL_REG_EXPANDED = 00040, /* Expanded format, white space & comments. */
TCL_REG_NLSTOP = 00100, /* \n doesn't match . or [^ ] */
TCL_REG_NLANCH = 00200, /* ^ matches after \n, $ before. */
TCL_REG_NEWLINE = 00300, /* Newlines are line terminators. */
TCL_REG_CANMATCH = 01000 /* Report details on partial/limited
* matches. */
};
/*
* Flags values passed to Tcl_RegExpExecObj.
*/
#define TCL_REG_NOTBOL 0001 /* Beginning of string does not match ^. */
#define TCL_REG_NOTEOL 0002 /* End of string does not match $. */
enum TclRegExpExecFlags {
TCL_REG_NOTBOL = 0001, /* Beginning of string does not match ^. */
TCL_REG_NOTEOL = 0002 /* End of string does not match $. */
};
/*
* Structures filled in by Tcl_RegExpInfo. Note that all offset values are
@@ -592,25 +597,36 @@ typedef struct stat *Tcl_OldStat_;
* Tcl_GetObjResult() or Tcl_GetStringResult() to read the interpreter's
* result. See the SetResult man page for details. Besides this result, the
* command function returns an integer code, which is one of the following:
*
* TCL_OK Command completed normally; the interpreter's result
* contains the command's result.
* TCL_ERROR The command couldn't be completed successfully; the
* interpreter's result describes what went wrong.
* TCL_RETURN The command requests that the current function return;
* the interpreter's result contains the function's
* return value.
* TCL_BREAK The command requests that the innermost loop be
* exited; the interpreter's result is meaningless.
* TCL_CONTINUE Go on to the next iteration of the current loop; the
* interpreter's result is meaningless.
*/
#define TCL_OK 0
#define TCL_ERROR 1
#define TCL_RETURN 2
#define TCL_BREAK 3
#define TCL_CONTINUE 4
enum TclStandardResultCodes {
TCL_OK = 0, /* Command completed normally; the
* interpreter's result contains the command's
* result. */
TCL_ERROR = 1, /* The command couldn't be completed
* successfully; the interpreter's result
* describes what went wrong. */
TCL_RETURN = 2, /* The command requests that the current
* function return; the interpreter's result
* contains the function's return value. */
TCL_BREAK = 3, /* The command requests that the innermost
* loop be exited; the interpreter's result is
* meaningless (conventionally the empty
* string). */
TCL_CONTINUE = 4 /* Go on to the next iteration of the current
* loop; the interpreter's result is
* meaningless (conventionally the empty
* string). */
/*
* NOTE: This is NOT a closed set! Application-specific result codes
* appear in the wild, usually for doing some sort of "fast exception".
* They all behave the same, like an error except that no stack trace is
* accumulated in the errorInfo. Because there's no registry of codes
* used, they are all reserved to applications; library code cannot safely
* use them.
*/
};
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE 200
@@ -621,10 +637,12 @@ typedef struct stat *Tcl_OldStat_;
* Flags to control what substitutions are performed by Tcl_SubstObj():
*/
#define TCL_SUBST_COMMANDS 001
#define TCL_SUBST_VARIABLES 002
#define TCL_SUBST_BACKSLASHES 004
#define TCL_SUBST_ALL 007
enum TclSubstControlFlags {
TCL_SUBST_COMMANDS = 001,
TCL_SUBST_VARIABLES = 002,
TCL_SUBST_BACKSLASHES = 004,
TCL_SUBST_ALL = 007
};
/*
* Argument descriptors for math function callbacks in expressions:
@@ -697,8 +715,8 @@ typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
char *address, int port);
@@ -717,7 +735,12 @@ typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef ClientData (Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
typedef void (Tcl_MainLoopProc) (void);
#ifndef TCL_NO_DEPRECATED
# define Tcl_PackageInitProc Tcl_LibraryInitProc
# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif
/*
*----------------------------------------------------------------------------
* The following structure represents a type of object, which is a particular
@@ -958,55 +981,56 @@ typedef struct Tcl_DString {
/*
* Flag values passed to Tcl_ConvertElement.
* TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
* use backslash quoting instead.
* TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
* is safe to leave the hash unquoted when the element is not the first
* element of a list, and this flag can be used by the caller to indicate
* that condition.
*/
#define TCL_DONT_USE_BRACES 1
#define TCL_DONT_QUOTE_HASH 8
enum TclConvertElementFlags {
TCL_DONT_USE_BRACES = 1, /* Force Tcl_ConvertElement not to enclose the
* element in braces, but to use backslash
* quoting instead.*/
TCL_DONT_QUOTE_HASH = 8 /* Disable the default quoting of the '#'
* character. It is safe to leave the hash
* unquoted when the element is not the first
* element of a list, and this flag can be
* used by the caller to indicate that
* condition. */
};
/*
* Flags that may be passed to Tcl_GetIndexFromObj.
* TCL_EXACT disallows abbreviated strings.
* TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is
* a table that will not live long enough to make it worthwhile.
*/
#define TCL_EXACT 1
#define TCL_INDEX_TEMP_TABLE 2
enum TclGetIndexFromObjFlags {
TCL_EXACT = 1, /* Disallow abbreviated strings. */
TCL_INDEX_TEMP_TABLE = 2 /* Disallow caching of lookups. A possible use
* case is a table that will not live long
* enough to make it worthwhile. */
};
/*
*----------------------------------------------------------------------------
* Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
* WARNING: these bit choices must not conflict with the bit choices for
* evalFlag bits in tclInt.h!
*
* Meanings:
* TCL_NO_EVAL: Just record this command
* TCL_EVAL_GLOBAL: Execute script in global namespace
* TCL_EVAL_DIRECT: Do not compile this script
* TCL_EVAL_INVOKE: Magical Tcl_EvalObjv mode for aliases/ensembles
* o Run in iPtr->lookupNsPtr or global namespace
* o Cut out of error traces
* o Don't reset the flags controlling ensemble
* error message rewriting.
* TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the
* stack for the script in progress to be
* completely unwound.
* TCL_EVAL_NOERR: Do no exception reporting at all, just return
* as the caller will report.
*/
#define TCL_NO_EVAL 0x010000
#define TCL_EVAL_GLOBAL 0x020000
#define TCL_EVAL_DIRECT 0x040000
#define TCL_EVAL_INVOKE 0x080000
#define TCL_CANCEL_UNWIND 0x100000
#define TCL_EVAL_NOERR 0x200000
enum TclEvalFlags {
TCL_NO_EVAL = 0x010000, /* Just record this command */
TCL_EVAL_GLOBAL = 0x020000, /* Execute script in global namespace */
TCL_EVAL_DIRECT = 0x040000, /* Do not compile this script */
TCL_EVAL_INVOKE = 0x080000, /* Magical Tcl_EvalObjv mode for
* aliases/ensembles
* o Run in iPtr->lookupNsPtr or global
* namespace
* o Cut out of error traces
* o Don't reset the flags controlling
* ensemble error message rewriting. */
TCL_CANCEL_UNWIND = 0x100000,
/* Magical Tcl_CancelEval mode that causes the
* stack for the script in progress to be
* completely unwound. */
TCL_EVAL_NOERR = 0x200000 /* Do no exception reporting at all, just
* return as the caller will report. */
};
/*
* Special freeProc values that may be passed to Tcl_SetResult (see the man
@@ -1023,45 +1047,48 @@ typedef struct Tcl_DString {
* TCL_CANCEL_UNWIND, above.
*/
#define TCL_GLOBAL_ONLY 1
#define TCL_NAMESPACE_ONLY 2
#define TCL_APPEND_VALUE 4
#define TCL_LIST_ELEMENT 8
#define TCL_TRACE_READS 0x10
#define TCL_TRACE_WRITES 0x20
#define TCL_TRACE_UNSETS 0x40
#define TCL_TRACE_DESTROYED 0x80
enum TclVariableFlags {
TCL_GLOBAL_ONLY = 1,
TCL_NAMESPACE_ONLY = 2,
TCL_APPEND_VALUE = 4,
TCL_LIST_ELEMENT = 8,
TCL_TRACE_READS = 0x10,
TCL_TRACE_WRITES = 0x20,
TCL_TRACE_UNSETS = 0x40,
TCL_TRACE_DESTROYED = 0x80,
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_INTERP_DESTROYED 0x100
TCL_INTERP_DESTROYED = 0x100,
#endif
#define TCL_LEAVE_ERR_MSG 0x200
#define TCL_TRACE_ARRAY 0x800
TCL_LEAVE_ERR_MSG = 0x200,
TCL_TRACE_ARRAY = 0x800,
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE 0x1000
/* Required to support old variable/vdelete/vinfo traces. */
TCL_TRACE_OLD_STYLE = 0x1000,
#endif
/* Indicate the semantics of the result of a trace. */
#define TCL_TRACE_RESULT_DYNAMIC 0x8000
#define TCL_TRACE_RESULT_OBJECT 0x10000
/* Indicate the semantics of the result of a trace. */
TCL_TRACE_RESULT_DYNAMIC = 0x8000,
TCL_TRACE_RESULT_OBJECT = 0x10000
};
/*
* Flag values for ensemble commands.
*/
#define TCL_ENSEMBLE_PREFIX 0x02/* Flag value to say whether to allow
enum TclEnsembleFlags {
TCL_ENSEMBLE_PREFIX = 0x02 /* Flag value to say whether to allow
* unambiguous prefixes of commands or to
* require exact matches for command names. */
};
/*
* Flag values passed to command-related functions.
*/
#define TCL_TRACE_RENAME 0x2000
#define TCL_TRACE_DELETE 0x4000
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
enum TclCommandFlags {
TCL_TRACE_RENAME = 0x2000,
TCL_TRACE_DELETE = 0x4000,
TCL_ALLOW_INLINE_COMPILATION = 0x20000
};
/*
* The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
@@ -1078,28 +1105,30 @@ typedef struct Tcl_DString {
* Types for linked variables:
*/
#define TCL_LINK_INT 1
#define TCL_LINK_DOUBLE 2
#define TCL_LINK_BOOLEAN 3
#define TCL_LINK_STRING 4
#define TCL_LINK_WIDE_INT 5
#define TCL_LINK_CHAR 6
#define TCL_LINK_UCHAR 7
#define TCL_LINK_SHORT 8
#define TCL_LINK_USHORT 9
#define TCL_LINK_UINT 10
enum TclLinkVariableTypes {
TCL_LINK_INT = 1,
TCL_LINK_DOUBLE = 2,
TCL_LINK_BOOLEAN = 3,
TCL_LINK_STRING = 4,
TCL_LINK_WIDE_INT = 5,
TCL_LINK_CHAR = 6,
TCL_LINK_UCHAR = 7,
TCL_LINK_SHORT = 8,
TCL_LINK_USHORT = 9,
TCL_LINK_UINT = 10,
TCL_LINK_FLOAT = 13,
TCL_LINK_WIDE_UINT = 14,
TCL_LINK_CHARS = 15,
TCL_LINK_BINARY = 16,
#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__)
#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
TCL_LINK_LONG = ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT),
TCL_LINK_ULONG = ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT),
#else
#define TCL_LINK_LONG 11
#define TCL_LINK_ULONG 12
TCL_LINK_LONG = 11,
TCL_LINK_ULONG = 12,
#endif
#define TCL_LINK_FLOAT 13
#define TCL_LINK_WIDE_UINT 14
#define TCL_LINK_CHARS 15
#define TCL_LINK_BINARY 16
#define TCL_LINK_READ_ONLY 0x80
TCL_LINK_READ_ONLY = 0x80
};
/*
*----------------------------------------------------------------------------
@@ -1147,21 +1176,23 @@ struct Tcl_HashEntry {
/*
* Flags used in Tcl_HashKeyType.
*
* TCL_HASH_KEY_RANDOMIZE_HASH -
* There are some things, pointers for example
* which don't hash well because they do not use
* the lower bits. If this flag is set then the
* hash table will attempt to rectify this by
* randomising the bits and then using the upper
* N bits as the index into the table.
* TCL_HASH_KEY_SYSTEM_HASH - If this flag is set then all memory internally
* allocated for the hash table that is not for an
* entry will use the system heap.
*/
#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
#define TCL_HASH_KEY_SYSTEM_HASH 0x2
enum TclHashKeyFlags {
TCL_HASH_KEY_RANDOMIZE_HASH = 0x1,
/* There are some things, pointers for example
* which don't hash well because they do not
* use the lower bits. If this flag is set
* then the hash table will attempt to rectify
* this by randomising the bits and then using
* the upper N bits as the index into the
* table. */
TCL_HASH_KEY_SYSTEM_HASH = 0x2
/* If this flag is set then all memory
* internally allocated for the hash table
* that is not for an entry will use the
* system heap. */
};
/*
* Structure definition for the methods associated with a hash table key type.
@@ -1302,12 +1333,14 @@ typedef struct {
* events:
*/
#define TCL_DONT_WAIT (1<<1)
#define TCL_WINDOW_EVENTS (1<<2)
#define TCL_FILE_EVENTS (1<<3)
#define TCL_TIMER_EVENTS (1<<4)
#define TCL_IDLE_EVENTS (1<<5) /* WAS 0x10 ???? */
#define TCL_ALL_EVENTS (~TCL_DONT_WAIT)
enum TclDoOneEventFlags {
TCL_DONT_WAIT = (1<<1),
TCL_WINDOW_EVENTS = (1<<2),
TCL_FILE_EVENTS = (1<<3),
TCL_TIMER_EVENTS = (1<<4),
TCL_IDLE_EVENTS = (1<<5), /* WAS 0x10 ???? */
TCL_ALL_EVENTS = (~TCL_DONT_WAIT)
};
/*
* The following structure defines a generic event for the Tcl event system.
@@ -1336,8 +1369,10 @@ typedef enum {
* event routines.
*/
#define TCL_SERVICE_NONE 0
#define TCL_SERVICE_ALL 1
enum TclServiceModes {
TCL_SERVICE_NONE = 0,
TCL_SERVICE_ALL = 1
};
/*
* The following structure keeps is used to hold a time value, either as an
@@ -1366,9 +1401,11 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
* indicate what sorts of events are of interest:
*/
#define TCL_READABLE (1<<1)
#define TCL_WRITABLE (1<<2)
#define TCL_EXCEPTION (1<<3)
enum TclChannelHandlerFlags {
TCL_READABLE = (1<<1),
TCL_WRITABLE = (1<<2),
TCL_EXCEPTION = (1<<3)
};
/*
* Flag values to pass to Tcl_OpenCommandChannel to indicate the disposition
@@ -1376,18 +1413,22 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
* Tcl_GetStdChannel.
*/
#define TCL_STDIN (1<<1)
#define TCL_STDOUT (1<<2)
#define TCL_STDERR (1<<3)
#define TCL_ENFORCE_MODE (1<<4)
enum TclOpenCommandChannelFlags {
TCL_STDIN = (1<<1),
TCL_STDOUT = (1<<2),
TCL_STDERR = (1<<3),
TCL_ENFORCE_MODE = (1<<4)
};
/*
* Bits passed to Tcl_DriverClose2Proc to indicate which side of a channel
* should be closed.
*/
#define TCL_CLOSE_READ (1<<1)
#define TCL_CLOSE_WRITE (1<<2)
enum TclChannelCloseFlags {
TCL_CLOSE_READ = (1<<1),
TCL_CLOSE_WRITE = (1<<2)
};
/*
* Value to use as the closeProc for a channel that supports the close2Proc
@@ -1412,8 +1453,10 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
* TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc.
*/
#define TCL_CHANNEL_THREAD_INSERT (0)
#define TCL_CHANNEL_THREAD_REMOVE (1)
enum TclChannelThreadActionOperations {
TCL_CHANNEL_THREAD_INSERT = 0,
TCL_CHANNEL_THREAD_REMOVE = 1
};
/*
* Typedefs for the various operations in a channel type:
@@ -1474,8 +1517,8 @@ typedef struct Tcl_ChannelType {
/* Version of the channel type. */
Tcl_DriverCloseProc *closeProc;
/* Function to call to close the channel, or
* NULL or TCL_CLOSE2PROC if the close2Proc should be
* used instead. */
* NULL or TCL_CLOSE2PROC if the close2Proc
* should be used instead. */
Tcl_DriverInputProc *inputProc;
/* Function to call for input on channel. */
Tcl_DriverOutputProc *outputProc;
@@ -1542,9 +1585,10 @@ typedef struct Tcl_ChannelType {
* to the blockModeProc function in the above structure.
*/
#define TCL_MODE_BLOCKING 0 /* Put channel into blocking mode. */
#define TCL_MODE_NONBLOCKING 1 /* Put channel into nonblocking
* mode. */
enum TclChannelBlockModeFlags {
TCL_MODE_BLOCKING = 0, /* Put channel into blocking mode. */
TCL_MODE_NONBLOCKING = 1 /* Put channel into nonblocking mode. */
};
/*
*----------------------------------------------------------------------------
@@ -1573,27 +1617,33 @@ typedef struct Tcl_GlobTypeData {
* Type and permission definitions for glob command.
*/
#define TCL_GLOB_TYPE_BLOCK (1<<0)
#define TCL_GLOB_TYPE_CHAR (1<<1)
#define TCL_GLOB_TYPE_DIR (1<<2)
#define TCL_GLOB_TYPE_PIPE (1<<3)
#define TCL_GLOB_TYPE_FILE (1<<4)
#define TCL_GLOB_TYPE_LINK (1<<5)
#define TCL_GLOB_TYPE_SOCK (1<<6)
#define TCL_GLOB_TYPE_MOUNT (1<<7)
enum TclGlobTypes {
TCL_GLOB_TYPE_BLOCK = (1<<0),
TCL_GLOB_TYPE_CHAR = (1<<1),
TCL_GLOB_TYPE_DIR = (1<<2),
TCL_GLOB_TYPE_PIPE = (1<<3),
TCL_GLOB_TYPE_FILE = (1<<4),
TCL_GLOB_TYPE_LINK = (1<<5),
TCL_GLOB_TYPE_SOCK = (1<<6),
TCL_GLOB_TYPE_MOUNT = (1<<7)
};
#define TCL_GLOB_PERM_RONLY (1<<0)
#define TCL_GLOB_PERM_HIDDEN (1<<1)
#define TCL_GLOB_PERM_R (1<<2)
#define TCL_GLOB_PERM_W (1<<3)
#define TCL_GLOB_PERM_X (1<<4)
enum TclGlobPermissions {
TCL_GLOB_PERM_RONLY = (1<<0),
TCL_GLOB_PERM_HIDDEN = (1<<1),
TCL_GLOB_PERM_R = (1<<2),
TCL_GLOB_PERM_W = (1<<3),
TCL_GLOB_PERM_X = (1<<4)
};
/*
* Flags for the unload callback function.
*/
#define TCL_UNLOAD_DETACH_FROM_INTERPRETER (1<<0)
#define TCL_UNLOAD_DETACH_FROM_PROCESS (1<<1)
enum TclUnloadFlags {
TCL_UNLOAD_DETACH_FROM_INTERPRETER = (1<<0),
TCL_UNLOAD_DETACH_FROM_PROCESS = (1<<1)
};
/*
* Typedefs for the various filesystem operations:
@@ -1799,8 +1849,10 @@ typedef struct Tcl_Filesystem {
* TCL_CREATE_HARD_LINK - Create a hard link.
*/
#define TCL_CREATE_SYMBOLIC_LINK 0x01
#define TCL_CREATE_HARD_LINK 0x02
enum TclFileLinkActions {
TCL_CREATE_SYMBOLIC_LINK = 0x01,
TCL_CREATE_HARD_LINK = 0x02
};
/*
*----------------------------------------------------------------------------
@@ -1843,99 +1895,101 @@ typedef struct Tcl_Token {
/*
* Type values defined for Tcl_Token structures. These values are defined as
* mask bits so that it's easy to check for collections of types.
*
* TCL_TOKEN_WORD - The token describes one word of a command,
* from the first non-blank character of the word
* (which may be " or {) up to but not including
* the space, semicolon, or bracket that
* terminates the word. NumComponents counts the
* total number of sub-tokens that make up the
* word. This includes, for example, sub-tokens
* of TCL_TOKEN_VARIABLE tokens.
* TCL_TOKEN_SIMPLE_WORD - This token is just like TCL_TOKEN_WORD except
* that the word is guaranteed to consist of a
* single TCL_TOKEN_TEXT sub-token.
* TCL_TOKEN_TEXT - The token describes a range of literal text
* that is part of a word. NumComponents is
* always 0.
* TCL_TOKEN_BS - The token describes a backslash sequence that
* must be collapsed. NumComponents is always 0.
* TCL_TOKEN_COMMAND - The token describes a command whose result
* must be substituted into the word. The token
* includes the enclosing brackets. NumComponents
* is always 0.
* TCL_TOKEN_VARIABLE - The token describes a variable substitution,
* including the dollar sign, variable name, and
* array index (if there is one) up through the
* right parentheses. NumComponents tells how
* many additional tokens follow to represent the
* variable name. The first token will be a
* TCL_TOKEN_TEXT token that describes the
* variable name. If the variable is an array
* reference then there will be one or more
* additional tokens, of type TCL_TOKEN_TEXT,
* TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and
* TCL_TOKEN_VARIABLE, that describe the array
* index; numComponents counts the total number
* of nested tokens that make up the variable
* reference, including sub-tokens of
* TCL_TOKEN_VARIABLE tokens.
* TCL_TOKEN_SUB_EXPR - The token describes one subexpression of an
* expression, from the first non-blank character
* of the subexpression up to but not including
* the space, brace, or bracket that terminates
* the subexpression. NumComponents counts the
* total number of following subtokens that make
* up the subexpression; this includes all
* subtokens for any nested TCL_TOKEN_SUB_EXPR
* tokens. For example, a numeric value used as a
* primitive operand is described by a
* TCL_TOKEN_SUB_EXPR token followed by a
* TCL_TOKEN_TEXT token. A binary subexpression
* is described by a TCL_TOKEN_SUB_EXPR token
* followed by the TCL_TOKEN_OPERATOR token for
* the operator, then TCL_TOKEN_SUB_EXPR tokens
* for the left then the right operands.
* TCL_TOKEN_OPERATOR - The token describes one expression operator.
* An operator might be the name of a math
* function such as "abs". A TCL_TOKEN_OPERATOR
* token is always preceded by one
* TCL_TOKEN_SUB_EXPR token for the operator's
* subexpression, and is followed by zero or more
* TCL_TOKEN_SUB_EXPR tokens for the operator's
* operands. NumComponents is always 0.
* TCL_TOKEN_EXPAND_WORD - This token is just like TCL_TOKEN_WORD except
* that it marks a word that began with the
* literal character prefix "{*}". This word is
* marked to be expanded - that is, broken into
* words after substitution is complete.
*/
#define TCL_TOKEN_WORD 1
#define TCL_TOKEN_SIMPLE_WORD 2
#define TCL_TOKEN_TEXT 4
#define TCL_TOKEN_BS 8
#define TCL_TOKEN_COMMAND 16
#define TCL_TOKEN_VARIABLE 32
#define TCL_TOKEN_SUB_EXPR 64
#define TCL_TOKEN_OPERATOR 128
#define TCL_TOKEN_EXPAND_WORD 256
enum TclTokenTypes {
TCL_TOKEN_WORD = 1, /* The token describes one word of a command,
* from the first non-blank character of the
* word (which may be " or {) up to but not
* including the space, semicolon, or bracket
* that terminates the word. NumComponents
* counts the total number of sub-tokens that
* make up the word. This includes, for
* example, sub-tokens of TCL_TOKEN_VARIABLE
* tokens. */
TCL_TOKEN_SIMPLE_WORD = 2, /* This token is just like TCL_TOKEN_WORD
* except that the word is guaranteed to
* consist of a single TCL_TOKEN_TEXT
* sub-token. */
TCL_TOKEN_TEXT = 4, /* The token describes a range of literal text
* that is part of a word. NumComponents is
* always 0. */
TCL_TOKEN_BS = 8, /* The token describes a backslash sequence
* that must be collapsed. NumComponents is
* always 0. */
TCL_TOKEN_COMMAND = 16, /* The token describes a command whose result
* must be substituted into the word. The
* token includes the enclosing brackets.
* NumComponents is always 0. */
TCL_TOKEN_VARIABLE = 32, /* The token describes a variable
* substitution, including the dollar sign,
* variable name, and array index (if there is
* one) up through the right parentheses.
* NumComponents tells how many additional
* tokens follow to represent the variable
* name. The first token will be a
* TCL_TOKEN_TEXT token that describes the
* variable name. If the variable is an array
* reference then there will be one or more
* additional tokens, of type TCL_TOKEN_TEXT,
* TCL_TOKEN_BS, TCL_TOKEN_COMMAND, and
* TCL_TOKEN_VARIABLE, that describe the array
* index; numComponents counts the total
* number of nested tokens that make up the
* variable reference, including sub-tokens of
* TCL_TOKEN_VARIABLE tokens. */
TCL_TOKEN_SUB_EXPR = 64, /* The token describes one subexpression of an
* expression, from the first non-blank
* character of the subexpression up to but
* not including the space, brace, or bracket
* that terminates the subexpression.
* NumComponents counts the total number of
* following subtokens that make up the
* subexpression; this includes all subtokens
* for any nested TCL_TOKEN_SUB_EXPR tokens.
* For example, a numeric value used as a
* primitive operand is described by a
* TCL_TOKEN_SUB_EXPR token followed by a
* TCL_TOKEN_TEXT token. A binary
* subexpression is described by a
* TCL_TOKEN_SUB_EXPR token followed by the
* TCL_TOKEN_OPERATOR token for the operator,
* then TCL_TOKEN_SUB_EXPR tokens for the left
* then the right operands. */
TCL_TOKEN_OPERATOR = 128, /* The token describes one expression
* operator. An operator might be the name of
* a math function such as "abs". A
* TCL_TOKEN_OPERATOR token is always preceded
* by one TCL_TOKEN_SUB_EXPR token for the
* operator's subexpression, and is followed
* by zero or more TCL_TOKEN_SUB_EXPR tokens
* for the operator's operands. NumComponents
* is always 0. */
TCL_TOKEN_EXPAND_WORD = 256 /* This token is just like TCL_TOKEN_WORD
* except that it marks a word that began with
* the literal character prefix "{*}". This
* word is marked to be expanded - that is,
* broken into words after substitution is
* complete. */
};
/*
* Parsing error types. On any parsing error, one of these values will be
* stored in the error field of the Tcl_Parse structure defined below.
*/
#define TCL_PARSE_SUCCESS 0
#define TCL_PARSE_QUOTE_EXTRA 1
#define TCL_PARSE_BRACE_EXTRA 2
#define TCL_PARSE_MISSING_BRACE 3
#define TCL_PARSE_MISSING_BRACKET 4
#define TCL_PARSE_MISSING_PAREN 5
#define TCL_PARSE_MISSING_QUOTE 6
#define TCL_PARSE_MISSING_VAR_BRACE 7
#define TCL_PARSE_SYNTAX 8
#define TCL_PARSE_BAD_NUMBER 9
enum TclParsingErrors {
TCL_PARSE_SUCCESS = 0,
TCL_PARSE_QUOTE_EXTRA = 1,
TCL_PARSE_BRACE_EXTRA = 2,
TCL_PARSE_MISSING_BRACE = 3,
TCL_PARSE_MISSING_BRACKET = 4,
TCL_PARSE_MISSING_PAREN = 5,
TCL_PARSE_MISSING_QUOTE = 6,
TCL_PARSE_MISSING_VAR_BRACE = 7,
TCL_PARSE_SYNTAX = 8,
TCL_PARSE_BAD_NUMBER = 9
};
/*
* A structure of the following type is filled in by Tcl_ParseCommand. It
@@ -2030,52 +2084,53 @@ typedef struct Tcl_EncodingType {
/*
* The following definitions are used as values for the conversion control
* flags argument when converting text from one character set to another:
*
* TCL_ENCODING_START - Signifies that the source buffer is the first
* block in a (potentially multi-block) input
* stream. Tells the conversion function to reset
* to an initial state and perform any
* initialization that needs to occur before the
* first byte is converted. If the source buffer
* contains the entire input stream to be
* converted, this flag should be set.
* TCL_ENCODING_END - Signifies that the source buffer is the last
* block in a (potentially multi-block) input
* stream. Tells the conversion routine to
* perform any finalization that needs to occur
* after the last byte is converted and then to
* reset to an initial state. If the source
* buffer contains the entire input stream to be
* converted, this flag should be set.
* TCL_ENCODING_STOPONERROR - If set, the converter returns immediately upon
* encountering an invalid byte sequence or a
* source character that has no mapping in the
* target encoding. If clear, the converter
* substitues the problematic character(s) with
* one or more "close" characters in the
* destination buffer and then continues to
* convert the source.
* TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a
* terminating NUL byte. Since it does not need
* an extra byte for a terminating NUL, it fills
* all dstLen bytes with encoded UTF-8 content if
* needed. If clear, a byte is reserved in the
* dst space for NUL termination, and a
* terminating NUL is appended.
* TCL_ENCODING_CHAR_LIMIT - If set and dstCharsPtr is not NULL, then
* Tcl_ExternalToUtf takes the initial value of
* *dstCharsPtr as a limit of the maximum number
* of chars to produce in the encoded UTF-8
* content. Otherwise, the number of chars
* produced is controlled only by other limiting
* factors.
*/
#define TCL_ENCODING_START 0x01
#define TCL_ENCODING_END 0x02
#define TCL_ENCODING_STOPONERROR 0x04
#define TCL_ENCODING_NO_TERMINATE 0x08
#define TCL_ENCODING_CHAR_LIMIT 0x10
enum TclEncodingFlags {
TCL_ENCODING_START = 1, /* Signifies that the source buffer is the
* first block in a (potentially multi-block)
* input stream. Tells the conversion function
* to reset to an initial state and perform
* any initialization that needs to occur
* before the first byte is converted. If the
* source buffer contains the entire input
* stream to be converted, this flag should be
* set. */
TCL_ENCODING_END = 2, /* Signifies that the source buffer is the
* last block in a (potentially multi-block)
* input stream. Tells the conversion routine
* to perform any finalization that needs to
* occur after the last byte is converted and
* then to reset to an initial state. If the
* source buffer contains the entire input
* stream to be converted, this flag should be
* set. */
TCL_ENCODING_STOPONERROR = 4,
/* If set, the converter returns immediately
* upon encountering an invalid byte sequence
* or a source character that has no mapping
* in the target encoding. If clear, the
* converter substitues the problematic
* character(s) with one or more "close"
* characters in the destination buffer and
* then continues to convert the source.*/
TCL_ENCODING_NO_TERMINATE = 8,
/* If set, Tcl_ExternalToUtf does not append a
* terminating NUL byte. Since it does not
* need an extra byte for a terminating NUL,
* it fills all dstLen bytes with encoded
* UTF-8 content if needed. If clear, a byte
* is reserved in the dst space for NUL
* termination, and a terminating NUL is
* appended. */
TCL_ENCODING_CHAR_LIMIT = 16/* If set and dstCharsPtr is not NULL, then
* Tcl_ExternalToUtf takes the initial value
* of *dstCharsPtr as a limit of the maximum
* number of chars to produce in the encoded
* UTF-8 content. Otherwise, the number of
* chars produced is controlled only by other
* limiting factors. */
};
/*
* The following definitions are the error codes returned by the conversion
@@ -2158,8 +2213,10 @@ typedef struct Tcl_Config {
* interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument.
*/
#define TCL_LIMIT_COMMANDS 0x01
#define TCL_LIMIT_TIME 0x02
enum TclLimitHandlerTypes {
TCL_LIMIT_COMMANDS = 0x01,
TCL_LIMIT_TIME = 0x02
};
/*
* Structure containing information about a limit handler to be called when a
@@ -2213,15 +2270,17 @@ typedef struct {
* documentation for details.
*/
#define TCL_ARGV_CONSTANT 15
#define TCL_ARGV_INT 16
#define TCL_ARGV_STRING 17
#define TCL_ARGV_REST 18
#define TCL_ARGV_FLOAT 19
#define TCL_ARGV_FUNC 20
#define TCL_ARGV_GENFUNC 21
#define TCL_ARGV_HELP 22
#define TCL_ARGV_END 23
enum TclArgvInfoTypes {
TCL_ARGV_CONSTANT = 15,
TCL_ARGV_INT = 16,
TCL_ARGV_STRING = 17,
TCL_ARGV_REST = 18,
TCL_ARGV_FLOAT = 19,
TCL_ARGV_FUNC = 20,
TCL_ARGV_GENFUNC = 21,
TCL_ARGV_HELP = 22,
TCL_ARGV_END = 23
};
/*
* Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
@@ -2255,18 +2314,20 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
* Tcl_ZlibStreamInit functions.
*/
#define TCL_ZLIB_FORMAT_RAW 1
#define TCL_ZLIB_FORMAT_ZLIB 2
#define TCL_ZLIB_FORMAT_GZIP 4
#define TCL_ZLIB_FORMAT_AUTO 8
enum TclZlibFlags {
TCL_ZLIB_FORMAT_RAW = 1,
TCL_ZLIB_FORMAT_ZLIB = 2,
TCL_ZLIB_FORMAT_GZIP = 4,
TCL_ZLIB_FORMAT_AUTO = 8,
/*
* Constants that describe whether the stream is to operate in compressing or
* decompressing mode.
*/
/*
* Constants that describe whether the stream is to operate in compressing
* or decompressing mode.
*/
#define TCL_ZLIB_STREAM_DEFLATE 16
#define TCL_ZLIB_STREAM_INFLATE 32
TCL_ZLIB_STREAM_DEFLATE = 16,
TCL_ZLIB_STREAM_INFLATE = 32
};
/*
* Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is
@@ -2282,25 +2343,32 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
* Constants for types of flushing, used with Tcl_ZlibFlush.
*/
#define TCL_ZLIB_NO_FLUSH 0
#define TCL_ZLIB_FLUSH 2
#define TCL_ZLIB_FULLFLUSH 3
#define TCL_ZLIB_FINALIZE 4
enum TclZlibFlushModes {
TCL_ZLIB_NO_FLUSH = 0,
TCL_ZLIB_FLUSH = 2,
TCL_ZLIB_FULLFLUSH = 3,
TCL_ZLIB_FINALIZE = 4
};
/*
*----------------------------------------------------------------------------
* Definitions needed for the Tcl_LoadFile function. [TIP #416]
*/
#define TCL_LOAD_GLOBAL 1
#define TCL_LOAD_LAZY 2
enum TclLoadFileFlags {
TCL_LOAD_GLOBAL = 1,
TCL_LOAD_LAZY = 2
};
/*
*----------------------------------------------------------------------------
* Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
*/
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)
enum TclOpenTcpServerFlags {
TCL_TCPSERVER_REUSEADDR = (1<<0),
TCL_TCPSERVER_REUSEPORT = (1<<1)
};
/*
* Constants for special int-typed values, see TIP #494
@@ -2380,6 +2448,9 @@ EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
EXTERN void Tcl_InitSubsystems(void);
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#ifndef TCL_NO_DEPRECATED
# define Tcl_StaticPackage Tcl_StaticLibrary
#endif
#ifdef _WIN32
EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
+7 -5
View File
@@ -94,7 +94,7 @@ union overhead {
#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
#define NBUCKETS (13 - (MINBLOCK >> 4))
#define MAXMALLOC (1<<(NBUCKETS+2))
#define MAXMALLOC ((size_t)1 << (NBUCKETS+2))
static union overhead *nextf[NBUCKETS];
/*
@@ -583,7 +583,7 @@ TclpRealloc(
Tcl_MutexUnlock(allocMutexPtr);
return (void *)(overPtr+1);
}
maxSize = 1 << (i+3);
maxSize = (size_t)1 << (i+3);
expensive = 0;
if (numBytes+OVERHEAD > maxSize) {
expensive = 1;
@@ -656,18 +656,18 @@ mstats(
for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
fprintf(stderr, " %u", j);
}
totalFree += ((size_t)j) * (1 << (i + 3));
totalFree += ((size_t)j) * ((size_t)1 << (i + 3));
}
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
totalUsed += numMallocs[i] * ((size_t)1 << (i + 3));
}
fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
totalUsed, totalFree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
fprintf(stderr, "\n\tNumber of big (>%" TCL_Z_MODIFIER "u) blocks in use: %" TCL_Z_MODIFIER "u\n",
MAXMALLOC, numMallocs[NBUCKETS]);
Tcl_MutexUnlock(allocMutexPtr);
@@ -748,6 +748,8 @@ TclpRealloc(
}
#endif /* !USE_TCLALLOC */
#else
TCL_MAC_EMPTY_FILE(generic_tclAlloc_c)
#endif /* !TCL_THREADS */
/*
+6 -2
View File
@@ -774,6 +774,10 @@ Tcl_CreateInterp(void)
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
#ifdef _WIN32
# define getenv(x) _wgetenv(L##x) /* On Windows, use _wgetenv below */
#endif
/* TIP #268 */
#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
@@ -3509,6 +3513,8 @@ Tcl_DeleteCommandFromToken(
if (cmdPtr->tracePtr != NULL) {
CommandTrace *tracePtr;
/* Note that CallCommandTraces() never frees cmdPtr, that's
* done just before Tcl_DeleteCommandFromToken() returns */
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
/*
@@ -3678,7 +3684,6 @@ CallCommandTraces(
}
}
cmdPtr->flags |= CMD_TRACE_ACTIVE;
cmdPtr->refCount++;
result = NULL;
active.nextPtr = iPtr->activeCmdTracePtr;
@@ -3736,7 +3741,6 @@ CallCommandTraces(
*/
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
cmdPtr->refCount--;
iPtr->activeCmdTracePtr = active.nextPtr;
Tcl_Release(iPtr);
return result;
+39 -12
View File
@@ -1650,19 +1650,37 @@ ClockGetenvObjCmd(
int objc,
Tcl_Obj *const objv[])
{
#ifdef _WIN32
const WCHAR *varName;
const WCHAR *varValue;
Tcl_DString ds;
#else
const char *varName;
const char *varValue;
#endif
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
#ifdef _WIN32
Tcl_DStringInit(&ds);
varName = Tcl_UtfToWCharDString(TclGetString(objv[1]), -1, &ds);
varValue = _wgetenv(varName);
if (varValue == NULL) {
Tcl_DStringFree(&ds);
} else {
Tcl_DStringSetLength(&ds, 0);
Tcl_WCharToUtfDString(varValue, -1, &ds);
Tcl_DStringResult(interp, &ds);
}
#else
varName = TclGetString(objv[1]);
varValue = getenv(varName);
if (varValue == NULL) {
varValue = "";
if (varValue != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
#endif
return TCL_OK;
}
@@ -2021,15 +2039,24 @@ ClockSecondsObjCmd(
*----------------------------------------------------------------------
*/
#ifdef _WIN32
#define getenv(x) _wgetenv(L##x)
#else
#define WCHAR char
#define wcslen strlen
#define wcscmp strcmp
#define wcscpy strcpy
#endif
static void
TzsetIfNecessary(void)
{
static char *tzWas = (char *)INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
static long tzLastRefresh = 0; /* Used for latency before next refresh */
static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling,
that TZ changed via TCL */
const char *tzIsNow; /* Current value of TZ */
const WCHAR *tzIsNow; /* Current value of TZ */
/*
* Prevent performance regression on some platforms by resolving of system time zone:
@@ -2047,17 +2074,17 @@ TzsetIfNecessary(void)
Tcl_MutexLock(&clockMutex);
tzIsNow = getenv("TZ");
if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
|| strcmp(tzIsNow, tzWas) != 0)) {
if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1)
|| wcscmp(tzIsNow, tzWas) != 0)) {
tzset();
if (tzWas != NULL && tzWas != INT2PTR(-1)) {
if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) {
ckfree(tzWas);
}
tzWas = (char *)ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
tzWas = (WCHAR *)ckalloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1));
wcscpy(tzWas, tzIsNow);
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
if (tzWas != INT2PTR(-1)) ckfree(tzWas);
if (tzWas != (WCHAR *)INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
}
Tcl_MutexUnlock(&clockMutex);
+9 -7
View File
@@ -86,12 +86,14 @@ typedef struct {
* following values.
*/
#define SORTMODE_ASCII 0
#define SORTMODE_INTEGER 1
#define SORTMODE_REAL 2
#define SORTMODE_COMMAND 3
#define SORTMODE_DICTIONARY 4
#define SORTMODE_ASCII_NC 8
enum SortModeFlags {
SORTMODE_ASCII = 0,
SORTMODE_INTEGER = 1,
SORTMODE_REAL = 2,
SORTMODE_COMMAND = 3,
SORTMODE_DICTIONARY = 4,
SORTMODE_ASCII_NC = 8
};
/*
* Forward declarations for procedures defined in this file:
@@ -1700,7 +1702,7 @@ InfoLoadedCmd(
} else { /* Get pkgs just in specified interp. */
packageName = TclGetString(objv[2]);
}
return TclGetLoadedPackagesEx(interp, interpName, packageName);
return TclGetLoadedLibraries(interp, interpName, packageName);
}
/*
+73 -84
View File
@@ -123,26 +123,27 @@ enum Marks {
* store a NODE_TYPE code.
*/
#define NODE_TYPE 0xC0
enum NodeTypeFlags {
NODE_TYPE = 0xC0,
/*
* The four category values are LEAF, UNARY, and BINARY, explained below, and
* "uncategorized", which is used either temporarily, until context determines
* which of the other three categories is correct, or for lexemes like
* INVALID, which aren't really lexemes at all, but indicators of a parsing
* error. Note that the codes must be distinct to distinguish categories, but
* need not take the form of a bit array.
*/
/*
* The four category values are LEAF, UNARY, and BINARY, explained below,
* and "uncategorized", which is used either temporarily, until context
* determines which of the other three categories is correct, or for
* lexemes like INVALID, which aren't really lexemes at all, but
* indicators of a parsing error. Note that the codes must be distinct to
* distinguish categories, but need not take the form of a bit array.
*/
#define BINARY 0x40 /* This lexeme is a binary operator. An OpNode
BINARY = 0x40, /* This lexeme is a binary operator. An OpNode
* representing it should go into the parse
* tree, and two operands should be parsed for
* it in the expression. */
#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode
UNARY = 0x80, /* This lexeme is a unary operator. An OpNode
* representing it should go into the parse
* tree, and one operand should be parsed for
* it in the expression. */
#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse
LEAF = 0xC0 /* This lexeme is a leaf operand in the parse
* tree. No OpNode will be placed in the tree
* for it. Either a literal value will be
* appended to the list of literals in this
@@ -150,47 +151,42 @@ enum Marks {
* be appended in a Tcl_Parse struct to
* represent those leaves that require some
* form of substitution. */
};
/* Uncategorized lexemes */
enum LexemeTypes {
/* Uncategorized lexemes */
#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or
PLUS = 1, /* Ambiguous. Resolves to UNARY_PLUS or
* BINARY_PLUS according to context. */
#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or
MINUS = 2, /* Ambiguous. Resolves to UNARY_MINUS or
* BINARY_MINUS according to context. */
#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to
BAREWORD = 3, /* Ambigous. Resolves to BOOLEAN or to
* FUNCTION or a parse error according to
* context and value. */
#define INCOMPLETE 4 /* A parse error. Used only when the single
INCOMPLETE = 4, /* A parse error. Used only when the single
* "=" is encountered. */
#define INVALID 5 /* A parse error. Used when any punctuation
INVALID = 5, /* A parse error. Used when any punctuation
* appears that's not a supported operator. */
#define COMMENT 6 /* Comment. Lasts to end of line or end of
COMMENT = 6, /* Comment. Lasts to end of line or end of
* expression, whichever comes first. */
/* Leaf lexemes */
/* Leaf lexemes */
#define NUMBER (LEAF | 1)
/* For literal numbers */
#define SCRIPT (LEAF | 2)
/* Script substitution; [foo] */
#define BOOLEAN (LEAF | BAREWORD)
/* For literal booleans */
#define BRACED (LEAF | 4)
/* Braced string; {foo bar} */
#define VARIABLE (LEAF | 5)
/* Variable substitution; $x */
#define QUOTED (LEAF | 6)
/* Quoted string; "foo $bar [soom]" */
#define EMPTY (LEAF | 7)
/* Used only for an empty argument list to a
NUMBER = (LEAF | 1), /* For literal numbers */
SCRIPT = (LEAF | 2), /* Script substitution; [foo] */
BOOLEAN = (LEAF | BAREWORD),/* For literal booleans */
BRACED = (LEAF | 4), /* Braced string; {foo bar} */
VARIABLE = (LEAF | 5), /* Variable substitution; $x */
QUOTED = (LEAF | 6), /* Quoted string; "foo $bar [soom]" */
EMPTY = (LEAF | 7), /* Used only for an empty argument list to a
* function. Represents the empty string
* within parens in the expression: rand() */
/* Unary operator lexemes */
/* Unary operator lexemes */
#define UNARY_PLUS (UNARY | PLUS)
#define UNARY_MINUS (UNARY | MINUS)
#define FUNCTION (UNARY | BAREWORD)
UNARY_PLUS = (UNARY | PLUS),
UNARY_MINUS = (UNARY | MINUS),
FUNCTION = (UNARY | BAREWORD),
/* This is a bit of "creative interpretation"
* on the part of the parser. A function call
* is parsed into the parse tree according to
@@ -206,69 +202,62 @@ enum Marks {
* include such exceptional handling in the
* code against the need we would otherwise
* have for more lexeme categories. */
#define START (UNARY | 4)
/* This lexeme isn't parsed from the
START = (UNARY | 4), /* This lexeme isn't parsed from the
* expression text at all. It represents the
* start of the expression and sits at the
* root of the parse tree where it serves as
* the start/end point of traversals. */
#define OPEN_PAREN (UNARY | 5)
/* Another bit of creative interpretation,
OPEN_PAREN = (UNARY | 5), /* Another bit of creative interpretation,
* where we treat "(" as a unary operator with
* the sub-expression between it and its
* matching ")" as its operand. See
* CLOSE_PAREN below. */
#define NOT (UNARY | 6)
#define BIT_NOT (UNARY | 7)
NOT = (UNARY | 6),
BIT_NOT = (UNARY | 7),
/* Binary operator lexemes */
/* Binary operator lexemes */
#define BINARY_PLUS (BINARY | PLUS)
#define BINARY_MINUS (BINARY | MINUS)
#define COMMA (BINARY | 3)
/* The "," operator is a low precedence binary
BINARY_PLUS = (BINARY | PLUS),
BINARY_MINUS = (BINARY | MINUS),
COMMA = (BINARY | 3), /* The "," operator is a low precedence binary
* operator that separates the arguments in a
* function call. The additional constraint
* that this operator can only legally appear
* at the right places within a function call
* argument list are hard coded within
* ParseExpr(). */
#define MULT (BINARY | 4)
#define DIVIDE (BINARY | 5)
#define MOD (BINARY | 6)
#define LESS (BINARY | 7)
#define GREATER (BINARY | 8)
#define BIT_AND (BINARY | 9)
#define BIT_XOR (BINARY | 10)
#define BIT_OR (BINARY | 11)
#define QUESTION (BINARY | 12)
/* These two lexemes make up the */
#define COLON (BINARY | 13)
/* ternary conditional operator, $x ? $y : $z.
* ParseExpr(). */
MULT = (BINARY | 4),
DIVIDE = (BINARY | 5),
MOD = (BINARY | 6),
LESS = (BINARY | 7),
GREATER = (BINARY | 8),
BIT_AND = (BINARY | 9),
BIT_XOR = (BINARY | 10),
BIT_OR = (BINARY | 11),
QUESTION = (BINARY | 12), /* These two lexemes make up the */
COLON = (BINARY | 13), /* ternary conditional operator, $x ? $y : $z.
* We treat them as two binary operators to
* avoid another lexeme category, and code the
* additional constraints directly in
* ParseExpr(). For instance, the right
* operand of a "?" operator must be a ":"
* operator. */
#define LEFT_SHIFT (BINARY | 14)
#define RIGHT_SHIFT (BINARY | 15)
#define LEQ (BINARY | 16)
#define GEQ (BINARY | 17)
#define EQUAL (BINARY | 18)
#define NEQ (BINARY | 19)
#define AND (BINARY | 20)
#define OR (BINARY | 21)
#define STREQ (BINARY | 22)
#define STRNEQ (BINARY | 23)
#define EXPON (BINARY | 24)
/* Unlike the other binary operators, EXPON is
LEFT_SHIFT = (BINARY | 14),
RIGHT_SHIFT = (BINARY | 15),
LEQ = (BINARY | 16),
GEQ = (BINARY | 17),
EQUAL = (BINARY | 18),
NEQ = (BINARY | 19),
AND = (BINARY | 20),
OR = (BINARY | 21),
STREQ = (BINARY | 22),
STRNEQ = (BINARY | 23),
EXPON = (BINARY | 24), /* Unlike the other binary operators, EXPON is
* right associative and this distinction is
* coded directly in ParseExpr(). */
#define IN_LIST (BINARY | 25)
#define NOT_IN_LIST (BINARY | 26)
#define CLOSE_PAREN (BINARY | 27)
/* By categorizing the CLOSE_PAREN lexeme as a
IN_LIST = (BINARY | 25),
NOT_IN_LIST = (BINARY | 26),
CLOSE_PAREN = (BINARY | 27),/* By categorizing the CLOSE_PAREN lexeme as a
* BINARY operator, the normal parsing rules
* for binary operators assure that a close
* paren will not directly follow another
@@ -283,17 +272,17 @@ enum Marks {
* parse tree. The sub-expression between
* parens becomes the single argument of the
* matching OPEN_PAREN unary operator. */
#define STR_LT (BINARY | 28)
#define STR_GT (BINARY | 29)
#define STR_LEQ (BINARY | 30)
#define STR_GEQ (BINARY | 31)
#define END (BINARY | 32)
/* This lexeme represents the end of the
STR_LT = (BINARY | 28),
STR_GT = (BINARY | 29),
STR_LEQ = (BINARY | 30),
STR_GEQ = (BINARY | 31),
END = (BINARY | 32), /* This lexeme represents the end of the
* string being parsed. Treating it as a
* binary operator follows the same logic as
* the CLOSE_PAREN lexeme and END pairs with
* START, in the same way that CLOSE_PAREN
* pairs with OPEN_PAREN. */
};
/*
* When ParseExpr() builds the parse tree it must choose which operands to
+264 -276
View File
@@ -395,21 +395,17 @@ typedef struct CompileEnv {
* CmdLocation map, and the compilation AuxData array.
*/
/*
* A PRECOMPILED bytecode struct is one that was generated from a compiled
* image rather than implicitly compiled from source
*/
#define TCL_BYTECODE_PRECOMPILED 0x0001
/*
* When a bytecode is compiled, interp or namespace resolvers have not been
* applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
*/
#define TCL_BYTECODE_RESOLVE_VARS 0x0002
#define TCL_BYTECODE_RECOMPILE 0x0004
enum BytecodeFlags {
TCL_BYTECODE_PRECOMPILED = 0x0001,
/* A PRECOMPILED bytecode struct is one that
* was generated from a compiled image rather
* than implicitly compiled from source. */
TCL_BYTECODE_RESOLVE_VARS = 0x0002,
/* When a bytecode is compiled, interp or
* namespace resolvers have not been applied
* yet: this is indicated by the this flag. */
TCL_BYTECODE_RECOMPILE = 0x0004
};
typedef struct ByteCode {
TclHandle interpHandle; /* Handle for interpreter containing the
@@ -540,316 +536,306 @@ typedef struct ByteCode {
* tclExecute.c.
*/
/* Opcodes 0 to 9 */
#define INST_DONE 0
#define INST_PUSH1 1
#define INST_PUSH4 2
#define INST_POP 3
#define INST_DUP 4
#define INST_STR_CONCAT1 5
#define INST_INVOKE_STK1 6
#define INST_INVOKE_STK4 7
#define INST_EVAL_STK 8
#define INST_EXPR_STK 9
#ifdef _BUILD_TCL_EXECUTE
#define IS_DEPRECATED /* nothing */
#else
#define IS_DEPRECATED TCL_DEPRECATED_API("no longer used")
#endif /* _BUILD_TCL_EXECUTE*/
/* Opcodes 10 to 23 */
#define INST_LOAD_SCALAR1 10
#define INST_LOAD_SCALAR4 11
#define INST_LOAD_SCALAR_STK 12
#define INST_LOAD_ARRAY1 13
#define INST_LOAD_ARRAY4 14
#define INST_LOAD_ARRAY_STK 15
#define INST_LOAD_STK 16
#define INST_STORE_SCALAR1 17
#define INST_STORE_SCALAR4 18
#define INST_STORE_SCALAR_STK 19
#define INST_STORE_ARRAY1 20
#define INST_STORE_ARRAY4 21
#define INST_STORE_ARRAY_STK 22
#define INST_STORE_STK 23
enum TclBytecodeOpcodes {
/* Opcodes 0 to 9: Basic operations */
INST_DONE = 0,
INST_PUSH1 = 1,
INST_PUSH4 = 2,
INST_POP = 3,
INST_DUP = 4,
INST_STR_CONCAT1 = 5,
INST_INVOKE_STK1 = 6,
INST_INVOKE_STK4 = 7,
INST_EVAL_STK = 8,
INST_EXPR_STK = 9,
/* Opcodes 24 to 33 */
#define INST_INCR_SCALAR1 24
#define INST_INCR_SCALAR_STK 25
#define INST_INCR_ARRAY1 26
#define INST_INCR_ARRAY_STK 27
#define INST_INCR_STK 28
#define INST_INCR_SCALAR1_IMM 29
#define INST_INCR_SCALAR_STK_IMM 30
#define INST_INCR_ARRAY1_IMM 31
#define INST_INCR_ARRAY_STK_IMM 32
#define INST_INCR_STK_IMM 33
/* Opcodes 10 to 23: LOAD and STORE */
INST_LOAD_SCALAR1 = 10,
INST_LOAD_SCALAR4 = 11,
INST_LOAD_SCALAR_STK = 12,
INST_LOAD_ARRAY1 = 13,
INST_LOAD_ARRAY4 = 14,
INST_LOAD_ARRAY_STK = 15,
INST_LOAD_STK = 16,
INST_STORE_SCALAR1 = 17,
INST_STORE_SCALAR4 = 18,
INST_STORE_SCALAR_STK = 19,
INST_STORE_ARRAY1 = 20,
INST_STORE_ARRAY4 = 21,
INST_STORE_ARRAY_STK = 22,
INST_STORE_STK = 23,
/* Opcodes 34 to 39 */
#define INST_JUMP1 34
#define INST_JUMP4 35
#define INST_JUMP_TRUE1 36
#define INST_JUMP_TRUE4 37
#define INST_JUMP_FALSE1 38
#define INST_JUMP_FALSE4 39
/* Opcodes 24 to 33: INCR */
INST_INCR_SCALAR1 = 24,
INST_INCR_SCALAR_STK = 25,
INST_INCR_ARRAY1 = 26,
INST_INCR_ARRAY_STK = 27,
INST_INCR_STK = 28,
INST_INCR_SCALAR1_IMM = 29,
INST_INCR_SCALAR_STK_IMM = 30,
INST_INCR_ARRAY1_IMM = 31,
INST_INCR_ARRAY_STK_IMM = 32,
INST_INCR_STK_IMM = 33,
/* Opcodes 40 to 64 */
#define INST_LOR 40
#define INST_LAND 41
#define INST_BITOR 42
#define INST_BITXOR 43
#define INST_BITAND 44
#define INST_EQ 45
#define INST_NEQ 46
#define INST_LT 47
#define INST_GT 48
#define INST_LE 49
#define INST_GE 50
#define INST_LSHIFT 51
#define INST_RSHIFT 52
#define INST_ADD 53
#define INST_SUB 54
#define INST_MULT 55
#define INST_DIV 56
#define INST_MOD 57
#define INST_UPLUS 58
#define INST_UMINUS 59
#define INST_BITNOT 60
#define INST_LNOT 61
#define INST_CALL_BUILTIN_FUNC1 62
#define INST_CALL_FUNC1 63
#define INST_TRY_CVT_TO_NUMERIC 64
/* Opcodes 34 to 39: JUMP */
INST_JUMP1 = 34,
INST_JUMP4 = 35,
INST_JUMP_TRUE1 = 36,
INST_JUMP_TRUE4 = 37,
INST_JUMP_FALSE1 = 38,
INST_JUMP_FALSE4 = 39,
/* Opcodes 65 to 66 */
#define INST_BREAK 65
#define INST_CONTINUE 66
/* Opcodes 40 to 64: Expression implementation */
INST_LOR = 40,
INST_LAND = 41,
INST_BITOR = 42,
INST_BITXOR = 43,
INST_BITAND = 44,
INST_EQ = 45,
INST_NEQ = 46,
INST_LT = 47,
INST_GT = 48,
INST_LE = 49,
INST_GE = 50,
INST_LSHIFT = 51,
INST_RSHIFT = 52,
INST_ADD = 53,
INST_SUB = 54,
INST_MULT = 55,
INST_DIV = 56,
INST_MOD = 57,
INST_UPLUS = 58,
INST_UMINUS = 59,
INST_BITNOT = 60,
INST_LNOT = 61,
#ifndef NO_DEPRECATED_BYTECODES
INST_CALL_BUILTIN_FUNC1 IS_DEPRECATED = 62,
INST_CALL_FUNC1 IS_DEPRECATED = 63,
#endif
INST_TRY_CVT_TO_NUMERIC = 64,
/* Opcodes 67 to 68 */
#define INST_FOREACH_START4 67 /* DEPRECATED */
#define INST_FOREACH_STEP4 68 /* DEPRECATED */
/* Opcodes 65 to 66: Local exceptions */
INST_BREAK = 65,
INST_CONTINUE = 66,
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4 69
#define INST_END_CATCH 70
#define INST_PUSH_RESULT 71
#define INST_PUSH_RETURN_CODE 72
#ifndef NO_DEPRECATED_BYTECODES
/* Opcodes 67 to 68: Old Foreach */
INST_FOREACH_START4 IS_DEPRECATED = 67,
INST_FOREACH_STEP4 IS_DEPRECATED = 68,
#endif
/* Opcodes 73 to 78 */
#define INST_STR_EQ 73
#define INST_STR_NEQ 74
#define INST_STR_CMP 75
#define INST_STR_LEN 76
#define INST_STR_INDEX 77
#define INST_STR_MATCH 78
/* Opcodes 69 to 72: Catch */
INST_BEGIN_CATCH4 = 69,
INST_END_CATCH = 70,
INST_PUSH_RESULT = 71,
INST_PUSH_RETURN_CODE = 72,
/* Opcodes 78 to 81 */
#define INST_LIST 79
#define INST_LIST_INDEX 80
#define INST_LIST_LENGTH 81
/* Opcodes 73 to 78: misc string ops */
INST_STR_EQ = 73,
INST_STR_NEQ = 74,
INST_STR_CMP = 75,
INST_STR_LEN = 76,
INST_STR_INDEX = 77,
INST_STR_MATCH = 78,
/* Opcodes 82 to 87 */
#define INST_APPEND_SCALAR1 82
#define INST_APPEND_SCALAR4 83
#define INST_APPEND_ARRAY1 84
#define INST_APPEND_ARRAY4 85
#define INST_APPEND_ARRAY_STK 86
#define INST_APPEND_STK 87
/* Opcodes 78 to 81: misc list ops */
INST_LIST = 79,
INST_LIST_INDEX = 80,
INST_LIST_LENGTH = 81,
/* Opcodes 88 to 93 */
#define INST_LAPPEND_SCALAR1 88
#define INST_LAPPEND_SCALAR4 89
#define INST_LAPPEND_ARRAY1 90
#define INST_LAPPEND_ARRAY4 91
#define INST_LAPPEND_ARRAY_STK 92
#define INST_LAPPEND_STK 93
/* Opcodes 82 to 87: APPEND */
INST_APPEND_SCALAR1 = 82,
INST_APPEND_SCALAR4 = 83,
INST_APPEND_ARRAY1 = 84,
INST_APPEND_ARRAY4 = 85,
INST_APPEND_ARRAY_STK = 86,
INST_APPEND_STK = 87,
/* TIP #22 - LINDEX operator with flat arg list */
/* Opcodes 88 to 93: LAPPEND */
INST_LAPPEND_SCALAR1 = 88,
INST_LAPPEND_SCALAR4 = 89,
INST_LAPPEND_ARRAY1 = 90,
INST_LAPPEND_ARRAY4 = 91,
INST_LAPPEND_ARRAY_STK = 92,
INST_LAPPEND_STK = 93,
#define INST_LIST_INDEX_MULTI 94
/* TIP #22 - LINDEX operator with flat arg list */
INST_LIST_INDEX_MULTI = 94,
/*
* TIP #33 - 'lset' command. Code gen also required a Forth-like
* OVER operation.
*/
/* TIP #33 - 'lset' command. Code gen also required a Forth-like OVER
* operation. */
INST_OVER = 95,
INST_LSET_LIST = 96,
INST_LSET_FLAT = 97,
#define INST_OVER 95
#define INST_LSET_LIST 96
#define INST_LSET_FLAT 97
/* TIP#90 - 'return' command. */
INST_RETURN_IMM = 98,
/* TIP#90 - 'return' command. */
/* TIP#123 - exponentiation operator. */
INST_EXPON = 99,
#define INST_RETURN_IMM 98
/* TIP #157 - {*}... (word expansion) language syntax support. */
INST_EXPAND_START = 100,
INST_EXPAND_STKTOP = 101,
INST_INVOKE_EXPANDED = 102,
/* TIP#123 - exponentiation operator. */
/* TIP #57 - 'lassign' command. Code generation requires immediate LINDEX
* and LRANGE operators. */
INST_LIST_INDEX_IMM = 103,
INST_LIST_RANGE_IMM = 104,
#define INST_EXPON 99
INST_START_CMD = 105,
/* TIP #157 - {*}... (word expansion) language syntax support. */
INST_LIST_IN = 106,
INST_LIST_NOT_IN = 107,
#define INST_EXPAND_START 100
#define INST_EXPAND_STKTOP 101
#define INST_INVOKE_EXPANDED 102
INST_PUSH_RETURN_OPTIONS = 108,
INST_RETURN_STK = 109,
/*
* TIP #57 - 'lassign' command. Code generation requires immediate
* LINDEX and LRANGE operators.
*/
/* Dictionary (TIP#111) related commands. */
INST_DICT_GET = 110,
INST_DICT_SET = 111,
INST_DICT_UNSET = 112,
INST_DICT_INCR_IMM = 113,
INST_DICT_APPEND = 114,
INST_DICT_LAPPEND = 115,
INST_DICT_FIRST = 116,
INST_DICT_NEXT = 117,
INST_DICT_DONE = 118,
INST_DICT_UPDATE_START = 119,
INST_DICT_UPDATE_END = 120,
#define INST_LIST_INDEX_IMM 103
#define INST_LIST_RANGE_IMM 104
/* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons). */
INST_JUMP_TABLE = 121,
#define INST_START_CMD 105
/* Instructions to support compilation of global, variable, upvar and
* [namespace upvar]. */
INST_UPVAR = 122,
INST_NSUPVAR = 123,
INST_VARIABLE = 124,
#define INST_LIST_IN 106
#define INST_LIST_NOT_IN 107
/* Instruction to support compiling syntax error to bytecode */
INST_SYNTAX = 125,
#define INST_PUSH_RETURN_OPTIONS 108
#define INST_RETURN_STK 109
/* Instruction to reverse N items on top of stack */
INST_REVERSE = 126,
/*
* Dictionary (TIP#111) related commands.
*/
/* regexp instruction */
INST_REGEXP = 127,
#define INST_DICT_GET 110
#define INST_DICT_SET 111
#define INST_DICT_UNSET 112
#define INST_DICT_INCR_IMM 113
#define INST_DICT_APPEND 114
#define INST_DICT_LAPPEND 115
#define INST_DICT_FIRST 116
#define INST_DICT_NEXT 117
#define INST_DICT_DONE 118
#define INST_DICT_UPDATE_START 119
#define INST_DICT_UPDATE_END 120
/* For [info exists] compilation */
INST_EXIST_SCALAR = 128,
INST_EXIST_ARRAY = 129,
INST_EXIST_ARRAY_STK = 130,
INST_EXIST_STK = 131,
/*
* Instruction to support jumps defined by tables (instead of the classic
* [switch] technique of chained comparisons).
*/
/* For [subst] compilation */
INST_NOP = 132,
INST_RETURN_CODE_BRANCH = 133,
#define INST_JUMP_TABLE 121
/* For [unset] compilation */
INST_UNSET_SCALAR = 134,
INST_UNSET_ARRAY = 135,
INST_UNSET_ARRAY_STK = 136,
INST_UNSET_STK = 137,
/*
* Instructions to support compilation of global, variable, upvar and
* [namespace upvar].
*/
/* For [dict with], [dict exists], [dict create] and [dict merge] */
INST_DICT_EXPAND = 138,
INST_DICT_RECOMBINE_STK = 139,
INST_DICT_RECOMBINE_IMM = 140,
INST_DICT_EXISTS = 141,
INST_DICT_VERIFY = 142,
#define INST_UPVAR 122
#define INST_NSUPVAR 123
#define INST_VARIABLE 124
/* For [string map] and [regsub] compilation */
INST_STR_MAP = 143,
INST_STR_FIND = 144,
INST_STR_FIND_LAST = 145,
INST_STR_RANGE_IMM = 146,
INST_STR_RANGE = 147,
/* Instruction to support compiling syntax error to bytecode */
/* For operations to do with coroutines and other NRE-manipulators */
INST_YIELD = 148,
INST_COROUTINE_NAME = 149,
INST_TAILCALL = 150,
#define INST_SYNTAX 125
/* For compilation of basic information operations */
INST_NS_CURRENT = 151,
INST_INFO_LEVEL_NUM = 152,
INST_INFO_LEVEL_ARGS = 153,
INST_RESOLVE_COMMAND = 154,
/* Instruction to reverse N items on top of stack */
/* For compilation relating to TclOO */
INST_TCLOO_SELF = 155,
INST_TCLOO_CLASS = 156,
INST_TCLOO_NS = 157,
INST_TCLOO_IS_OBJECT = 158,
#define INST_REVERSE 126
/* For compilation of [array] subcommands */
INST_ARRAY_EXISTS_STK = 159,
INST_ARRAY_EXISTS_IMM = 160,
INST_ARRAY_MAKE_STK = 161,
INST_ARRAY_MAKE_IMM = 162,
/* regexp instruction */
INST_INVOKE_REPLACE = 163,
#define INST_REGEXP 127
INST_LIST_CONCAT = 164,
/* For [info exists] compilation */
#define INST_EXIST_SCALAR 128
#define INST_EXIST_ARRAY 129
#define INST_EXIST_ARRAY_STK 130
#define INST_EXIST_STK 131
INST_EXPAND_DROP = 165,
/* For [subst] compilation */
#define INST_NOP 132
#define INST_RETURN_CODE_BRANCH 133
/* New foreach implementation */
INST_FOREACH_START = 166,
INST_FOREACH_STEP = 167,
INST_FOREACH_END = 168,
INST_LMAP_COLLECT = 169,
/* For [unset] compilation */
#define INST_UNSET_SCALAR 134
#define INST_UNSET_ARRAY 135
#define INST_UNSET_ARRAY_STK 136
#define INST_UNSET_STK 137
/* For compilation of [string trim] and related */
INST_STR_TRIM = 170,
INST_STR_TRIM_LEFT = 171,
INST_STR_TRIM_RIGHT = 172,
/* For [dict with], [dict exists], [dict create] and [dict merge] */
#define INST_DICT_EXPAND 138
#define INST_DICT_RECOMBINE_STK 139
#define INST_DICT_RECOMBINE_IMM 140
#define INST_DICT_EXISTS 141
#define INST_DICT_VERIFY 142
INST_CONCAT_STK = 173,
/* For [string map] and [regsub] compilation */
#define INST_STR_MAP 143
#define INST_STR_FIND 144
#define INST_STR_FIND_LAST 145
#define INST_STR_RANGE_IMM 146
#define INST_STR_RANGE 147
INST_STR_UPPER = 174,
INST_STR_LOWER = 175,
INST_STR_TITLE = 176,
INST_STR_REPLACE = 177,
/* For operations to do with coroutines and other NRE-manipulators */
#define INST_YIELD 148
#define INST_COROUTINE_NAME 149
#define INST_TAILCALL 150
INST_ORIGIN_COMMAND = 178,
/* For compilation of basic information operations */
#define INST_NS_CURRENT 151
#define INST_INFO_LEVEL_NUM 152
#define INST_INFO_LEVEL_ARGS 153
#define INST_RESOLVE_COMMAND 154
INST_TCLOO_NEXT = 179,
INST_TCLOO_NEXT_CLASS = 180,
/* For compilation relating to TclOO */
#define INST_TCLOO_SELF 155
#define INST_TCLOO_CLASS 156
#define INST_TCLOO_NS 157
#define INST_TCLOO_IS_OBJECT 158
INST_YIELD_TO_INVOKE = 181,
/* For compilation of [array] subcommands */
#define INST_ARRAY_EXISTS_STK 159
#define INST_ARRAY_EXISTS_IMM 160
#define INST_ARRAY_MAKE_STK 161
#define INST_ARRAY_MAKE_IMM 162
INST_NUM_TYPE = 182,
INST_TRY_CVT_TO_BOOLEAN = 183,
INST_STR_CLASS = 184,
#define INST_INVOKE_REPLACE 163
INST_LAPPEND_LIST = 185,
INST_LAPPEND_LIST_ARRAY = 186,
INST_LAPPEND_LIST_ARRAY_STK = 187,
INST_LAPPEND_LIST_STK = 188,
#define INST_LIST_CONCAT 164
INST_CLOCK_READ = 189,
#define INST_EXPAND_DROP 165
INST_DICT_GET_DEF = 190,
/* New foreach implementation */
#define INST_FOREACH_START 166
#define INST_FOREACH_STEP 167
#define INST_FOREACH_END 168
#define INST_LMAP_COLLECT 169
/* TIP 461 */
INST_STR_LT = 191,
INST_STR_GT = 192,
INST_STR_LE = 193,
INST_STR_GE = 194,
/* For compilation of [string trim] and related */
#define INST_STR_TRIM 170
#define INST_STR_TRIM_LEFT 171
#define INST_STR_TRIM_RIGHT 172
#define INST_CONCAT_STK 173
#define INST_STR_UPPER 174
#define INST_STR_LOWER 175
#define INST_STR_TITLE 176
#define INST_STR_REPLACE 177
#define INST_ORIGIN_COMMAND 178
#define INST_TCLOO_NEXT 179
#define INST_TCLOO_NEXT_CLASS 180
#define INST_YIELD_TO_INVOKE 181
#define INST_NUM_TYPE 182
#define INST_TRY_CVT_TO_BOOLEAN 183
#define INST_STR_CLASS 184
#define INST_LAPPEND_LIST 185
#define INST_LAPPEND_LIST_ARRAY 186
#define INST_LAPPEND_LIST_ARRAY_STK 187
#define INST_LAPPEND_LIST_STK 188
#define INST_CLOCK_READ 189
#define INST_DICT_GET_DEF 190
/* TIP 461 */
#define INST_STR_LT 191
#define INST_STR_GT 192
#define INST_STR_LE 193
#define INST_STR_GE 194
/* The last opcode */
#define LAST_INST_OPCODE 194
/* The last opcode */
LAST_INST_OPCODE = 194
};
/*
* Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1237,9 +1223,11 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
#define TclFetchAuxData(envPtr, index) \
(envPtr)->auxDataArrayPtr[(index)].clientData
#define LITERAL_ON_HEAP 0x01
#define LITERAL_CMD_NAME 0x02
#define LITERAL_UNSHARED 0x04
enum LiteralFlags {
LITERAL_ON_HEAP = 0x01,
LITERAL_CMD_NAME = 0x02,
LITERAL_UNSHARED = 0x04
};
/*
* Macro used to manually adjust the stack requirements; used in cases where
+1 -1
View File
@@ -178,7 +178,7 @@ Tcl_RegisterConfig(
* QueryConfigObjCmd --
*
* Implementation of "::<package>::pkgconfig", the command to query
* configuration information embedded into a binary library.
* configuration information embedded into a library.
*
* Results:
* A standard tcl result.
+12 -11
View File
@@ -749,10 +749,10 @@ EXTERN int Tcl_SplitList(Tcl_Interp *interp,
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
const char ***argvPtr);
/* 244 */
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
const char *pkgName,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 245 */
TCL_DEPRECATED("No longer in use, changed to macro")
int Tcl_StringMatch(const char *str, const char *pattern);
@@ -1338,8 +1338,8 @@ EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
/* 444 */
EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *sym1, const char *sym2,
Tcl_PackageInitProc **proc1Ptr,
Tcl_PackageInitProc **proc2Ptr,
Tcl_LibraryInitProc **proc1Ptr,
Tcl_LibraryInitProc **proc2Ptr,
Tcl_LoadHandle *handlePtr,
Tcl_FSUnloadFileProc **unloadProcPtr);
/* 445 */
@@ -2216,7 +2216,7 @@ typedef struct TclStubs {
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 244 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
@@ -2416,7 +2416,7 @@ typedef struct TclStubs {
int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
@@ -3148,8 +3148,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_SplitList) /* 242 */
#define Tcl_SplitPath \
(tclStubsPtr->tcl_SplitPath) /* 243 */
#define Tcl_StaticPackage \
(tclStubsPtr->tcl_StaticPackage) /* 244 */
#define Tcl_StaticLibrary \
(tclStubsPtr->tcl_StaticLibrary) /* 244 */
#define Tcl_StringMatch \
(tclStubsPtr->tcl_StringMatch) /* 245 */
#define Tcl_TellOld \
@@ -3976,6 +3976,7 @@ extern const TclStubs *tclStubsPtr;
/* !END!: Do not edit above this line. */
#undef TclUnusedStubEntry
#if defined(USE_TCL_STUBS)
# undef Tcl_CreateInterp
# undef Tcl_FindExecutable
@@ -3984,7 +3985,7 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_SetPanicProc
# undef Tcl_SetExitProc
# undef Tcl_ObjSetVar2
# undef Tcl_StaticPackage
# undef Tcl_StaticLibrary
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
+1 -1
View File
@@ -950,7 +950,7 @@ Tcl_DictObjPut(
TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
dict->refCount++;
TclFreeIntRep(dictPtr)
TclFreeIntRep(dictPtr);
DictSetIntRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
+126 -207
View File
@@ -127,10 +127,12 @@ typedef struct {
* file.
*/
#define ENCODING_SINGLEBYTE 0
#define ENCODING_DOUBLEBYTE 1
#define ENCODING_MULTIBYTE 2
#define ENCODING_ESCAPE 3
enum EncodingTypes {
ENCODING_SINGLEBYTE = 0,
ENCODING_DOUBLEBYTE = 1,
ENCODING_MULTIBYTE = 2,
ENCODING_ESCAPE = 3
};
/*
* A list of directories in which Tcl should look for *.enc files. This list
@@ -220,14 +222,7 @@ static size_t unilen(const char *src);
static Tcl_EncodingConvertProc Utf16ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf16Proc;
static Tcl_EncodingConvertProc UtfToUcs2Proc;
static int UtfToUtfProc(ClientData clientData,
const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr,
int *dstWrotePtr, int *dstCharsPtr,
int pureNullMode);
static Tcl_EncodingConvertProc UtfIntToUtfExtProc;
static Tcl_EncodingConvertProc UtfExtToUtfIntProc;
static Tcl_EncodingConvertProc UtfToUtfProc;
static Tcl_EncodingConvertProc Iso88591FromUtfProc;
static Tcl_EncodingConvertProc Iso88591ToUtfProc;
@@ -517,6 +512,18 @@ FillEncodingFileMap(void)
*---------------------------------------------------------------------------
*/
/* These flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
enum EncodingFlags {
TCL_ENCODING_MODIFIED = 0x20,
/* Converting NULL bytes to 0xC0 0x80 */
/*
* Since TCL_ENCODING_MODIFIED is only used for utf-8 and TCL_ENCODING_LE
* is only used for utf-16/ucs-2, re-use the same value.
*/
TCL_ENCODING_LE = TCL_ENCODING_MODIFIED
/* Little-endian encoding */
};
void
TclInitEncodingSubsystem(void)
{
@@ -533,7 +540,7 @@ TclInitEncodingSubsystem(void)
return;
}
isLe.s = 1;
isLe.s = TCL_ENCODING_LE;
Tcl_MutexLock(&encodingMutex);
Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&encodingMutex);
@@ -553,8 +560,8 @@ TclInitEncodingSubsystem(void)
tclIdentityEncoding = Tcl_CreateEncoding(&type);
type.encodingName = "utf-8";
type.toUtfProc = UtfExtToUtfIntProc;
type.fromUtfProc = UtfIntToUtfExtProc;
type.toUtfProc = UtfToUtfProc;
type.fromUtfProc = UtfToUtfProc;
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = NULL;
@@ -565,7 +572,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "ucs-2le";
type.clientData = INT2PTR(1);
type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "ucs-2be";
type.clientData = INT2PTR(0);
@@ -579,7 +586,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 2;
type.encodingName = "utf-16le";
type.clientData = INT2PTR(1);
type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-16be";
type.clientData = INT2PTR(0);
@@ -1141,19 +1148,21 @@ Tcl_ExternalToUtfDString(
}
flags = TCL_ENCODING_START | TCL_ENCODING_END;
if (encodingPtr->toUtfProc == UtfToUtfProc) {
flags |= TCL_ENCODING_MODIFIED;
}
while (1) {
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
src += srcRead;
if (result != TCL_CONVERT_NOSPACE) {
Tcl_DStringSetLength(dstPtr, soFar);
return Tcl_DStringValue(dstPtr);
}
flags &= ~TCL_ENCODING_START;
src += srcRead;
srcLen -= srcRead;
if (Tcl_DStringLength(dstPtr) == 0) {
Tcl_DStringSetLength(dstPtr, dstLen);
@@ -1249,15 +1258,17 @@ Tcl_ExternalToUtf(
if (!noTerminate) {
/*
* If there are any null characters in the middle of the buffer,
* they will converted to the UTF-8 null character (\xC080). To get
* they will converted to the UTF-8 null character (\xC0\x80). To get
* the actual \0 at the end of the destination buffer, we need to
* append it manually. First make room for it...
*/
dstLen--;
}
if (encodingPtr->toUtfProc == UtfToUtfProc) {
flags |= TCL_ENCODING_MODIFIED;
}
do {
int savedFlags = flags;
Tcl_EncodingState savedState = *statePtr;
result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
@@ -1267,7 +1278,6 @@ Tcl_ExternalToUtf(
break;
}
dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
flags = savedFlags;
*statePtr = savedState;
} while (1);
if (!noTerminate) {
@@ -1331,8 +1341,8 @@ Tcl_UtfToExternalDString(
flags = TCL_ENCODING_START | TCL_ENCODING_END;
while (1) {
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
&dstChars);
srcLen, flags, &state, dst, dstLen,
&srcRead, &dstWrote, &dstChars);
soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
if (result != TCL_CONVERT_NOSPACE) {
@@ -1433,8 +1443,8 @@ Tcl_UtfToExternal(
dstLen -= encodingPtr->nullSize;
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
dstCharsPtr);
flags, statePtr, dst, dstLen, srcReadPtr,
dstWrotePtr, dstCharsPtr);
if (encodingPtr->nullSize == 2) {
dst[*dstWrotePtr + 1] = '\0';
}
@@ -2153,104 +2163,6 @@ BinaryProc(
return result;
}
/*
*-------------------------------------------------------------------------
*
* UtfIntToUtfExtProc --
*
* Convert from UTF-8 to UTF-8. While converting null-bytes from the
* Tcl's internal representation (0xC0, 0x80) to the official
* representation (0x00). See UtfToUtfProc for details.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfIntToUtfExtProc(
ClientData clientData,
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
* conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
char *dst, /* Output buffer in which converted string
* is stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
}
/*
*-------------------------------------------------------------------------
*
* UtfExtToUtfIntProc --
*
* Convert from UTF-8 to UTF-8 while converting null-bytes from the
* official representation (0x00) to Tcl's internal representation (0xC0,
* 0x80). See UtfToUtfProc for details.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfExtToUtfIntProc(
ClientData clientData,
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
* conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
}
/*
*-------------------------------------------------------------------------
*
@@ -2271,15 +2183,11 @@ UtfExtToUtfIntProc(
static int
UtfToUtfProc(
TCL_UNUSED(ClientData),
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_MODIFIED */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
* conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2292,21 +2200,15 @@ UtfToUtfProc(
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr, /* Filled with the number of characters that
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
int pureNullMode) /* Convert embedded nulls from internal
* representation to real null-bytes or vice
* versa. Also combine or separate surrogate pairs */
{
const char *srcStart, *srcEnd, *srcClose;
const char *dstStart, *dstEnd;
int result, numChars, charLimit = INT_MAX;
int *chPtr = (int *) statePtr;
int ch;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
}
result = TCL_OK;
srcStart = src;
@@ -2320,6 +2222,7 @@ UtfToUtfProc(
}
dstStart = dst;
flags |= PTR2INT(clientData);
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
@@ -2336,50 +2239,69 @@ UtfToUtfProc(
result = TCL_CONVERT_NOSPACE;
break;
}
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && (flags & TCL_ENCODING_MODIFIED))) {
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xC080.
*/
*dst++ = *src++;
*chPtr = 0; /* reset surrogate handling */
} else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
} else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd)
&& UCHAR(src[1]) == 0x80 && !(flags & TCL_ENCODING_MODIFIED)) {
/*
* Convert 0xC080 to real nulls when we are in output mode.
*/
*dst++ = 0;
*chPtr = 0; /* reset surrogate handling */
src += 2;
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
/*
* Always check before using TclUtfToUCS4. Not doing can so
* cause it run beyond the end of the buffer! If we happen such an
* incomplete char its bytes are made to represent themselves.
* incomplete char its bytes are made to represent themselves
* unless the user has explicitly asked to be told.
*/
*chPtr = UCHAR(*src);
src += 1;
dst += Tcl_UniCharToUtf(*chPtr, dst);
if (flags & TCL_ENCODING_MODIFIED) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_MULTIBYTE;
break;
}
ch = UCHAR(*src++);
} else {
char chbuf[2];
chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
TclUtfToUCS4(chbuf, &ch);
}
dst += Tcl_UniCharToUtf(ch, dst);
} else {
src += TclUtfToUCS4(src, chPtr);
if ((*chPtr | 0x7FF) == 0xDFFF) {
/* A surrogate character is detected, handle especially */
int low = *chPtr;
size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
continue;
int low;
size_t len = TclUtfToUCS4(src, &ch);
if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)
&& (flags & TCL_ENCODING_MODIFIED)) {
result = TCL_CONVERT_SYNTAX;
break;
}
src += len;
if ((ch | 0x7FF) == 0xDFFF) {
/*
* A surrogate character is detected, handle especially.
*/
low = ch;
len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
*dst++ = (char) ((ch | 0x80) & 0xBF);
continue;
}
src += len;
dst += Tcl_UniCharToUtf(*chPtr, dst);
*chPtr = low;
dst += Tcl_UniCharToUtf(ch, dst);
ch = low;
}
dst += Tcl_UniCharToUtf(*chPtr, dst);
dst += Tcl_UniCharToUtf(ch, dst);
}
}
@@ -2407,7 +2329,7 @@ UtfToUtfProc(
static int
Utf16ToUtfProc(
ClientData clientData, /* != NULL means LE, == NUL means BE */
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in Unicode. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2433,18 +2355,27 @@ Utf16ToUtfProc(
int result, numChars, charLimit = INT_MAX;
unsigned short ch;
flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
/* check alignment with utf-16 (2 == sizeof(UTF-16)) */
/*
* Check alignment with utf-16 (2 == sizeof(UTF-16))
*/
if ((srcLen % 2) != 0) {
result = TCL_CONVERT_MULTIBYTE;
srcLen--;
}
/* If last code point is a high surrogate, we cannot handle that yet */
if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) {
/*
* If last code point is a high surrogate, we cannot handle that yet.
*/
if ((srcLen >= 2) &&
((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) {
result = TCL_CONVERT_MULTIBYTE;
srcLen-= 2;
}
@@ -2461,15 +2392,17 @@ Utf16ToUtfProc(
break;
}
if (clientData) {
if (flags & TCL_ENCODING_LE) {
ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
}
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
* unsigned short-size data.
*/
if (ch && ch < 0x80) {
*dst++ = (ch & 0xFF);
} else {
@@ -2502,15 +2435,11 @@ Utf16ToUtfProc(
static int
UtfToUtf16Proc(
ClientData clientData, /* != NULL means LE, == NUL means BE */
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
* information used during a piecewise
* conversion. Contents of statePtr are
* initialized and/or reset by conversion
* routine under control of flags argument. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
@@ -2529,11 +2458,8 @@ UtfToUtf16Proc(
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
int ch;
if (flags & TCL_ENCODING_START) {
*statePtr = 0;
}
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2543,6 +2469,7 @@ UtfToUtf16Proc(
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
flags |= PTR2INT(clientData);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
@@ -2559,38 +2486,27 @@ UtfToUtf16Proc(
result = TCL_CONVERT_NOSPACE;
break;
}
src += TclUtfToUniChar(src, chPtr);
if (clientData) {
#if TCL_UTF_MAX > 3
if (*chPtr <= 0xFFFF) {
*dst++ = (*chPtr & 0xFF);
*dst++ = (*chPtr >> 8);
src += TclUtfToUCS4(src, &ch);
if (flags & TCL_ENCODING_LE) {
if (ch <= 0xFFFF) {
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
} else {
*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
*dst++ = (*chPtr & 0xFF);
*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
*dst++ = (ch & 0xFF);
*dst++ = ((ch >> 8) & 0x3) | 0xDC;
}
#else
*dst++ = (*chPtr & 0xFF);
*dst++ = (*chPtr >> 8);
#endif
} else {
#if TCL_UTF_MAX > 3
if (*chPtr <= 0xFFFF) {
*dst++ = (*chPtr >> 8);
*dst++ = (*chPtr & 0xFF);
if (ch <= 0xFFFF) {
*dst++ = (ch >> 8);
*dst++ = (ch & 0xFF);
} else {
*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
*dst++ = (*chPtr & 0xFF);
*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
*dst++ = ((ch >> 8) & 0x3) | 0xDC;
*dst++ = (ch & 0xFF);
}
#else
*dst++ = (*chPtr >> 8);
*dst++ = (*chPtr & 0xFF);
#endif
}
}
*srcReadPtr = src - srcStart;
@@ -2617,7 +2533,7 @@ UtfToUtf16Proc(
static int
UtfToUcs2Proc(
ClientData clientData, /* != NULL means LE, == NUL means BE */
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2645,6 +2561,7 @@ UtfToUcs2Proc(
#endif
Tcl_UniChar ch = 0;
flags |= PTR2INT(clientData);
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
@@ -2688,7 +2605,7 @@ UtfToUcs2Proc(
* casting dst to a Tcl_UniChar. [Bug 1122671]
*/
if (clientData) {
if (flags & TCL_ENCODING_LE) {
*dst++ = (ch & 0xFF);
*dst++ = (ch >> 8);
} else {
@@ -3096,7 +3013,9 @@ Iso88591FromUtfProc(
break;
}
#if TCL_UTF_MAX <= 3
if ((ch >= 0xD800) && (len < 3)) len = 4;
if ((ch >= 0xD800) && (len < 3)) {
len = 4;
}
#endif
/*
* Plunge on, using '?' as a fallback character.
@@ -3141,7 +3060,7 @@ TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
TableEncodingData *dataPtr = (TableEncodingData *)clientData;
TableEncodingData *dataPtr = (TableEncodingData *) clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
@@ -3199,7 +3118,7 @@ EscapeToUtfProc(
* correspond to the bytes stored in the
* output buffer. */
{
EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData;
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
+1 -1
View File
@@ -1513,7 +1513,7 @@ Tcl_UpdateObjCmd(
}
switch ((enum updateOptionsEnum) optionIndex) {
case OPT_IDLETASKS:
flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
break;
default:
Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
+2
View File
@@ -15,6 +15,8 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#define _BUILD_TCL_EXECUTE 1 /* Disable some warnings */
#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
+2 -1
View File
@@ -3387,7 +3387,8 @@ int
Tcl_Close(
Tcl_Interp *interp, /* Interpreter for errors. */
Tcl_Channel chan) /* The channel being closed. Must not be
* referenced in any interpreter. */
* referenced in any interpreter. May be NULL,
* in which case this is a no-op. */
{
CloseCallback *cbPtr; /* Iterate over close callbacks for this
* channel. */
+11 -7
View File
@@ -68,18 +68,22 @@ static int ExecuteCallback(TransformChannelData *ctrl,
* the procedure what to do with the result of the script it calls.
*/
#define TRANSMIT_DONT 0 /* No transfer to do. */
#define TRANSMIT_DOWN 1 /* Transfer to the underlying channel. */
#define TRANSMIT_SELF 2 /* Transfer into our channel. */
#define TRANSMIT_IBUF 3 /* Transfer to internal input buffer. */
#define TRANSMIT_NUM 4 /* Transfer number to 'maxRead'. */
enum TransmitAction {
TRANSMIT_DONT = 0, /* No transfer to do. */
TRANSMIT_DOWN = 1, /* Transfer to the underlying channel. */
TRANSMIT_SELF = 2, /* Transfer into our channel. */
TRANSMIT_IBUF = 3, /* Transfer to internal input buffer. */
TRANSMIT_NUM = 4 /* Transfer number to 'maxRead'. */
};
/*
* Codes for 'preserve' of 'ExecuteCallback'.
*/
#define P_PRESERVE 1
#define P_NO_PRESERVE 0
enum PreserveFlags {
P_PRESERVE = 1,
P_NO_PRESERVE = 0
};
/*
* Strings for the action codes delivered to the script implementing a
+112 -25
View File
@@ -44,7 +44,7 @@ static void ReflectThread(ClientData clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static long long ReflectSeekWide(ClientData clientData,
static long long ReflectSeekWide(ClientData clientData,
long long offset, int mode, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int ReflectSeek(ClientData clientData, long offset,
@@ -56,12 +56,13 @@ static int ReflectGetOption(ClientData clientData,
static int ReflectSetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
static int ReflectTruncate(ClientData clientData,
long long length);
static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
/*
* The C layer channel type/driver definition used by the reflection. This is
* a version 3 structure.
* The C layer channel type/driver definition used by the reflection.
*/
static const Tcl_ChannelType tclRChannelType = {
@@ -89,7 +90,7 @@ static const Tcl_ChannelType tclRChannelType = {
#else
NULL, /* thread action */
#endif
NULL /* truncate */
ReflectTruncate /* Truncate. NULL'able */
};
/*
@@ -103,33 +104,27 @@ typedef struct {
* Tcl level part of the channel. NULL here
* signals the channel is dead because the
* interpreter/thread containing its Tcl
* command is gone.
*/
* command is gone. */
#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler
* thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel
* thread */
#endif
Tcl_Obj *cmd; /* Callback command prefix */
Tcl_Obj *methods; /* Methods to append to command prefix */
Tcl_Obj *name; /* Name of the channel as created */
int mode; /* Mask of R/W mode */
int interest; /* Mask of events the channel is interested
* in. */
int dead; /* Boolean signal that some operations
* should no longer be attempted. */
Tcl_TimerToken readTimer; /*
A token for the timer that is scheduled in
order to call Tcl_NotifyChannel when the
channel is readable
*/
Tcl_TimerToken writeTimer; /*
A token for the timer that is scheduled in
order to call Tcl_NotifyChannel when the
channel is writable
*/
Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in
* order to call Tcl_NotifyChannel when the
* channel is readable */
Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in
* order to call Tcl_NotifyChannel when the
* channel is writable */
/*
* Note regarding the usage of timers.
@@ -187,6 +182,7 @@ static const char *const methodNames[] = {
"initialize", /* */
"read", /* OPT */
"seek", /* OPT */
"truncate", /* OPT */
"watch", /* */
"write", /* OPT */
NULL
@@ -200,6 +196,7 @@ typedef enum {
METH_INIT,
METH_READ,
METH_SEEK,
METH_TRUNCATE,
METH_WATCH,
METH_WRITE
} MethodName;
@@ -209,7 +206,8 @@ typedef enum {
(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE))
#define RANDW \
(TCL_READABLE | TCL_WRITABLE)
@@ -239,7 +237,8 @@ typedef enum {
ForwardedBlock,
ForwardedSetOpt,
ForwardedGetOpt,
ForwardedGetOptAll
ForwardedGetOptAll,
ForwardedTruncate
} ForwardedOperation;
/*
@@ -302,6 +301,10 @@ struct ForwardParamGetOpt {
const char *name; /* Name of option to get, maybe NULL */
Tcl_DString *value; /* Result */
};
struct ForwardParamTruncate {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
Tcl_WideInt length; /* I: Length of file. */
};
/*
* Now join all these together in a single union for convenience.
@@ -316,6 +319,7 @@ typedef union ForwardParam {
struct ForwardParamBlock block;
struct ForwardParamSetOpt setOpt;
struct ForwardParamGetOpt getOpt;
struct ForwardParamTruncate truncate;
} ForwardParam;
/*
@@ -706,6 +710,9 @@ TclChanCreateObjCmd(
#endif
clonePtr->wideSeekProc = NULL;
}
if (!(methods & FLAG(METH_TRUNCATE))) {
clonePtr->truncateProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
@@ -2047,6 +2054,73 @@ ReflectGetOption(
goto stop;
}
/*
*----------------------------------------------------------------------
*
* ReflectTruncate --
*
* This function is invoked to truncate a channel's file size.
*
* Results:
* A standard Tcl result code.
*
* Side effects:
* Arbitrary, as it calls upon a Tcl script.
*
*----------------------------------------------------------------------
*/
static int
ReflectTruncate(
ClientData clientData, /* Channel to query */
long long length) /* Length to truncate to. */
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
Tcl_Obj *lenObj;
int errorNum; /* EINVAL or EOK (success). */
Tcl_Obj *resObj; /* Result for 'truncate' */
/*
* Are we in the correct thread?
*/
#ifdef TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
p.truncate.length = length;
ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
if (p.base.code != TCL_OK) {
PassReceivedError(rcPtr->chan, &p);
return EINVAL;
}
return EOK;
}
#endif
/* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
Tcl_Preserve(rcPtr);
lenObj = Tcl_NewIntObj(length);
Tcl_IncrRefCount(lenObj);
if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
Tcl_SetChannelError(rcPtr->chan, resObj);
errorNum = EINVAL;
} else {
errorNum = EOK;
}
Tcl_DecrRefCount(lenObj);
Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
Tcl_Release(rcPtr);
return errorNum;
}
/*
* Helpers. =========================================================
*/
@@ -3278,6 +3352,19 @@ ForwardProc(
Tcl_Release(rcPtr);
break;
case ForwardedTruncate: {
Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length);
Tcl_IncrRefCount(lenObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
ForwardSetObjError(paramPtr, resObj);
}
Tcl_Release(rcPtr);
Tcl_DecrRefCount(lenObj);
break;
}
default:
/*
* Bad operation code.
+30 -35
View File
@@ -476,8 +476,10 @@ static int TransformLimit(ReflectedTransform *rtPtr,
* Operation codes for TransformFlush().
*/
#define FLUSH_WRITE 1
#define FLUSH_DISCARD 0
enum FlushOperations {
FLUSH_WRITE = 1,
FLUSH_DISCARD = 0
};
/*
* Main methods to plug into the 'chan' ensemble'. ==================
@@ -1113,7 +1115,6 @@ ReflectInput(
goto stop;
}
/*
* The buffer is exhausted, but the caller wants even more. We now
* have to go to the underlying channel, get more bytes and then
@@ -1149,12 +1150,10 @@ ReflectInput(
goto stop;
}
readBytes = Tcl_ReadRaw(rtPtr->parent,
(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
if (readBytes < 0) {
if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {
/*
* Down channel is blocked and offers zero additional bytes.
* The nonzero gotBytes already returned makes the total
@@ -1165,11 +1164,10 @@ ReflectInput(
}
/*
* Either the down channel is not blocked (a real error)
* or it is and there are gotBytes==0 byte copied so far.
* In either case, pass up the error, so we either report
* any real error, or do not mistakenly signal EOF by
* returning 0 to the caller.
* Either the down channel is not blocked (a real error) or it is
* and there are gotBytes==0 byte copied so far. In either case,
* pass up the error, so we either report any real error, or do
* not mistakenly signal EOF by returning 0 to the caller.
*/
*errorCodePtr = Tcl_GetErrno();
@@ -1177,34 +1175,33 @@ ReflectInput(
}
if (readBytes == 0) {
/*
* Zero returned from Tcl_ReadRaw() always indicates EOF
* on the down channel.
* Zero returned from Tcl_ReadRaw() always indicates EOF on the
* down channel.
*/
rtPtr->eofPending = 1;
/*
* Now this is a bit different. The partial data waiting is
* converted and returned.
*/
if (HAS(rtPtr->methods, METH_DRAIN)) {
if (!TransformDrain(rtPtr, errorCodePtr)) {
goto error;
}
}
if (ResultLength(&rtPtr->result) == 0) {
/*
* Now this is a bit different. The partial data waiting is
* converted and returned.
* The drain delivered nothing.
*/
if (HAS(rtPtr->methods, METH_DRAIN)) {
if (!TransformDrain(rtPtr, errorCodePtr)) {
goto error;
}
}
goto stop;
}
if (ResultLength(&rtPtr->result) == 0) {
/*
* The drain delivered nothing.
*/
goto stop;
}
continue; /* at: while (toRead > 0) */
continue; /* at: while (toRead > 0) */
} /* readBytes == 0 */
/*
@@ -1388,16 +1385,15 @@ ReflectSeekWide(
curPos = -1;
} else {
curPos = Tcl_ChannelSeekProc(parent->typePtr)(
parent->instanceData, offset, seekMode,
errorCodePtr);
parent->instanceData, offset, seekMode, errorCodePtr);
}
#else
*errorCodePtr = EINVAL;
curPos = -1;
#endif
} else {
curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
seekMode, errorCodePtr);
curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData,
offset, seekMode, errorCodePtr);
}
if (curPos == -1) {
Tcl_SetErrno(*errorCodePtr);
@@ -1423,8 +1419,7 @@ ReflectSeek(
* routine.
*/
return ReflectSeekWide(clientData, offset, seekMode,
errorCodePtr);
return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr);
}
#endif
+11 -4
View File
@@ -3009,7 +3009,7 @@ Tcl_FSLoadFile(
const char *sym1, const char *sym2,
/* Names of two functions to find in the
* dynamic shared object. */
Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr,
/* Places to store pointers to the functions
* named by sym1 and sym2. */
Tcl_LoadHandle *handlePtr, /* A place to store the token for the loaded
@@ -3027,8 +3027,8 @@ Tcl_FSLoadFile(
res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
if (res == TCL_OK) {
*proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0];
*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
*proc1Ptr = (Tcl_LibraryInitProc *) procPtrs[0];
*proc2Ptr = (Tcl_LibraryInitProc *) procPtrs[1];
} else {
*proc1Ptr = *proc2Ptr = NULL;
}
@@ -3077,6 +3077,13 @@ Tcl_FSLoadFile(
*
*/
#ifdef _WIN32
#define getenv(x) _wgetenv(L##x)
#define atoi(x) _wtoi(x)
#else
#define WCHAR char
#endif
static int
skipUnlink(
Tcl_Obj *shlibFile)
@@ -3098,7 +3105,7 @@ skipUnlink(
(void)shlibFile;
return 1;
#else
char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
WCHAR *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
if (skipstr && (skipstr[0] != '\0')) {
return atoi(skipstr);
-2
View File
@@ -1332,7 +1332,6 @@ PrintUsage(
int width, numSpaces;
#define NUM_SPACES 20
static const char spaces[] = " ";
char tmp[TCL_DOUBLE_SPACE];
Tcl_Obj *msg;
/*
@@ -1382,7 +1381,6 @@ PrintUsage(
case TCL_ARGV_FLOAT:
Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
*((double *) infoPtr->dstPtr));
sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
break;
case TCL_ARGV_STRING: {
char *string = *((char **) infoPtr->dstPtr);
+7 -6
View File
@@ -17,6 +17,7 @@ library tcl
# Define the unsupported generic interfaces.
interface tclInt
scspec EXTERN
# Declare each of the functions in the unsupported internal Tcl
# interface. These interfaces are allowed to changed between versions.
@@ -239,8 +240,8 @@ declare 55 {
# Replaced with TclpLoadFile in 8.1:
# declare 56 {
# int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
# Tcl_PackageInitProc **proc2Ptr)
# char *sym2, Tcl_LibraryInitProc **proc1Ptr,
# Tcl_LibraryInitProc **proc2Ptr)
# }
# Signature changed to take a length in 8.1:
# declare 57 {
@@ -552,8 +553,8 @@ declare 138 {
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
# char *sym2, Tcl_PackageInitProc **proc1Ptr,
# Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
# char *sym2, Tcl_LibraryInitProc **proc1Ptr,
# Tcl_LibraryInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
# int TclLooksLikeInt(const char *bytes, int length)
@@ -1025,8 +1026,8 @@ declare 256 {
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
void TclStaticLibrary(Tcl_Interp *interp, const char *prefix,
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
# TIP 431: temporary directory creation function
+346 -261
View File
@@ -230,7 +230,9 @@ typedef struct Tcl_ResolverInfo {
* (Bug #835020)
*/
#define TCL_AVOID_RESOLVERS 0x40000
enum ResolutionFlags {
TCL_AVOID_RESOLVERS = 0x40000
};
/*
*----------------------------------------------------------------
@@ -283,7 +285,7 @@ typedef struct Namespace {
* synonym. */
char *fullName; /* The namespace's fully qualified name. This
* starts with ::. */
void *clientData; /* An arbitrary value associated with this
void *clientData; /* An arbitrary value associated with this
* namespace. */
Tcl_NamespaceDeleteProc *deleteProc;
/* Procedure invoked when deleting the
@@ -366,7 +368,8 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
unsigned int exportLookupEpoch;
/* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -413,44 +416,50 @@ struct NamespacePathEntry {
/*
* Flags used to represent the status of a namespace:
*
* NS_DYING - 1 means Tcl_DeleteNamespace has been called to delete the
* namespace but there are still active call frames on the Tcl
* stack that refer to the namespace. When the last call frame
* referring to it has been popped, it's variables and command
* will be destroyed and it will be marked "dead" (NS_DEAD). The
* namespace can no longer be looked up by name.
* NS_DEAD - 1 means Tcl_DeleteNamespace has been called to delete the
* namespace and no call frames still refer to it. Its variables
* and command have already been destroyed. This bit allows the
* namespace resolution code to recognize that the namespace is
* "deleted". When the last namespaceName object in any byte code
* unit that refers to the namespace has been freed (i.e., when
* the namespace's refCount is 0), the namespace's storage will
* be freed.
* NS_KILLED - 1 means that TclTeardownNamespace has already been called on
* this namespace and it should not be called again [Bug 1355942]
* NS_SUPPRESS_COMPILATION -
* Marks the commands in this namespace for not being compiled,
* forcing them to be looked up every time.
*/
#define NS_DYING 0x01
#define NS_DEAD 0x02
#define NS_KILLED 0x04
#define NS_SUPPRESS_COMPILATION 0x08
enum NamespaceFlags {
NS_DYING = 0x01, /* Tcl_DeleteNamespace has been called to
* delete the namespace but there are still
* active call frames on the Tcl stack that
* refer to the namespace. When the last call
* frame referring to it has been popped, it's
* variables and command will be destroyed and
* it will be marked "dead" (NS_DEAD). The
* namespace can no longer be looked up by
* name. */
NS_DEAD = 0x02, /* Tcl_DeleteNamespace has been called to
* delete the namespace and no call frames
* still refer to it. Its variables and
* command have already been destroyed. This
* bit allows the namespace resolution code to
* recognize that the namespace is "deleted".
* When the last namespaceName object in any
* byte code unit that refers to the namespace
* has been freed (i.e., when the namespace's
* refCount is 0), the namespace's storage
* will be freed. */
NS_KILLED = 0x04, /* TclTeardownNamespace has already been
* called on this namespace and it should not
* be called again. [Bug 1355942] */
NS_SUPPRESS_COMPILATION = 0x08
/* Marks the commands in this namespace for
* not being compiled, forcing them to be
* looked up every time. */
};
/*
* Flags passed to TclGetNamespaceForQualName:
* Flags passed to TclGetNamespaceForQualName. Also:
*
* TCL_GLOBAL_ONLY - (see tcl.h) Look only in the global ns.
* TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns.
* TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces.
* TCL_FIND_ONLY_NS - The name sought is a namespace name.
*/
#define TCL_CREATE_NS_IF_UNKNOWN 0x800
#define TCL_FIND_ONLY_NS 0x1000
enum GetNamespaceFlags {
TCL_CREATE_NS_IF_UNKNOWN = 0x800,
/* Create unknown namespaces. */
TCL_FIND_ONLY_NS = 0x1000 /* The name sought is a namespace name. */
};
/*
* The client data for an ensemble command. This consists of the table of
@@ -534,10 +543,13 @@ typedef struct EnsembleConfig {
* Various bits for the EnsembleConfig.flags field.
*/
#define ENSEMBLE_DEAD 0x1 /* Flag value to say that the ensemble is dead
enum EnsembleFlags {
ENSEMBLE_DEAD = 0x1, /* Flag value to say that the ensemble is dead
* and on its way out. */
#define ENSEMBLE_COMPILE 0x4 /* Flag to enable bytecode compilation of an
* ensemble. */
ENSEMBLE_COMPILE = 0x4 /* Flag to enable bytecode compilation of an
* ensemble. Possible candidate for some sort
* of exposure to the public interface? */
};
/*
*----------------------------------------------------------------
@@ -554,7 +566,7 @@ typedef struct EnsembleConfig {
typedef struct VarTrace {
Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
* flags are performed on variable. */
void *clientData; /* Argument to pass to proc. */
void *clientData; /* Argument to pass to proc. */
int flags; /* What events the trace procedure is
* interested in: OR-ed combination of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
@@ -573,14 +585,14 @@ typedef struct CommandTrace {
Tcl_CommandTraceProc *traceProc;
/* Procedure to call when operations given by
* flags are performed on command. */
void *clientData; /* Argument to pass to proc. */
void *clientData; /* Argument to pass to proc. */
int flags; /* What events the trace procedure is
* interested in: OR-ed combination of
* TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
struct CommandTrace *nextPtr;
/* Next in list of traces associated with a
* particular command. */
unsigned int refCount; /* Used to ensure this structure is not
unsigned int refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -745,35 +757,38 @@ typedef struct VarInHash {
* in precompiled scripts keep working.
*/
/* Type of value (0 is scalar) */
#define VAR_ARRAY 0x1
#define VAR_LINK 0x2
enum VariableFlags {
/* Type of value (0 is scalar) */
VAR_ARRAY = 0x1,
VAR_LINK = 0x2,
/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE 0x4
#define VAR_DEAD_HASH 0x8
#define VAR_ARRAY_ELEMENT 0x1000
#define VAR_NAMESPACE_VAR 0x80 /* KEEP OLD VALUE for Itcl */
/* Type of storage (0 is compiled local) */
VAR_IN_HASHTABLE = 0x4,
VAR_DEAD_HASH = 0x8,
VAR_ARRAY_ELEMENT = 0x1000,
VAR_NAMESPACE_VAR = 0x80, /* KEEP OLD VALUE for Itcl */
#define VAR_ALL_HASH \
(VAR_IN_HASHTABLE|VAR_DEAD_HASH|VAR_NAMESPACE_VAR|VAR_ARRAY_ELEMENT)
VAR_ALL_HASH = (
VAR_IN_HASHTABLE | VAR_DEAD_HASH | VAR_NAMESPACE_VAR |
VAR_ARRAY_ELEMENT),
/* Trace and search state. */
/* Trace and search state. */
VAR_TRACED_READ = 0x10, /* TCL_TRACE_READS */
VAR_TRACED_WRITE = 0x20, /* TCL_TRACE_WRITES */
VAR_TRACED_UNSET = 0x40, /* TCL_TRACE_UNSETS */
VAR_TRACED_ARRAY = 0x800, /* TCL_TRACE_ARRAY */
VAR_TRACE_ACTIVE = 0x2000,
VAR_SEARCH_ACTIVE = 0x4000,
VAR_ALL_TRACES = (
VAR_TRACED_READ | VAR_TRACED_WRITE | VAR_TRACED_ARRAY |
VAR_TRACED_UNSET),
#define VAR_TRACED_READ 0x10 /* TCL_TRACE_READS */
#define VAR_TRACED_WRITE 0x20 /* TCL_TRACE_WRITES */
#define VAR_TRACED_UNSET 0x40 /* TCL_TRACE_UNSETS */
#define VAR_TRACED_ARRAY 0x800 /* TCL_TRACE_ARRAY */
#define VAR_TRACE_ACTIVE 0x2000
#define VAR_SEARCH_ACTIVE 0x4000
#define VAR_ALL_TRACES \
(VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_ARRAY|VAR_TRACED_UNSET)
/* Special handling on initialisation (only CompiledLocal). */
#define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */
#define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */
#define VAR_IS_ARGS 0x400
#define VAR_RESOLVED 0x8000
/* Special handling on initialisation (only CompiledLocal). */
VAR_ARGUMENT = 0x100, /* KEEP OLD VALUE! See tclProc.c */
VAR_TEMPORARY = 0x200, /* KEEP OLD VALUE! See tclProc.c */
VAR_IS_ARGS = 0x400,
VAR_RESOLVED = 0x8000
};
/*
* Macros to ensure that various flag bits are set properly for variables.
@@ -974,7 +989,7 @@ typedef struct CompiledLocal {
* is marked by a unique tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
* the name is NULL, this will just be '\0'.
* The actual size of this field will be large
* enough to hold the name. MUST BE THE LAST
@@ -1032,7 +1047,7 @@ typedef struct Trace {
int level; /* Only trace commands at nesting level less
* than or equal to this. */
Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
void *clientData; /* Arbitrary value to pass to proc. */
void *clientData; /* Arbitrary value to pass to proc. */
struct Trace *nextPtr; /* Next in list of traces for this interp. */
int flags; /* Flags governing the trace - see
* Tcl_CreateObjTrace for details. */
@@ -1063,17 +1078,16 @@ typedef struct ActiveInterpTrace {
/*
* Flag values designating types of execution traces. See tclTrace.c for
* related flag values.
*
* TCL_TRACE_ENTER_EXEC - triggers enter/enterstep traces.
* - passed to Tcl_CreateObjTrace to set up
* "enterstep" traces.
* TCL_TRACE_LEAVE_EXEC - triggers leave/leavestep traces.
* - passed to Tcl_CreateObjTrace to set up
* "leavestep" traces.
*/
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
enum ExecutionTraceTypes {
TCL_TRACE_ENTER_EXEC = 1, /* Triggers enter/enterstep traces. Passed to
* Tcl_CreateObjTrace to set up "enterstep"
* traces. */
TCL_TRACE_LEAVE_EXEC = 2 /* Triggers leave/leavestep traces. Passed to
* Tcl_CreateObjTrace to set up "leavestep"
* traces. */
};
/*
* The structure below defines an entry in the assocData hash table which is
@@ -1176,20 +1190,24 @@ typedef struct CallFrame {
/* NULL if no tailcall is scheduled */
} CallFrame;
#define FRAME_IS_PROC 0x1
#define FRAME_IS_LAMBDA 0x2
#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's
enum CallFrameFlags {
/*FRAME_IS_NAMESPACE = 0,*/ /* The frame is a namespace. Not used except
* by implication. */
FRAME_IS_PROC = 0x1, /* The frame is a standard procedure. */
FRAME_IS_LAMBDA = 0x2, /* The frame is a lambda term */
FRAME_IS_METHOD = 0x4, /* The frame is a method body, and the frame's
* clientData field contains a CallContext
* reference. Part of TIP#257. */
#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of
FRAME_IS_OO_DEFINE = 0x8, /* The frame is part of the inside workings of
* the [oo::define] command; the clientData
* field contains an Object reference that has
* been confirmed to refer to a class. Part of
* TIP#257. */
#define FRAME_IS_PRIVATE_DEFINE 0x10
FRAME_IS_PRIVATE_DEFINE = 0x10
/* Marks this frame as being used for private
* declarations with [oo::define]. Usually
* OR'd with FRAME_IS_OO_DEFINE. TIP#500. */
};
/*
* TIP #280
@@ -1312,7 +1330,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
int num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
int loc[TCLFLEXARRAY]; /* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
@@ -1336,13 +1354,15 @@ typedef struct ContLineLoc {
* types, per the context of the byte code in execution.
*/
#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */
#define TCL_LOCATION_BC (2) /* Location in byte code. */
#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
* location. */
#define TCL_LOCATION_SOURCE (4) /* Location in a file. */
#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc. */
#define TCL_LOCATION_LAST (6) /* Number of values in the enum. */
enum CmdFrameTypes {
TCL_LOCATION_EVAL = 0, /* Location in a dynamic eval script. */
TCL_LOCATION_BC = 2, /* Location in bytecode. */
TCL_LOCATION_PREBC = 3, /* Location in precompiled bytecode, no
* location. */
TCL_LOCATION_SOURCE = 4, /* Location in a file. */
TCL_LOCATION_PROC = 5, /* Location in a dynamic proc. */
TCL_LOCATION_LAST = 6 /* Number of values in the enum. */
};
/*
* Structure passed to describe procedure-like "procedures" that are not
@@ -1353,10 +1373,10 @@ typedef struct ContLineLoc {
typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData);
typedef struct {
const char *name; /* Name of this field. */
GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the
GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the
* clientData, or just use the clientData
* directly (after casting) if NULL. */
void *clientData; /* Context for above function, or Tcl_Obj* if
void *clientData; /* Context for above function, or Tcl_Obj* if
* proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
@@ -1383,8 +1403,10 @@ typedef void **TclHandle;
*----------------------------------------------------------------
*/
#define TCL_REG_BOSONLY 002000 /* Prepend \A to pattern so it only matches at
enum TclRegexpFlags {
TCL_REG_BOSONLY = 002000 /* Prepend \A to pattern so it only matches at
* the beginning of the string. */
};
/*
* These are a thin layer over TclpThreadKeyDataGet and TclpThreadKeyDataSet
@@ -1691,11 +1713,11 @@ typedef struct Command {
Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */
void *objClientData; /* Arbitrary value passed to object proc. */
Tcl_CmdProc *proc; /* String-based command procedure. */
void *clientData; /* Arbitrary value passed to string proc. */
void *clientData; /* Arbitrary value passed to string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Procedure invoked when deleting command to,
* e.g., free all client data. */
void *deleteData; /* Arbitrary value passed to deleteProc. */
void *deleteData; /* Arbitrary value passed to deleteProc. */
int flags; /* Miscellaneous bits of information about
* command. See below for definitions. */
ImportRef *importRefPtr; /* List of each imported Command created in
@@ -1711,37 +1733,32 @@ typedef struct Command {
} Command;
/*
* Flag bits for commands.
*
* CMD_DYING - If 1 the command is in the process of
* being deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored.
* CMD_TRACE_ACTIVE - If 1 the trace processing is currently
* underway for a rename/delete change. See the
* two flags below for which is currently being
* processed.
* CMD_HAS_EXEC_TRACES - If 1 means that this command has at least one
* execution trace (as opposed to simple
* delete/rename traces) in its tracePtr list.
* CMD_COMPILES_EXPANDED - If 1 this command has a compiler that
* can handle expansion (provided it is not the
* first word).
* TCL_TRACE_RENAME - A rename trace is in progress. Further
* Flag bits for commands. Also:
* TCL_TRACE_RENAME - A rename trace is in progress. Further
* recursive renames will not be traced.
* TCL_TRACE_DELETE - A delete trace is in progress. Further
* TCL_TRACE_DELETE - A delete trace is in progress. Further
* recursive deletes will not be traced.
* (these last two flags are defined in tcl.h)
* (these two flags are defined in tcl.h)
*/
#define CMD_DYING 0x01
#define CMD_TRACE_ACTIVE 0x02
#define CMD_HAS_EXEC_TRACES 0x04
#define CMD_COMPILES_EXPANDED 0x08
#define CMD_REDEF_IN_PROGRESS 0x10
#define CMD_VIA_RESOLVER 0x20
#define CMD_DEAD 0x40
enum CommandFlags {
CMD_DYING = 0x01, /* The command is in the process of being
* deleted (its deleteProc is currently
* executing). Other attempts to delete the
* command should be ignored. */
CMD_TRACE_ACTIVE = 0x02, /* The trace processing is currently underway
* for a rename/delete change. See the two
* flags (TCL_TRACE_RENAME, TCL_TRACE_DELETE)
* for which is currently being processed. */
CMD_HAS_EXEC_TRACES = 0x04,
CMD_COMPILES_EXPANDED = 0x08,
/* This command has a compiler that can handle
* expansion (provided it is not the first
* word). */
CMD_REDEF_IN_PROGRESS = 0x10,
CMD_VIA_RESOLVER = 0x20,
CMD_DEAD = 0x40
};
/*
*----------------------------------------------------------------
@@ -1804,7 +1821,7 @@ typedef struct AllocCache {
struct Cache *nextPtr; /* Linked list of cache entries. */
Tcl_ThreadId owner; /* Which thread's cache is this? */
Tcl_Obj *firstObjPtr; /* List of free objects for thread. */
int numObjects; /* Number of objects for thread. */
size_t numObjects; /* Number of objects for thread. */
} AllocCache;
/*
@@ -2267,75 +2284,81 @@ typedef struct Interp {
/*
* EvalFlag bits for Interp structures:
*
* TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with a
* code other than TCL_OK or TCL_ERROR; 0 means codes
* other than these should be turned into errors.
*/
#define TCL_ALLOW_EXCEPTIONS 0x04
#define TCL_EVAL_FILE 0x02
#define TCL_EVAL_SOURCE_IN_FRAME 0x10
#define TCL_EVAL_NORESOLVE 0x20
#define TCL_EVAL_DISCARD_RESULT 0x40
enum TclInterpEvalFlags {
TCL_ALLOW_EXCEPTIONS = 0x04,/* It's OK for the script to terminate with a
* code other than TCL_OK or TCL_ERROR; not
* set means codes other than these should be
* turned into errors. */
TCL_EVAL_FILE = 0x02,
TCL_EVAL_SOURCE_IN_FRAME = 0x10,
TCL_EVAL_NORESOLVE = 0x20,
TCL_EVAL_DISCARD_RESULT = 0x40
};
/*
* Flag bits for Interp structures:
*
* DELETED: Non-zero means the interpreter has been deleted:
* don't process any more commands for it, and destroy
* the structure as soon as all nested invocations of
* Tcl_Eval are done.
* ERR_ALREADY_LOGGED: Non-zero means information has already been logged in
* iPtr->errorInfo for the current Tcl_Eval instance, so
* Tcl_Eval needn't log it (used to implement the "error
* message log" command).
* DONT_COMPILE_CMDS_INLINE: Non-zero means that the bytecode compiler should
* not compile any commands into an inline sequence of
* instructions. This is set 1, for example, when command
* traces are requested.
* RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp
* has not be initialized. This is set 1 when we first
* use the rand() or srand() functions.
* SAFE_INTERP: Non zero means that the current interp is a safe
* interp (i.e. it has only the safe commands installed,
* less privilege than a regular interp).
* INTERP_DEBUG_FRAME: Used for switching on various extra interpreter
* debug/info mechanisms (e.g. info frame eval/uplevel
* tracing) which are performance intensive.
* INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
* active; so no further trace callbacks should be
* invoked.
* INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms
* of the wrong-num-args string in Tcl_WrongNumArgs.
* Makes it append instead of replacing and uses
* different intermediate text.
* CANCELED: Non-zero means that the script in progress should be
* canceled as soon as possible. This can be checked by
* extensions (and the core itself) by calling
* Tcl_Canceled and checking if TCL_ERROR is returned.
* This is a one-shot flag that is reset immediately upon
* being detected; however, if the TCL_CANCEL_UNWIND flag
* is set Tcl_Canceled will continue to report that the
* script in progress has been canceled thereby allowing
* the evaluation stack for the interp to be fully
* unwound.
*
* WARNING: For the sake of some extensions that have made use of former
* internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS)
* or 8 (formerly ERROR_CODE_SET).
*/
#define DELETED 1
#define ERR_ALREADY_LOGGED 4
#define INTERP_DEBUG_FRAME 0x10
#define DONT_COMPILE_CMDS_INLINE 0x20
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
#define INTERP_TRACE_IN_PROGRESS 0x200
#define INTERP_ALTERNATE_WRONG_ARGS 0x400
#define ERR_LEGACY_COPY 0x800
#define CANCELED 0x1000
enum TclInterpFlags {
DELETED = 1, /* If set, the interpreter has been deleted:
* don't process any more commands for it, and
* destroy the structure as soon as all nested
* invocations of Tcl_Eval are done. */
ERR_ALREADY_LOGGED = 4, /* If set, information has already been logged
* in iPtr->errorInfo for the current Tcl_Eval
* instance, so Tcl_Eval needn't log it (used
* to implement the "error message log"
* command). */
INTERP_DEBUG_FRAME = 0x10, /* Used for switching on various extra
* interpreter debug/info mechanisms (e.g.
* info frame eval/uplevel tracing) which are
* performance intensive. */
DONT_COMPILE_CMDS_INLINE = 0x20,
/* If set the bytecode compiler should not
* compile any commands into an inline
* sequence of instructions. This is set, for
* example, when command traces are
* requested. */
RAND_SEED_INITIALIZED = 0x40,
/* If set, the randSeed value of the interp
* has been initialized. This is set when we
* first use the rand() or srand()
* functions. */
SAFE_INTERP = 0x80, /* If set, the current interp is a safe interp
* (i.e. it has only the safe commands
* installed, less privilege than a regular
* interp). */
INTERP_TRACE_IN_PROGRESS = 0x200,
/* An interp trace is currently active; so no
* further trace callbacks should be
* invoked. */
INTERP_ALTERNATE_WRONG_ARGS = 0x400,
/* Used for listing second and subsequent
* forms of the wrong-num-args string in
* Tcl_WrongNumArgs. Makes it append instead
* of replacing and uses different
* intermediate text. Used by a few commands
* (notably [read]). */
ERR_LEGACY_COPY = 0x800,
CANCELED = 0x1000 /* If set, the script in progress should be
* canceled as soon as possible. This can be
* checked by extensions (and the core itself)
* by calling Tcl_Canceled and checking if
* TCL_ERROR is returned. This is a one-shot
* flag that is reset immediately upon being
* detected; however, if the TCL_CANCEL_UNWIND
* flag is set Tcl_Canceled will continue to
* report that the script in progress has been
* canceled thereby allowing the evaluation
* stack for the interp to be fully
* unwound. */
};
/*
* Maximum number of levels of nesting permitted in Tcl commands (used to
@@ -2413,22 +2436,21 @@ typedef enum TclEolTranslation {
/*
* Flags for TclInvoke:
*
* TCL_INVOKE_HIDDEN Invoke a hidden command; if not set, invokes
* an exposed command.
* TCL_INVOKE_NO_UNKNOWN If set, "unknown" is not invoked if the
* command to be invoked is not found. Only has
* an effect if invoking an exposed command,
* i.e. if TCL_INVOKE_HIDDEN is not also set.
* TCL_INVOKE_NO_TRACEBACK Does not record traceback information if the
* invoked command returns an error. Used if the
* caller plans on recording its own traceback
* information.
*/
#define TCL_INVOKE_HIDDEN (1<<0)
#define TCL_INVOKE_NO_UNKNOWN (1<<1)
#define TCL_INVOKE_NO_TRACEBACK (1<<2)
enum TclInvokeFlags {
TCL_INVOKE_HIDDEN = 1, /* Invoke a hidden command; if not set,
* invokes an exposed command. */
TCL_INVOKE_NO_UNKNOWN = 2, /* If set, "unknown" is not invoked if the
* command to be invoked is not found. Only
* has an effect if invoking an exposed
* command, i.e. if TCL_INVOKE_HIDDEN is not
* also set. */
TCL_INVOKE_NO_TRACEBACK = 4 /* Does not record traceback information if
* the invoked command returns an error. Used
* if the caller plans on recording its own
* traceback information. */
};
/*
* The structure used as the internal representation of Tcl list objects. This
@@ -2490,8 +2512,10 @@ typedef struct List {
* TclNRLmapCmd and their compilations.
*/
#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
enum ForeachFlags {
TCL_EACH_KEEP_NONE = 0, /* Discard iteration result like [foreach] */
TCL_EACH_COLLECT = 1 /* Collect iteration result like [lmap] */
};
/*
* Macros providing a faster path to booleans and integers:
@@ -2550,27 +2574,24 @@ typedef struct List {
/*
* Flag values for TclTraceDictPath().
*
* DICT_PATH_READ indicates that all entries on the path must exist but no
* updates will be needed.
*
* DICT_PATH_UPDATE indicates that we are going to be doing an update at the
* tip of the path, so duplication of shared objects should be done along the
* way.
*
* DICT_PATH_EXISTS indicates that we are performing an existence test and a
* lookup failure should therefore not be an error. If (and only if) this flag
* is set, TclTraceDictPath() will return the special value
* DICT_PATH_NON_EXISTENT if the path is not traceable.
*
* DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set)
* indicates that we are to create non-existent dictionaries on the path.
*/
#define DICT_PATH_READ 0
#define DICT_PATH_UPDATE 1
#define DICT_PATH_EXISTS 2
#define DICT_PATH_CREATE 5
enum DictPathFlags {
DICT_PATH_READ = 0, /* All entries on the path must exist but no
* updates will be needed. */
DICT_PATH_UPDATE = 1, /* We are going to be doing an update at the
* tip of the path, so duplication of shared
* objects should be done along the way. */
DICT_PATH_EXISTS = 2, /* We are performing an existence test and a
* lookup failure should therefore not be an
* error. If (and only if) this flag is set,
* TclTraceDictPath() will return the special
* value DICT_PATH_NON_EXISTENT if the path is
* not traceable. */
DICT_PATH_CREATE = 5 /* We are to create non-existent dictionaries
* on the path. (Also requires the
* DICT_PATH_UPDATE bit to be set.) */
};
#define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1)
@@ -2623,10 +2644,12 @@ typedef struct TclFile_ *TclFile;
* combination of the following values:
*/
#define TCL_GLOBMODE_NO_COMPLAIN 1
#define TCL_GLOBMODE_JOIN 2
#define TCL_GLOBMODE_DIR 4
#define TCL_GLOBMODE_TAILS 8
enum GlobModeFlags {
TCL_GLOBMODE_NO_COMPLAIN = 1,
TCL_GLOBMODE_JOIN = 2,
TCL_GLOBMODE_DIR = 4,
TCL_GLOBMODE_TAILS = 8
};
typedef enum Tcl_PathPart {
TCL_PATH_DIRNAME,
@@ -2695,24 +2718,22 @@ typedef struct ProcessGlobalValue {
*----------------------------------------------------------------------
*/
#define TCL_PARSE_DECIMAL_ONLY 1
/* Leading zero doesn't denote octal or
enum TclParseNumberFlags {
TCL_PARSE_DECIMAL_ONLY = 1, /* Leading zero doesn't denote octal or
* hex. */
#define TCL_PARSE_OCTAL_ONLY 2
/* Parse octal even without prefix. */
#define TCL_PARSE_HEXADECIMAL_ONLY 4
TCL_PARSE_OCTAL_ONLY = 2, /* Parse octal even without prefix. */
TCL_PARSE_HEXADECIMAL_ONLY = 4,
/* Parse hexadecimal even without prefix. */
#define TCL_PARSE_INTEGER_ONLY 8
/* Disable floating point parsing. */
#define TCL_PARSE_SCAN_PREFIXES 16
TCL_PARSE_INTEGER_ONLY = 8, /* Disable floating point parsing. */
TCL_PARSE_SCAN_PREFIXES = 16,
/* Use [scan] rules dealing with 0?
* prefixes. */
#define TCL_PARSE_NO_WHITESPACE 32
TCL_PARSE_NO_WHITESPACE = 32,
/* Reject leading/trailing whitespace. */
#define TCL_PARSE_BINARY_ONLY 64
/* Parse binary even without prefix. */
#define TCL_PARSE_NO_UNDERSCORE 128
TCL_PARSE_BINARY_ONLY = 64, /* Parse binary even without prefix. */
TCL_PARSE_NO_UNDERSCORE = 128
/* Reject underscore digit separator */
};
/*
*----------------------------------------------------------------------
@@ -2720,14 +2741,16 @@ typedef struct ProcessGlobalValue {
*----------------------------------------------------------------------
*/
#define TCL_NUMBER_INT 2
enum TclNumberTypes {
TCL_NUMBER_INT = 2,
#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */
# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */
TCL_NUMBER_LONG = 1, /* deprecated, not used any more */
TCL_NUMBER_WIDE = TCL_NUMBER_INT, /* deprecated */
#endif
#define TCL_NUMBER_BIG 3
#define TCL_NUMBER_DOUBLE 4
#define TCL_NUMBER_NAN 5
TCL_NUMBER_BIG = 3,
TCL_NUMBER_DOUBLE = 4,
TCL_NUMBER_NAN = 5
};
/*
*----------------------------------------------------------------
@@ -2739,7 +2762,6 @@ MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
@@ -2802,7 +2824,9 @@ MODULE_SCOPE size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
MODULE_SCOPE char tclEmptyString;
enum CheckEmptyStringResult {
TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
TCL_EMPTYSTRING_UNKNOWN = -1,
TCL_EMPTYSTRING_NO,
TCL_EMPTYSTRING_YES
};
/*
@@ -2871,7 +2895,7 @@ typedef struct ForIterData {
typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
const char* symbol);
struct Tcl_LoadHandle_ {
void *clientData; /* Client data is the load handle in the
void *clientData; /* Client data is the load handle in the
* native filesystem if a module was loaded
* there, or an opaque pointer to a structure
* for further bookkeeping on load-from-VFS
@@ -2885,19 +2909,16 @@ struct Tcl_LoadHandle_ {
/* Flags for conversion of doubles to digit strings */
#define TCL_DD_E_FORMAT 0x2
/* Use a fixed-length string of digits,
enum DoubleFormatFlags {
TCL_DD_E_FORMAT = 0x2, /* Use a fixed-length string of digits,
* suitable for E format*/
#define TCL_DD_F_FORMAT 0x3
/* Use a fixed number of digits after the
TCL_DD_F_FORMAT = 0x3, /* Use a fixed number of digits after the
* decimal point, suitable for F format */
#define TCL_DD_SHORTEST 0x4
/* Use the shortest possible string */
#define TCL_DD_NO_QUICK 0x8
/* Debug flag: forbid quick FP conversion */
#define TCL_DD_CONVERSION_TYPE_MASK 0x3
TCL_DD_SHORTEST = 0x4, /* Use the shortest possible string */
TCL_DD_NO_QUICK = 0x8, /* Debug flag: forbid quick FP conversion */
TCL_DD_CONVERSION_TYPE_MASK = 0x3
/* Mask to isolate the conversion type */
};
/*
*----------------------------------------------------------------
@@ -3044,7 +3065,7 @@ MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
unsigned int *sizePtr);
MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp,
MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp,
const char *targetName,
const char *packageName);
MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
@@ -3133,12 +3154,21 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp,
int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp,
Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
int len);
MODULE_SCOPE void TclpAlertNotifier(ClientData clientData);
MODULE_SCOPE void TclpServiceModeHook(int mode);
MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr);
MODULE_SCOPE void TclpCreateFileHandler(int fd, int mask,
Tcl_FileProc *proc, ClientData clientData);
MODULE_SCOPE int TclpDeleteFile(const void *path);
MODULE_SCOPE void TclpDeleteFileHandler(int fd);
MODULE_SCOPE void TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void TclpFinalizeNotifier(ClientData clientData);
MODULE_SCOPE void TclpFinalizePipes(void);
MODULE_SCOPE void TclpFinalizeSockets(void);
MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp,
@@ -3152,6 +3182,7 @@ MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE ClientData TclpInitNotifier(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
@@ -3178,8 +3209,9 @@ MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName);
MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp,
const char *fileName);
MODULE_SCOPE void * TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
MODULE_SCOPE char * TclpReadlink(const char *fileName,
@@ -4211,6 +4243,37 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
#define TCL_INDEX_END (-2)
#define TCL_INDEX_START (0)
/*
*----------------------------------------------------------------------
*
* TclScaleTime --
*
* TIP #233 (Virtualized Time): Wrapper around the time virutalisation
* rescale function to hide the binding of the clientData.
*
* This is static inline code; it's like a macro, but a function. It's
* used because this is a piece of code that ends up in places that are a
* bit performance sensitive.
*
* Results:
* None
*
* Side effects:
* Updates the time structure (given as an argument) with what the time
* should be after virtualisation.
*
*----------------------------------------------------------------------
*/
static inline void
TclScaleTime(
Tcl_Time *timePtr)
{
if (timePtr != NULL) {
tclScaleTimeProcPtr(timePtr, tclTimeClientData);
}
}
/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
@@ -4726,7 +4789,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
*----------------------------------------------------------------
*/
#ifdef WORDS_BIGENDIAN
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
#else /* !WORDS_BIGENDIAN */
# define TclUniCharNcmp Tcl_UniCharNcmp
@@ -4757,7 +4820,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclTommath_Init;
/*
*----------------------------------------------------------------------
@@ -4769,11 +4832,11 @@ MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;
*----------------------------------------------------------------------
*/
MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
/*
*----------------------------------------------------------------
@@ -5144,12 +5207,34 @@ typedef struct NRE_callback {
#define Tcl_Free(ptr) TclpFree(ptr)
#endif
/*
* Special hack for macOS, where the static linker (technically the 'ar'
* command) hates empty object files, and accepts no flags to make it shut up.
*
* These symbols are otherwise completely useless.
*
* They can't be written to or written through. They can't be seen by any
* other code. They use a separate attribute (supported by all macOS
* compilers, which are derivatives of clang or gcc) to stop the compilation
* from moaning. They will be excluded during the final linking stage.
*
* Other platforms get nothing at all. That's good.
*/
#ifdef MAC_OSX_TCL
#define TCL_MAC_EMPTY_FILE(name) \
static __attribute__((used)) const void *const TclUnusedFile_ ## name; \
static const void *const TclUnusedFile_ ## name = NULL;
#else
#define TCL_MAC_EMPTY_FILE(name)
#endif /* MAC_OSX_TCL */
/*
* Other externals.
*/
MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
* (if changed with tcl-env). */
MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment
* (if changed with tcl-env). */
#endif /* _TCLINT */
+10 -9
View File
@@ -651,10 +651,10 @@ EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const int flags);
/* 257 */
EXTERN void TclStaticPackage(Tcl_Interp *interp,
const char *pkgName,
Tcl_PackageInitProc *initProc,
Tcl_PackageInitProc *safeInitProc);
EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
@@ -925,7 +925,7 @@ typedef struct TclIntStubs {
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */
void (*tclUnusedStubEntry) (void); /* 260 */
@@ -1370,8 +1370,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclStaticLibrary \
(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclpCreateTemporaryDirectory \
(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclGetBytesFromObj \
@@ -1409,11 +1409,12 @@ extern const TclIntStubs *tclIntStubsPtr;
# undef TclGetCommandFullName
# undef TclCopyChannelOld
# undef TclSockMinimumBuffersOld
# undef Tcl_StaticPackage
# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage)
# undef Tcl_StaticLibrary
# define Tcl_StaticLibrary (tclIntStubsPtr->tclStaticLibrary)
#endif
#undef TclGuessPackageName
#undef TclUnusedStubEntry
#ifndef TCL_NO_DEPRECATED
# define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0)
#endif
+5
View File
@@ -570,6 +570,11 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# undef TclWinConvertError
# define TclWinConvertError Tcl_WinConvertError
#endif
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa
+10 -11
View File
@@ -196,18 +196,18 @@ struct LimitHandler {
/*
* Values for the LimitHandler flags field.
* LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
* processed; handlers are never to be entered reentrantly.
* LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
* should not normally be observed because when a handler is
* deleted it is also spliced out of the list of handlers, but
* even so we will be careful.
*/
#define LIMIT_HANDLER_ACTIVE 0x01
#define LIMIT_HANDLER_DELETED 0x02
enum LimitHandlerFlags {
LIMIT_HANDLER_ACTIVE = 0x01,/* Whether the handler is currently being
* processed; handlers are never to be entered
* reentrantly. */
LIMIT_HANDLER_DELETED = 0x02/* Whether the handler has been deleted. This
* should not normally be observed because
* when a handler is deleted it is also
* spliced out of the list of handlers, but
* even so we will be careful. */
};
/*
* Prototypes for local static functions:
@@ -276,7 +276,6 @@ static void TimeLimitCallback(ClientData clientData);
static Tcl_NRPostProc NRPostInvokeHidden;
static Tcl_ObjCmdProc NRInterpCmd;
static Tcl_ObjCmdProc NRChildCmd;
/*
*----------------------------------------------------------------------
+16 -18
View File
@@ -75,21 +75,19 @@ typedef struct Link {
/*
* Definitions for flag bits:
* LINK_READ_ONLY - 1 means errors should be generated if Tcl
* script attempts to write variable.
* LINK_BEING_UPDATED - 1 means that a call to Tcl_UpdateLinkedVar is
* in progress for this variable, so trace
* callbacks on the variable should be ignored.
* LINK_ALLOC_ADDR - 1 means linkPtr->addr was allocated on the
* heap.
* LINK_ALLOC_LAST - 1 means linkPtr->valueLast.p was allocated on
* the heap.
*/
#define LINK_READ_ONLY 1
#define LINK_BEING_UPDATED 2
#define LINK_ALLOC_ADDR 4
#define LINK_ALLOC_LAST 8
enum LinkFlags {
LINK_READ_ONLY = 1, /* Errors should be generated if Tcl script
* attempts to write variable. */
LINK_BEING_UPDATED = 2, /* A call to Tcl_UpdateLinkedVar is in
* progress for this variable, so trace
* callbacks on the variable should be
* ignored. */
LINK_ALLOC_ADDR = 4, /* linkPtr->addr was allocated on the heap. */
LINK_ALLOC_LAST = 8 /* linkPtr->valueLast.p was allocated on the
* heap. */
};
/*
* Forward references to functions defined later in this file:
@@ -110,11 +108,11 @@ static int SetInvalidRealFromAny(Tcl_Interp *interp,
*/
static Tcl_ObjType invalidRealType = {
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
"invalidReal", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
/*
+301 -301
View File
File diff suppressed because it is too large Load Diff
+293 -5
View File
@@ -10,6 +10,7 @@
* Copyright © 1995-1997 Sun Microsystems, Inc.
* Copyright © 1998 Scriptics Corporation.
* Copyright © 2003 Kevin B. Kenny. All rights reserved.
* Copyright © 2021 Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,11 +19,11 @@
#include "tclInt.h"
/*
* Module-scope struct of notifier hooks that are checked in the default
* Notifier hooks that are checked in the public wrappers for the default
* notifier functions (for overriding via Tcl_SetNotifier).
*/
Tcl_NotifierProcs tclNotifierHooks = {
static Tcl_NotifierProcs tclNotifierHooks = {
NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
};
@@ -174,7 +175,8 @@ TclFinalizeNotifier(void)
Tcl_Event *evPtr, *hold;
if (!tsdPtr->initialized) {
return; /* Notifier not initialized for the current thread */
return; /* Notifier not initialized for the current
* thread. */
}
Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -227,6 +229,38 @@ Tcl_SetNotifier(
Tcl_NotifierProcs *notifierProcPtr)
{
tclNotifierHooks = *notifierProcPtr;
/*
* Don't allow hooks to refer to the hook point functions; avoids infinite
* loop.
*/
if (tclNotifierHooks.setTimerProc == Tcl_SetTimer) {
tclNotifierHooks.setTimerProc = NULL;
}
if (tclNotifierHooks.waitForEventProc == Tcl_WaitForEvent) {
tclNotifierHooks.waitForEventProc = NULL;
}
if (tclNotifierHooks.initNotifierProc == Tcl_InitNotifier) {
tclNotifierHooks.initNotifierProc = NULL;
}
if (tclNotifierHooks.finalizeNotifierProc == Tcl_FinalizeNotifier) {
tclNotifierHooks.finalizeNotifierProc = NULL;
}
if (tclNotifierHooks.alertNotifierProc == Tcl_AlertNotifier) {
tclNotifierHooks.alertNotifierProc = NULL;
}
if (tclNotifierHooks.serviceModeHookProc == Tcl_ServiceModeHook) {
tclNotifierHooks.serviceModeHookProc = NULL;
}
#ifndef _WIN32
if (tclNotifierHooks.createFileHandlerProc == Tcl_CreateFileHandler) {
tclNotifierHooks.createFileHandlerProc = NULL;
}
if (tclNotifierHooks.deleteFileHandlerProc == Tcl_DeleteFileHandler) {
tclNotifierHooks.deleteFileHandlerProc = NULL;
}
#endif /* !_WIN32 */
}
/*
@@ -276,7 +310,7 @@ Tcl_CreateEventSource(
* checkProc. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
EventSource *sourcePtr = (EventSource *)ckalloc(sizeof(EventSource));
EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
sourcePtr->setupProc = setupProc;
sourcePtr->checkProc = checkProc;
@@ -794,7 +828,7 @@ Tcl_SetServiceMode(
void
Tcl_SetMaxBlockTime(
const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the
const Tcl_Time *timePtr) /* Specifies a maximum elapsed time for the
* next blocking operation in the event
* tsdPtr-> */
{
@@ -1132,6 +1166,260 @@ Tcl_ThreadAlert(
Tcl_MutexUnlock(&listLock);
}
/*
*----------------------------------------------------------------------
*
* Tcl_InitNotifier --
*
* Initializes the platform specific notifier state. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* Returns a handle to the notifier state for this thread..
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
ClientData
Tcl_InitNotifier(void)
{
if (tclNotifierHooks.initNotifierProc) {
return tclNotifierHooks.initNotifierProc();
} else {
return TclpInitNotifier();
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_FinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated. Forwards to the platform implementation when the hook
* is not enabled.
*
* Results:
* None.
*
* Side effects:
* If no finalizeNotifierProc notifier hook exists, TclpFinalizeNotifier
* is called.
*
*----------------------------------------------------------------------
*/
void
Tcl_FinalizeNotifier(
ClientData clientData)
{
if (tclNotifierHooks.finalizeNotifierProc) {
tclNotifierHooks.finalizeNotifierProc(clientData);
} else {
TclpFinalizeNotifier(clientData);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
* routine is called. This routine is guaranteed not to be called by Tcl
* on a given notifier after Tcl_FinalizeNotifier is called for that
* notifier. This routine is typically called from a thread other than
* the notifier's thread. Forwards to the platform implementation when
* the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_AlertNotifier(
ClientData clientData) /* Pointer to thread data. */
{
if (tclNotifierHooks.alertNotifierProc) {
tclNotifierHooks.alertNotifierProc(clientData);
} else {
TclpAlertNotifier(clientData);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ServiceModeHook --
*
* This function is invoked whenever the service mode changes. Forwards
* to the platform implementation when the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_ServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
if (tclNotifierHooks.serviceModeHookProc) {
tclNotifierHooks.serviceModeHookProc(mode);
} else {
TclpServiceModeHook(mode);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimer --
*
* This function sets the current notifier timer value. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* None.
*
* Side effects:
* See the platform-specific implementations.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetTimer(
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
if (tclNotifierHooks.setTimerProc) {
tclNotifierHooks.setTimerProc(timePtr);
} else {
TclpSetTimer(timePtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_WaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the notifier's message queue. If the block time is 0, then
* Tcl_WaitForEvent just polls without blocking. Forwards to the
* platform implementation when the hook is not enabled.
*
* Results:
* Returns -1 if the wait would block forever, 1 if an out-of-loop source
* was processed (see platform-specific notes) and otherwise returns 0.
*
* Side effects:
* Queues file events that are detected by the notifier.
*
*----------------------------------------------------------------------
*/
int
Tcl_WaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
if (tclNotifierHooks.waitForEventProc) {
return tclNotifierHooks.waitForEventProc(timePtr);
} else {
return TclpWaitForEvent(timePtr);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_CreateFileHandler --
*
* This function registers a file descriptor handler with the notifier.
* Forwards to the platform implementation when the hook is not enabled.
*
* This function is not defined on Windows. The OS API there is too
* different.
*
* Results:
* None.
*
* Side effects:
* Creates a new file handler structure.
*
*----------------------------------------------------------------------
*/
#ifndef _WIN32
void
Tcl_CreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
* conditions under which proc should be
* called. */
Tcl_FileProc *proc, /* Function to call for each selected
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
if (tclNotifierHooks.createFileHandlerProc) {
tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
} else {
TclpCreateFileHandler(fd, mask, proc, clientData);
}
}
#endif /* !_WIN32 */
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file
* descriptor. Forwards to the platform implementation when the hook is
* not enabled.
*
* This function is not defined on Windows. The OS API there is too
* different.
*
* Results:
* None.
*
* Side effects:
* If a callback was previously registered on the file descriptor, remove
* it.
*
*----------------------------------------------------------------------
*/
#ifndef _WIN32
void
Tcl_DeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
if (tclNotifierHooks.deleteFileHandlerProc) {
tclNotifierHooks.deleteFileHandlerProc(fd);
} else {
TclpDeleteFileHandler(fd);
}
}
#endif /* !_WIN32 */
/*
* Local Variables:
* mode: c
+5 -3
View File
@@ -105,9 +105,11 @@ typedef struct {
* Tcl_NewInstanceMethod.
*/
#define TCL_OO_METHOD_PUBLIC 1
#define TCL_OO_METHOD_UNEXPORTED 0
#define TCL_OO_METHOD_PRIVATE 0x20
enum TclOOVisibilityConstants {
TCL_OO_METHOD_PUBLIC = 1,
TCL_OO_METHOD_UNEXPORTED = 0,
TCL_OO_METHOD_PRIVATE = 0x20
};
/*
* The type of some object (or class) metadata. This describes how to delete
+20 -16
View File
@@ -51,13 +51,15 @@ typedef struct {
* Extra flags used for call chain management.
*/
#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC 0x200000
#define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
#define BUILDING_MIXINS 0x400000
#define TRAVERSED_MIXIN 0x800000
#define OBJECT_MIXIN 0x1000000
enum CallChainFlags {
DEFINITE_PROTECTED = 0x100000,
DEFINITE_PUBLIC = 0x200000,
BUILDING_MIXINS = 0x400000,
TRAVERSED_MIXIN = 0x800000,
OBJECT_MIXIN = 0x1000000,
KNOWN_STATE = (DEFINITE_PROTECTED | DEFINITE_PUBLIC),
SPECIAL = (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
};
#define MIXIN_CONSISTENT(flags) \
(((flags) & OBJECT_MIXIN) || \
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
@@ -152,7 +154,6 @@ static const Tcl_ObjType methodNameType = {
NULL,
NULL
};
/*
* ----------------------------------------------------------------------
@@ -422,6 +423,14 @@ FinalizeMethodRefs(
* ----------------------------------------------------------------------
*/
/*
* Name the bits used in the names table values.
*/
enum NameTableFlags {
IN_LIST = 1,
NO_IMPLEMENTATION = 2
};
int
TclOOGetSortedMethodList(
Object *oPtr, /* The object to get the method names for. */
@@ -453,12 +462,6 @@ TclOOGetSortedMethodList(
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
/*
* Name the bits used in the names table values.
*/
#define IN_LIST 1
#define NO_IMPLEMENTATION 2
/*
* Process method names due to the object.
*/
@@ -2027,8 +2030,9 @@ AddSimpleClassDefineNamespaces(
static inline void
AddDefinitionNamespaceToChain(
Class *const definerCls, /* What class defines this entry. */
Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a
Class *const definerCls, /* What class defines this entry. */
Tcl_Obj *const namespaceName,
/* The name for this entry (or NULL, a
* no-op). */
DefineChain *const definePtr,
/* The define chain to add the method
+28 -21
View File
@@ -112,7 +112,9 @@ typedef struct ProcedureMethod {
* methods.
*/
#define USE_DECLARER_NS 0x80
enum ProcedureMethodFlags {
USE_DECLARER_NS = 0x80,
};
/*
* Forwarded methods have the following extra information.
@@ -213,36 +215,38 @@ typedef struct Object {
* command. */
} Object;
#define OBJECT_DESTRUCTING 1 /* Indicates that an object is being or has
* been destroyed */
#define DESTRUCTOR_CALLED 2 /* Indicates that evaluation of destructor script for the
object has began */
#define OO_UNUSED_4 4 /* No longer used. */
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
enum ObjectFlags {
OBJECT_DESTRUCTING = 1, /* Indicates that an object is being or has
* been destroyed */
DESTRUCTOR_CALLED = 2, /* Indicates that evaluation of destructor
* script for the object has began */
OO_UNUSED_4 = 4, /* No longer used. */
ROOT_OBJECT = 0x1000, /* Flag to say that this object is the root of
* the class hierarchy and should be treated
* specially during teardown. */
#define FILTER_HANDLING 0x2000 /* Flag set when the object is processing a
FILTER_HANDLING = 0x2000, /* Flag set when the object is processing a
* filter; when set, filters are *not*
* processed on the object, preventing nasty
* recursive filtering problems. */
#define USE_CLASS_CACHE 0x4000 /* Flag set to say that the object is a pure
USE_CLASS_CACHE = 0x4000, /* Flag set to say that the object is a pure
* instance of the class, and has had nothing
* added that changes the dispatch chain (i.e.
* no methods, mixins, or filters. */
#define ROOT_CLASS 0x8000 /* Flag to say that this object is the root
ROOT_CLASS = 0x8000, /* Flag to say that this object is the root
* class of classes, and should be treated
* specially during teardown (and in a few
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
FORCE_UNKNOWN = 0x10000, /* States that we are *really* looking up the
* unknown method handler at that point. */
#define HAS_PRIVATE_METHODS 0x20000
HAS_PRIVATE_METHODS = 0x20000,
/* Object/class has (or had) private methods,
* and so shouldn't be cached so
* aggressively. */
#define DONT_DELETE 0x40000 /* Inhibit deletion of this object. Used
DONT_DELETE = 0x40000 /* Inhibit deletion of this object. Used
* during fundamental object type mutation to
* make sure that the object actually survives
* to the end of the operation. */
};
/*
* And the definition of a class. Note that every class also has an associated
@@ -418,17 +422,18 @@ typedef struct CallContext {
* Bits for the 'flags' field of the call chain.
*/
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
enum TclCallChainFlags {
PUBLIC_METHOD = 0x01, /* This is a public (exported) method. */
PRIVATE_METHOD = 0x02, /* This is a private (class's direct instances
* only) method. Supports itcl. */
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
#define CONSTRUCTOR 0x08 /* This is a constructor. */
#define DESTRUCTOR 0x10 /* This is a destructor. */
#define TRUE_PRIVATE_METHOD 0x20
/* This is a private method only accessible
OO_UNKNOWN_METHOD = 0x04, /* This is an unknown method. */
CONSTRUCTOR = 0x08, /* This is a constructor. */
DESTRUCTOR = 0x10, /* This is a destructor. */
TRUE_PRIVATE_METHOD = 0x20, /* This is a private method only accessible
* from other methods defined on this class
* or instance. [TIP #500] */
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
SCOPE_FLAGS = (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
};
/*
* Structure containing definition information about basic class methods.
@@ -666,7 +671,9 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
* but all arguments are used multiple times and so must have no side effects.
*/
#ifdef DUPLICATE
#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#endif /* DUPLICATE */
#define DUPLICATE(target,source,type) \
do { \
size_t len = sizeof(type) * ((target).num=(source).num);\
+29 -11
View File
@@ -1,17 +1,35 @@
/*
* Minimal set of shared macro definitions and declarations so that multiple
* source files can make use of the parsing table in tclParse.c
* tclParse.h --
*
* This file contains the minimal set of shared macro definitions and
* declarations so that multiple source files can make use of the parsing
* table in tclParse.c.
*
* Copyright (c) 2012 by Don Porter
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#define TYPE_NORMAL 0
#define TYPE_SPACE 0x1
#define TYPE_COMMAND_END 0x2
#define TYPE_SUBS 0x4
#define TYPE_QUOTE 0x8
#define TYPE_CLOSE_PAREN 0x10
#define TYPE_CLOSE_BRACK 0x20
#define TYPE_BRACE 0x40
enum ParseTypes {
TYPE_NORMAL = 0,
TYPE_SPACE = 0x1,
TYPE_COMMAND_END = 0x2,
TYPE_SUBS = 0x4,
TYPE_QUOTE = 0x8,
TYPE_CLOSE_PAREN = 0x10,
TYPE_CLOSE_BRACK = 0x20,
TYPE_BRACE = 0x40
};
#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
MODULE_SCOPE const char tclCharTypeTable[];
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+14 -10
View File
@@ -77,23 +77,27 @@ typedef struct FsPath {
* Flag values for FsPath->flags.
*/
#define TCLPATH_APPENDED 1
#define TCLPATH_NEEDNORM 4
enum FsPathFlags {
TCLPATH_APPENDED = 1,
TCLPATH_NEEDNORM = 4
};
/*
* Define some macros to give us convenient access to path-object specific
* fields.
*/
#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define PATHOBJ(pathPtr) \
((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define SETPATHOBJ(pathPtr,fsPathPtr) \
do { \
Tcl_ObjIntRep ir; \
ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \
} while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
do { \
Tcl_ObjIntRep ir; \
ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
ir.twoPtrValue.ptr2 = NULL; \
Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \
} while (0)
#define PATHFLAGS(pathPtr) \
(PATHOBJ(pathPtr)->flags)
/*
*---------------------------------------------------------------------------
+1 -1
View File
@@ -2,7 +2,7 @@
* tclPkgConfig.c --
*
* This file contains the configuration information to embed into the tcl
* binary library.
* library.
*
* Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
*
+8
View File
@@ -65,6 +65,9 @@ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
/* 1 */
EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len,
Tcl_DString *dsPtr);
/* Slot 2 is reserved */
/* 3 */
EXTERN void Tcl_WinConvertError(unsigned errCode);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
@@ -89,6 +92,8 @@ typedef struct TclPlatStubs {
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
void (*reserved2)(void);
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
@@ -114,6 +119,9 @@ extern const TclPlatStubs *tclPlatStubsPtr;
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
/* Slot 2 is reserved */
#define Tcl_WinConvertError \
(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
+6 -1
View File
@@ -464,6 +464,7 @@ Tcl_SetResult(
ResetObjResult(iPtr);
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -482,10 +483,12 @@ Tcl_SetResult(
*----------------------------------------------------------------------
*/
#undef Tcl_GetStringResult
const char *
Tcl_GetStringResult(
Tcl_Interp *interp)/* Interpreter whose result to return. */
{
#ifndef TCL_NO_DEPRECATED
Interp *iPtr = (Interp *) interp;
/*
* If the string result is empty, move the object result to the string
@@ -497,8 +500,10 @@ Tcl_GetStringResult(
TCL_VOLATILE);
}
return iPtr->result;
#else
return TclGetString(Tcl_GetObjResult(interp));
#endif
}
#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
+8 -7
View File
@@ -16,13 +16,14 @@
* Flag values used by Tcl_ScanObjCmd.
*/
#define SCAN_NOSKIP 0x1 /* Don't skip blanks. */
#define SCAN_SUPPRESS 0x2 /* Suppress assignment. */
#define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */
#define SCAN_WIDTH 0x8 /* A width value was supplied. */
#define SCAN_LONGER 0x400 /* Asked for a wide value. */
#define SCAN_BIG 0x800 /* Asked for a bignum value. */
enum ScanFlags {
SCAN_NOSKIP = 0x1, /* Don't skip blanks. */
SCAN_SUPPRESS = 0x2, /* Suppress assignment. */
SCAN_UNSIGNED = 0x4, /* Read an unsigned value. */
SCAN_WIDTH = 0x8, /* A width value was supplied. */
SCAN_LONGER = 0x400, /* Asked for a wide value. */
SCAN_BIG = 0x800 /* Asked for a bignum value. */
};
/*
* The following structure contains the information associated with a
+38 -7
View File
@@ -70,6 +70,11 @@ static void SetUnicodeObj(Tcl_Obj *objPtr,
static int UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
#define ISCONTINUATION(bytes) (\
((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
@@ -1218,6 +1223,11 @@ Tcl_AppendLimitedToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867] */
if (bytes && ISCONTINUATION(bytes)) {
Tcl_GetUnicode(objPtr);
}
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
@@ -1415,6 +1425,12 @@ Tcl_AppendObjToObj(
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/* If appended string starts with a continuation byte or a lower surrogate,
* force objPtr to unicode representation. See [7f1162a867]
* This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
if (ISCONTINUATION(TclGetString(appendObjPtr))) {
Tcl_GetUnicode(objPtr);
}
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
@@ -3032,7 +3048,7 @@ TclStringCat(
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, length = 0, binary = 1;
int allowUniChar = 1, requestUniChar = 0;
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
int first = objc - 1; /* Index of first value possibly not empty */
int last = 0; /* Index of last value possibly not empty */
int inPlace = flags & TCL_STRING_IN_PLACE;
@@ -3068,7 +3084,9 @@ TclStringCat(
*/
binary = 0;
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
forceUniChar = 1;
} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
/* Prevent shimmer of non-string types. */
allowUniChar = 0;
}
@@ -3117,7 +3135,7 @@ TclStringCat(
}
}
} while (--oc);
} else if (allowUniChar && requestUniChar) {
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
/*
* Result will be pure Tcl_UniChar array. Pre-size it.
*/
@@ -3270,7 +3288,7 @@ TclStringCat(
dst += more;
}
}
} else if (allowUniChar && requestUniChar) {
} else if ((allowUniChar && requestUniChar) || forceUniChar) {
/* Efficiently produce a pure Tcl_UniChar array result */
Tcl_UniChar *dst;
@@ -3456,7 +3474,7 @@ TclStringCmp(
s1 = (char *) Tcl_GetUnicode(value1Ptr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
1
#else
checkEq
@@ -4145,9 +4163,22 @@ ExtendUnicodeRepWithString(
} else {
numAppendChars = 0;
}
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
dst = stringPtr->unicode + numOrigChars;
if (numAppendChars-- > 0) {
bytes += TclUtfToUniChar(bytes, &unichar);
*dst = unichar;
#if TCL_UTF_MAX > 3
/* join upper/lower surrogate */
if (bytes && (stringPtr->unicode[numOrigChars - 1] | 0x3FF) == 0xDBFF && (unichar | 0x3FF) == 0xDFFF) {
stringPtr->numChars--;
unichar = ((stringPtr->unicode[numOrigChars - 1] & 0x3FF) << 10) + (unichar & 0x3FF) + 0x10000;
dst--;
}
#endif
*dst++ = unichar;
while (numAppendChars-- > 0) {
bytes += TclUtfToUniChar(bytes, &unichar);
*dst++ = unichar;
}
}
*dst = 0;
}
+15 -8
View File
@@ -65,15 +65,22 @@
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
#undef TclStaticPackage
#undef TclStaticLibrary
#undef Tcl_BackgroundError
#undef TclGuessPackageName
#undef TclGetLoadedPackages
#define TclStaticPackage Tcl_StaticPackage
#define TclStaticLibrary Tcl_StaticLibrary
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_MacOSXOpenBundleResources
#undef TclWinConvertWSAError
#undef TclWinConvertError
#if defined(_WIN32) || defined(__CYGWIN__)
#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError
#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError
#endif
#if TCL_UTF_MAX > 3
static void uniCodePanic(void) {
@@ -168,7 +175,7 @@ static const char *TclUtfPrev(const char *src, const char *start) {
#define TclBN_mp_xor mp_xor
#define TclBN_mp_zero mp_zero
#define TclBN_s_mp_add s_mp_add
#define TclBN_s_mp_balance_mul mp_balance_mul
#define TclBN_s_mp_balance_mul s_mp_balance_mul
#define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul
#define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr
#define TclBN_s_mp_mul_digs s_mp_mul_digs
@@ -309,7 +316,7 @@ static int TclGetLoadedPackages(
* otherwise, just return info about this
* interpreter. */
{
return TclGetLoadedPackagesEx(interp, targetName, NULL);
return TclGetLoadedLibraries(interp, targetName, NULL);
}
mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
@@ -628,8 +635,6 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
# define Tcl_Eval 0
# undef Tcl_GlobalEval
# define Tcl_GlobalEval 0
# undef Tcl_GetStringResult
# define Tcl_GetStringResult 0
# undef Tcl_SaveResult
# define Tcl_SaveResult 0
# undef Tcl_RestoreResult
@@ -1032,7 +1037,7 @@ static const TclIntStubs tclIntStubs = {
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticPackage, /* 257 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
TclGetBytesFromObj, /* 259 */
TclUnusedStubEntry, /* 260 */
@@ -1148,6 +1153,8 @@ static const TclPlatStubs tclPlatStubs = {
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
Tcl_WinUtfToTChar, /* 0 */
Tcl_WinTCharToUtf, /* 1 */
0, /* 2 */
Tcl_WinConvertError, /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
Tcl_MacOSXOpenBundleResources, /* 0 */
@@ -1519,7 +1526,7 @@ const TclStubs tclStubs = {
Tcl_SourceRCFile, /* 241 */
Tcl_SplitList, /* 242 */
Tcl_SplitPath, /* 243 */
Tcl_StaticPackage, /* 244 */
Tcl_StaticLibrary, /* 244 */
Tcl_StringMatch, /* 245 */
Tcl_TellOld, /* 246 */
Tcl_TraceVar, /* 247 */
+8 -8
View File
@@ -277,7 +277,7 @@ static Tcl_CmdProc Testset2Cmd;
static Tcl_CmdProc TestseterrorcodeCmd;
static Tcl_ObjCmdProc TestsetobjerrorcodeCmd;
static Tcl_CmdProc TestsetplatformCmd;
static Tcl_CmdProc TeststaticpkgCmd;
static Tcl_CmdProc TeststaticlibraryCmd;
static Tcl_CmdProc TesttranslatefilenameCmd;
static Tcl_CmdProc TestupvarCmd;
static Tcl_ObjCmdProc TestWrongNumArgsObjCmd;
@@ -604,7 +604,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
@@ -4217,10 +4217,10 @@ TestsetplatformCmd(
/*
*----------------------------------------------------------------------
*
* TeststaticpkgCmd --
* TeststaticlibraryCmd --
*
* This procedure implements the "teststaticpkg" command.
* It is used to test the procedure Tcl_StaticPackage.
* This procedure implements the "teststaticlibrary" command.
* It is used to test the procedure Tcl_StaticLibrary.
*
* Results:
* A standard Tcl result.
@@ -4233,7 +4233,7 @@ TestsetplatformCmd(
*/
static int
TeststaticpkgCmd(
TeststaticlibraryCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
@@ -4243,7 +4243,7 @@ TeststaticpkgCmd(
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " pkgName safe loaded\"", NULL);
argv[0], " prefix safe loaded\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
@@ -4252,7 +4252,7 @@ TeststaticpkgCmd(
if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
return TCL_ERROR;
}
Tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
Tcl_StaticLibrary((loaded) ? interp : NULL, argv[1],
StaticInitProc, (safe) ? StaticInitProc : NULL);
return TCL_OK;
}
+36 -37
View File
@@ -82,18 +82,17 @@ typedef union Block {
* and statistics information.
*/
typedef struct Bucket {
typedef struct {
Block *firstPtr; /* First block available */
Block *lastPtr; /* End of block list */
long numFree; /* Number of blocks available */
size_t numFree; /* Number of blocks available */
/* All fields below for accounting only */
long numRemoves; /* Number of removes from bucket */
long numInserts; /* Number of inserts into bucket */
long numWaits; /* Number of waits to acquire a lock */
long numLocks; /* Number of locks acquired */
long totalAssigned; /* Total space assigned to bucket */
size_t numRemoves; /* Number of removes from bucket */
size_t numInserts; /* Number of inserts into bucket */
size_t numLocks; /* Number of locks acquired */
size_t totalAssigned; /* Total space assigned to bucket */
} Bucket;
/*
@@ -107,9 +106,9 @@ typedef struct Cache {
struct Cache *nextPtr; /* Linked list of cache entries */
Tcl_ThreadId owner; /* Which thread's cache is this? */
Tcl_Obj *firstObjPtr; /* List of free objects for thread */
int numObjects; /* Number of objects for thread */
size_t numObjects; /* Number of objects for thread */
Tcl_Obj *lastPtr; /* Last object in this cache */
int totalAssigned; /* Total space assigned to thread */
size_t totalAssigned; /* Total space assigned to thread */
Bucket buckets[NBUCKETS]; /* The buckets for this thread */
} Cache;
@@ -120,8 +119,8 @@ typedef struct Cache {
static struct {
size_t blockSize; /* Bucket blocksize. */
int maxBlocks; /* Max blocks before move to share. */
int numMove; /* Num blocks to move to share. */
size_t maxBlocks; /* Max blocks before move to share. */
size_t numMove; /* Num blocks to move to share. */
Tcl_Mutex *lockPtr; /* Share bucket lock. */
} bucketInfo[NBUCKETS];
@@ -132,12 +131,12 @@ static struct {
static Cache * GetCache(void);
static void LockBucket(Cache *cachePtr, int bucket);
static void UnlockBucket(Cache *cachePtr, int bucket);
static void PutBlocks(Cache *cachePtr, int bucket, int numMove);
static void PutBlocks(Cache *cachePtr, int bucket, size_t numMove);
static int GetBlocks(Cache *cachePtr, int bucket);
static Block * Ptr2Block(void *ptr);
static void * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
static void PutObjs(Cache *fromPtr, int numMove);
static void * Block2Ptr(Block *blockPtr, int bucket, size_t reqSize);
static void MoveObjs(Cache *fromPtr, Cache *toPtr, size_t numMove);
static void PutObjs(Cache *fromPtr, size_t numMove);
/*
* Local variables defined in this file and initialized at startup.
@@ -548,7 +547,7 @@ TclThreadAllocObj(void)
*/
if (cachePtr->numObjects == 0) {
int numMove;
size_t numMove;
Tcl_MutexLock(objLockPtr);
numMove = sharedPtr->numObjects;
@@ -565,11 +564,11 @@ TclThreadAllocObj(void)
cachePtr->numObjects = numMove = NOBJALLOC;
newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
if (newObjsPtr == NULL) {
Tcl_Panic("alloc: could not allocate %d new objects", numMove);
Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove);
}
cachePtr->lastPtr = newObjsPtr + numMove - 1;
objPtr = cachePtr->firstObjPtr; /* NULL */
while (--numMove >= 0) {
while (numMove-- > 0) {
newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
objPtr = newObjsPtr + numMove;
}
@@ -671,14 +670,14 @@ Tcl_GetMemoryInfo(
Tcl_DStringAppendElement(dsPtr, buf);
}
for (n = 0; n < NBUCKETS; ++n) {
sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
(unsigned long) bucketInfo[n].blockSize,
sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %"
TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u",
bucketInfo[n].blockSize,
cachePtr->buckets[n].numFree,
cachePtr->buckets[n].numRemoves,
cachePtr->buckets[n].numInserts,
cachePtr->buckets[n].totalAssigned,
cachePtr->buckets[n].numLocks,
cachePtr->buckets[n].numWaits);
cachePtr->buckets[n].numLocks);
Tcl_DStringAppendElement(dsPtr, buf);
}
Tcl_DStringEndSublist(dsPtr);
@@ -707,7 +706,7 @@ static void
MoveObjs(
Cache *fromPtr,
Cache *toPtr,
int numMove)
size_t numMove)
{
Tcl_Obj *objPtr = fromPtr->firstObjPtr;
Tcl_Obj *fromFirstObjPtr = objPtr;
@@ -720,7 +719,7 @@ MoveObjs(
* to be moved) as the first object in the 'from' cache.
*/
while (--numMove) {
while (numMove-- > 1) {
objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
}
fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
@@ -754,9 +753,9 @@ MoveObjs(
static void
PutObjs(
Cache *fromPtr,
int numMove)
size_t numMove)
{
int keep = fromPtr->numObjects - numMove;
size_t keep = fromPtr->numObjects - numMove;
Tcl_Obj *firstPtr, *lastPtr = NULL;
fromPtr->numObjects = keep;
@@ -767,7 +766,7 @@ PutObjs(
do {
lastPtr = firstPtr;
firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1;
} while (--keep > 0);
} while (keep-- > 1);
lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
}
@@ -808,7 +807,7 @@ static void *
Block2Ptr(
Block *blockPtr,
int bucket,
unsigned int reqSize)
size_t reqSize)
{
void *ptr;
@@ -898,14 +897,14 @@ static void
PutBlocks(
Cache *cachePtr,
int bucket,
int numMove)
size_t numMove)
{
/*
* We have numFree. Want to shed numMove. So compute how many
* Blocks to keep.
*/
int keep = cachePtr->buckets[bucket].numFree - numMove;
size_t keep = cachePtr->buckets[bucket].numFree - numMove;
Block *lastPtr = NULL, *firstPtr;
cachePtr->buckets[bucket].numFree = keep;
@@ -916,7 +915,7 @@ PutBlocks(
do {
lastPtr = firstPtr;
firstPtr = firstPtr->nextBlock;
} while (--keep > 0);
} while (keep-- > 1);
lastPtr->nextBlock = NULL;
}
@@ -961,7 +960,7 @@ GetBlocks(
int bucket)
{
Block *blockPtr;
int n;
size_t n;
/*
* First, atttempt to move blocks from the shared cache. Note the
@@ -994,7 +993,7 @@ GetBlocks(
cachePtr->buckets[bucket].firstPtr = blockPtr;
sharedPtr->buckets[bucket].numFree -= n;
cachePtr->buckets[bucket].numFree = n;
while (--n > 0) {
while (n-- > 1) {
blockPtr = blockPtr->nextBlock;
}
sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
@@ -1016,7 +1015,7 @@ GetBlocks(
blockPtr = NULL;
n = NBUCKETS;
size = 0;
while (--n > bucket) {
while (n-- > (size_t)bucket + 1) {
if (cachePtr->buckets[n].numFree > 0) {
size = bucketInfo[n].blockSize;
blockPtr = cachePtr->buckets[n].firstPtr;
@@ -1045,7 +1044,7 @@ GetBlocks(
n = size / bucketInfo[bucket].blockSize;
cachePtr->buckets[bucket].numFree = n;
cachePtr->buckets[bucket].firstPtr = blockPtr;
while (--n > 0) {
while (n-- > 1) {
blockPtr->nextBlock = (Block *)
((char *) blockPtr + bucketInfo[bucket].blockSize);
blockPtr = blockPtr->nextBlock;
@@ -1082,9 +1081,9 @@ TclInitThreadAlloc(void)
objLockPtr = TclpNewAllocMutex();
for (i = 0; i < NBUCKETS; ++i) {
bucketInfo[i].blockSize = MINALLOC << i;
bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i);
bucketInfo[i].numMove = i < NBUCKETS - 1 ?
1 << (NBUCKETS - 2 - i) : 1;
(size_t)1 << (NBUCKETS - 2 - i) : 1;
bucketInfo[i].lockPtr = TclpNewAllocMutex();
}
TclpInitAllocCache();
+2
View File
@@ -305,6 +305,8 @@ TclSignalExitThread(
Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#else
TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c)
#endif /* _WIN32 */
/*
-1
View File
@@ -17,7 +17,6 @@ library tcl
# Define the unsupported generic interfaces.
interface tclTomMath
# hooks {tclTomMathInt}
scspec EXTERN
# Declare each of the functions in the Tcl tommath interface
+6 -1
View File
@@ -73,6 +73,11 @@ MODULE_SCOPE mp_err TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len);
MODULE_SCOPE void TclBN_s_mp_set(mp_int *a, mp_digit b);
MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE mp_err TclBN_s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c);
MODULE_SCOPE const char *const TclBN_mp_s_rmap;
MODULE_SCOPE const uint8_t TclBN_mp_s_rmap_reverse[];
MODULE_SCOPE const size_t TclBN_mp_s_rmap_reverse_sz;
MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b);
#ifdef __cplusplus
}
#endif
@@ -149,7 +154,7 @@ MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
#define mp_xor TclBN_mp_xor
#define mp_zero TclBN_mp_zero
#define s_mp_add TclBN_s_mp_add
#define s_mp_balance_mul TclBN_mp_balance_mul
#define s_mp_balance_mul TclBN_s_mp_balance_mul
#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define s_mp_mul_digs TclBN_s_mp_mul_digs
+17 -16
View File
@@ -68,25 +68,26 @@ typedef struct {
* TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that
* TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
*
* TCL_TRACE_ENTER_DURING_EXEC - Trace each command inside the command
* currently being traced, before execution.
* TCL_TRACE_LEAVE_DURING_EXEC - Trace each command inside the command
* currently being traced, after execution.
* TCL_TRACE_ANY_EXEC - OR'd combination of all EXEC flags.
* TCL_TRACE_EXEC_IN_PROGRESS - The callback function on this trace is
* currently executing. Therefore we don't let
* further traces execute.
* TCL_TRACE_EXEC_DIRECT - This execution trace is triggered directly
* by the command being traced, not because of
* an internal trace.
* The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces.
*/
#define TCL_TRACE_ENTER_DURING_EXEC 4
#define TCL_TRACE_LEAVE_DURING_EXEC 8
#define TCL_TRACE_ANY_EXEC 15
#define TCL_TRACE_EXEC_IN_PROGRESS 0x10
#define TCL_TRACE_EXEC_DIRECT 0x20
enum TraceExecutionFlags {
TCL_TRACE_ENTER_DURING_EXEC = 4,
/* Trace each command inside the command
* currently being traced, before
* execution. */
TCL_TRACE_LEAVE_DURING_EXEC = 8,
/* Trace each command inside the command
* currently being traced, after execution. */
TCL_TRACE_ANY_EXEC = 15, /* OR'd combination of all EXEC flags. */
TCL_TRACE_EXEC_IN_PROGRESS = 0x10,
/* The callback function on this trace is
* currently executing. Therefore we don't let
* further traces execute. */
TCL_TRACE_EXEC_DIRECT = 0x20/* This execution trace is triggered directly
* by the command being traced, not because of
* an internal trace. */
};
/*
* Forward declarations for functions defined in this file:
+21 -1
View File
@@ -956,6 +956,10 @@ Tcl_UtfNext(
const char *next;
if (((*src) & 0xC0) == 0x80) {
/* Continuation byte, so we start 'inside' a (possible valid) UTF-8
* sequence. Since we are not allowed to access src[-1], we cannot
* check if the sequence is actually valid, the best we can do is
* just assume it is valid and locate the end. */
if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
++src;
}
@@ -1819,7 +1823,7 @@ Tcl_UniCharNcmp(
const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */
unsigned long numChars) /* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
/*
* We are definitely on a big-endian machine; memcmp() is safe
*/
@@ -1833,6 +1837,14 @@ Tcl_UniCharNcmp(
for ( ; numChars != 0; ucs++, uct++, numChars--) {
if (*ucs != *uct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
return 1;
} else if (((*uct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (*ucs - *uct);
}
}
@@ -1870,6 +1882,14 @@ Tcl_UniCharNcasecmp(
Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
if (lcs != lct) {
#if TCL_UTF_MAX < 4
/* special case for handling upper surrogates */
if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
return 1;
} else if (((lct & 0xFC00) == 0xD800)) {
return -1;
}
#endif
return (lcs - lct);
}
}
+15 -6
View File
@@ -88,11 +88,13 @@ static ProcessGlobalValue executableName = {
*/
#define COMPAT 1
#define CONVERT_NONE 0
#define CONVERT_BRACE 2
#define CONVERT_ESCAPE 4
#define CONVERT_MASK (CONVERT_BRACE | CONVERT_ESCAPE)
#define CONVERT_ANY 16
enum FormatListFlags {
CONVERT_NONE = 0,
CONVERT_BRACE = 2,
CONVERT_ESCAPE = 4,
CONVERT_MASK = (CONVERT_BRACE | CONVERT_ESCAPE),
CONVERT_ANY = 16
};
/*
* The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
@@ -2030,7 +2032,14 @@ Tcl_ConcatObj(
continue;
}
if (resPtr) {
if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
Tcl_Obj *elemPtr = NULL;
Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
if (elemPtr == NULL) {
continue;
}
if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
/* Abandon ship! */
Tcl_DecrRefCount(resPtr);
goto slow;
+1971 -1035
View File
File diff suppressed because it is too large Load Diff
+13 -15
View File
@@ -130,21 +130,19 @@ typedef struct {
} ZlibChannelData;
/*
* Value bits for the flags field. Definitions are:
* ASYNC - Whether this is an asynchronous channel.
* IN_HEADER - Whether the inHeader field has been registered with
* the input compressor.
* OUT_HEADER - Whether the outputHeader field has been registered
* with the output decompressor.
* STREAM_DECOMPRESS - Signal decompress pending data.
* STREAM_DONE - Flag to signal stream end up to transform input.
* Value bits for the flags field:
*/
#define ASYNC 0x01
#define IN_HEADER 0x02
#define OUT_HEADER 0x04
#define STREAM_DECOMPRESS 0x08
#define STREAM_DONE 0x10
enum ZlibChannelFlags {
ASYNC = 0x01, /* Whether this is an asynchronous channel. */
IN_HEADER = 0x02, /* Whether the inHeader field has been
* registered with the input compressor. */
OUT_HEADER = 0x04, /* Whether the outputHeader field has been
* registered with the output decompressor. */
STREAM_DECOMPRESS = 0x08, /* Signal decompress pending data. */
STREAM_DONE = 0x10 /* Flag to signal stream end up to transform
* input. */
};
/*
* Size of buffers allocated by default, and the range it can be set to. The
@@ -214,7 +212,7 @@ static const Tcl_ChannelType zlibChannelType = {
ZlibTransformGetOption,
ZlibTransformWatch,
ZlibTransformGetHandle,
ZlibTransformClose, /* close2Proc */
ZlibTransformClose, /* close2Proc */
ZlibTransformBlockMode,
NULL, /* flushProc */
ZlibTransformEventHandler,
@@ -3957,7 +3955,7 @@ TclZlibInit(
* Formally provide the package as a Tcl built-in.
*/
#ifndef TCL_NO_DEPRECATED
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
#endif
return Tcl_PkgProvide(interp, "tcl::zlib", TCL_ZLIB_VERSION);
+1 -2
View File
@@ -2988,8 +2988,7 @@ proc ::tcl::clock::GetSystemTimeZone {} {
set timezone $result
} elseif {[set result [getenv TZ]] ne {}} {
set timezone $result
}
if {![info exists timezone]} {
} else {
# Cache the time zone only if it was detected by one of the
# expensive methods.
if { [info exists CachedSystemTimeZone] } {
+11 -2
View File
@@ -1,3 +1,12 @@
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded dde 1.4.4 [list load [file join $dir tcldde14.dll] Dde]
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcl9dde14.dll] Dde]
} elseif {![package vsatisfies [package provide Tcl] 8.7]
&& [::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcldde14g.dll] Dde]
} else {
package ifneeded dde 1.4.4 \
[list load [file join $dir tcldde14.dll] Dde]
}
+7 -2
View File
@@ -1,4 +1,9 @@
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded registry 1.3.6 \
[list load [file join $dir tclregistry13.dll] Registry]
if {[package vsatisfies [package provide Tcl] 9.0-]} {
package ifneeded registry 1.3.6 \
[list load [file join $dir tcl9registry13.dll] Registry]
} else {
package ifneeded registry 1.3.6 \
[list load [file join $dir tclregistry13.dll] Registry]
}
+12 -12
View File
@@ -1009,8 +1009,8 @@ proc ::safe::AliasLoad {child file args} {
return -code error $msg
}
# package name (can be empty if file is not).
set package [lindex $args 0]
# prefix (can be empty if file is not).
set prefix [lindex $args 0]
namespace upvar ::safe [VarName $child] state
@@ -1022,23 +1022,23 @@ proc ::safe::AliasLoad {child file args} {
# authorize that.
if {!$state(nestedok)} {
Log $child "loading to a sub interp (nestedok)\
disabled (trying to load $package to $target)"
disabled (trying to load $prefix to $target)"
return -code error "permission denied (nested load)"
}
}
# Determine what kind of load is requested
if {$file eq ""} {
# static package loading
if {$package eq ""} {
set msg "load error: empty filename and no package name"
# static loading
if {$prefix eq ""} {
set msg "load error: empty filename and no prefix"
Log $child $msg
return -code error $msg
}
if {!$state(staticsok)} {
Log $child "static packages loading disabled\
(trying to load $package to $target)"
return -code error "permission denied (static package)"
Log $child "static loading disabled\
(trying to load $prefix to $target)"
return -code error "permission denied (static library)"
}
} else {
# file loading
@@ -1061,10 +1061,10 @@ proc ::safe::AliasLoad {child file args} {
}
try {
return [::interp invokehidden $child load $file $package $target]
return [::interp invokehidden $child load $file $prefix $target]
} on error msg {
# Some packages return no error message.
set msg0 "load of binary library for package $package failed"
# Some libraries return no error message.
set msg0 "load of library for prefix $prefix failed"
if {$msg eq {}} {
set msg $msg0
} else {
+2 -2
View File
@@ -394,7 +394,7 @@
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; };
F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
@@ -1141,7 +1141,7 @@
F96D3EA208F272A7004A47F5 /* split.n */,
F96D3EA308F272A7004A47F5 /* SplitList.3 */,
F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */,
F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
F96D3EA708F272A7004A47F5 /* string.n */,
F96D3EA808F272A7004A47F5 /* StringObj.3 */,
+2 -2
View File
@@ -393,7 +393,7 @@
F96D3EA208F272A7004A47F5 /* split.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = split.n; sourceTree = "<group>"; };
F96D3EA308F272A7004A47F5 /* SplitList.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitList.3; sourceTree = "<group>"; };
F96D3EA408F272A7004A47F5 /* SplitPath.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = SplitPath.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticPkg.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticPkg.3; sourceTree = "<group>"; };
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StaticLibrary.3; sourceTree = "<group>"; };
F96D3EA608F272A7004A47F5 /* StdChannels.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StdChannels.3; sourceTree = "<group>"; };
F96D3EA708F272A7004A47F5 /* string.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = string.n; sourceTree = "<group>"; };
F96D3EA808F272A7004A47F5 /* StringObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = StringObj.3; sourceTree = "<group>"; };
@@ -1141,7 +1141,7 @@
F96D3EA208F272A7004A47F5 /* split.n */,
F96D3EA308F272A7004A47F5 /* SplitList.3 */,
F96D3EA408F272A7004A47F5 /* SplitPath.3 */,
F96D3EA508F272A7004A47F5 /* StaticPkg.3 */,
F96D3EA508F272A7004A47F5 /* StaticLibrary.3 */,
F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
F96D3EA708F272A7004A47F5 /* string.n */,
F96D3EA808F272A7004A47F5 /* StringObj.3 */,
+11 -9
View File
@@ -32,9 +32,11 @@ extern int copyfile(const char *from, const char *to,
#else /* HAVE_COPYFILE_H */
int copyfile(const char *from, const char *to,
void *state, uint32_t flags);
#define COPYFILE_ACL (1<<0)
#define COPYFILE_XATTR (1<<2)
#define COPYFILE_NOFOLLOW_SRC (1<<18)
enum copyfileFlags {
COPYFILE_ACL = (1<<0),
COPYFILE_XATTR = (1<<2),
COPYFILE_NOFOLLOW_SRC = (1<<18)
};
#if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040)
/* Support for weakly importing copyfile. */
#define WEAK_IMPORT_COPYFILE
@@ -84,11 +86,11 @@ static int SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfOSType(Tcl_Obj *objPtr);
static const Tcl_ObjType tclOSTypeType = {
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
SetOSTypeFromAny /* setFromAnyProc */
"osType", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfOSType, /* updateStringProc */
SetOSTypeFromAny /* setFromAnyProc */
};
enum {
@@ -689,7 +691,7 @@ SetOSTypeFromAny(
static void
UpdateStringOfOSType(
Tcl_Obj *objPtr) /* OSType object whose string rep to
Tcl_Obj *objPtr) /* OSType object whose string rep to
* update. */
{
const int size = TCL_UTF_MAX * 4;
+116 -128
View File
@@ -534,7 +534,58 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;
/*
*----------------------------------------------------------------------
*
* Tcl_InitNotifier --
* LookUpFileHandler --
*
* Look up the file handler structure (and optionally the previous one in
* the chain) associated with a file descriptor.
*
* Returns:
* A pointer to the file handler, or NULL if it can't be found.
*
* Side effects:
* If prevPtrPtr is non-NULL, it will be written to if the file handler
* is found.
*
*----------------------------------------------------------------------
*/
static inline FileHandler *
LookUpFileHandler(
ThreadSpecificData *tsdPtr, /* Where to look things up. */
int fd, /* What we are looking for. */
FileHandler **prevPtrPtr) /* If non-NULL, where to report the previous
* pointer. */
{
FileHandler *filePtr, *prevPtr;
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return NULL;
}
if (filePtr->fd == fd) {
break;
}
}
/*
* Report what we've found to our caller.
*/
if (prevPtrPtr) {
*prevPtrPtr = prevPtr;
}
return filePtr;
}
/*
*----------------------------------------------------------------------
*
* TclpInitNotifier --
*
* Initializes the platform specific notifier state.
*
@@ -548,22 +599,16 @@ MODULE_SCOPE long tclMacOSXDarwinRelease;
*/
ClientData
Tcl_InitNotifier(void)
TclpInitNotifier(void)
{
ThreadSpecificData *tsdPtr;
if (tclNotifierHooks.initNotifierProc) {
return tclNotifierHooks.initNotifierProc();
}
tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#ifdef WEAK_IMPORT_SPINLOCKLOCK
/*
* Initialize support for weakly imported spinlock API.
*/
if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
Tcl_Panic("Tcl_InitNotifier: %s", "pthread_once failed");
}
#endif
@@ -590,7 +635,8 @@ Tcl_InitNotifier(void)
runLoopSource = CFRunLoopSourceCreate(NULL, LONG_MIN,
&runLoopSourceContext);
if (!runLoopSource) {
Tcl_Panic("Tcl_InitNotifier: could not create CFRunLoopSource");
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopSource");
}
CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode);
@@ -602,8 +648,8 @@ Tcl_InitNotifier(void)
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserver) {
Tcl_Panic("Tcl_InitNotifier: could not create "
"CFRunLoopObserver");
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopObserver");
}
CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes);
@@ -620,8 +666,8 @@ Tcl_InitNotifier(void)
LONG_MIN, UpdateWaitingListAndServiceEvents,
&runLoopObserverContext);
if (!runLoopObserverTcl) {
Tcl_Panic("Tcl_InitNotifier: could not create "
"CFRunLoopObserver");
Tcl_Panic("Tcl_InitNotifier: %s",
"could not create CFRunLoopObserver");
}
CFRunLoopAddObserver(runLoop, runLoopObserverTcl,
tclEventsOnlyRunLoopMode);
@@ -650,7 +696,7 @@ Tcl_InitNotifier(void)
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
if (result) {
Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
Tcl_Panic("Tcl_InitNotifier: %s", "pthread_atfork failed");
}
atForkInit = 1;
}
@@ -663,20 +709,20 @@ Tcl_InitNotifier(void)
*/
if (pipe(fds) != 0) {
Tcl_Panic("Tcl_InitNotifier: could not create trigger pipe");
Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
}
status = fcntl(fds[0], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[0], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make receive pipe non "
"blocking");
Tcl_Panic("Tcl_InitNotifier: %s",
"could not make receive pipe non-blocking");
}
status = fcntl(fds[1], F_GETFL);
status |= O_NONBLOCK;
if (fcntl(fds[1], F_SETFL, status) < 0) {
Tcl_Panic("Tcl_InitNotifier: could not make trigger pipe non "
"blocking");
Tcl_Panic("Tcl_InitNotifier: %s",
"could not make trigger pipe non-blocking");
}
receivePipe = fds[0];
@@ -762,7 +808,7 @@ StartNotifierThread(void)
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(&notifierThread, &attr,
(void * (*)(void *))NotifierThreadProc, NULL);
(void * (*)(void *)) NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result) {
Tcl_Panic("StartNotifierThread: unable to start notifier thread");
@@ -776,7 +822,7 @@ StartNotifierThread(void)
/*
*----------------------------------------------------------------------
*
* Tcl_FinalizeNotifier --
* TclpFinalizeNotifier --
*
* This function is called to cleanup the notifier state before a thread
* is terminated.
@@ -792,17 +838,10 @@ StartNotifierThread(void)
*/
void
Tcl_FinalizeNotifier(
ClientData clientData)
TclpFinalizeNotifier(
TCL_UNUSED(ClientData))
{
ThreadSpecificData *tsdPtr;
if (tclNotifierHooks.finalizeNotifierProc) {
tclNotifierHooks.finalizeNotifierProc(clientData);
return;
}
tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
LOCK_NOTIFIER_INIT;
notifierCount--;
@@ -876,7 +915,7 @@ Tcl_FinalizeNotifier(
/*
*----------------------------------------------------------------------
*
* Tcl_AlertNotifier --
* TclpAlertNotifier --
*
* Wake up the specified notifier from any thread. This routine is called
* by the platform independent notifier code whenever the Tcl_ThreadAlert
@@ -893,15 +932,10 @@ Tcl_FinalizeNotifier(
*/
void
Tcl_AlertNotifier(
TclpAlertNotifier(
ClientData clientData)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
if (tclNotifierHooks.alertNotifierProc) {
tclNotifierHooks.alertNotifierProc(clientData);
return;
}
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
LOCK_NOTIFIER_TSD;
if (tsdPtr->runLoop) {
@@ -914,7 +948,7 @@ Tcl_AlertNotifier(
/*
*----------------------------------------------------------------------
*
* Tcl_SetTimer --
* TclpSetTimer --
*
* This function sets the current notifier timer value.
*
@@ -928,18 +962,13 @@ Tcl_AlertNotifier(
*/
void
Tcl_SetTimer(
TclpSetTimer(
const Tcl_Time *timePtr) /* Timeout value, may be NULL. */
{
ThreadSpecificData *tsdPtr;
CFRunLoopTimerRef runLoopTimer;
CFTimeInterval waitTime;
if (tclNotifierHooks.setTimerProc) {
tclNotifierHooks.setTimerProc(timePtr);
return;
}
tsdPtr = TCL_TSD_INIT(&dataKey);
runLoopTimer = tsdPtr->runLoopTimer;
if (!runLoopTimer) {
@@ -949,7 +978,7 @@ Tcl_SetTimer(
Tcl_Time vTime = *timePtr;
if (vTime.sec != 0 || vTime.usec != 0) {
tclScaleTimeProcPtr(&vTime, tclTimeClientData);
TclScaleTime(&vTime);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
waitTime = 0;
@@ -988,7 +1017,7 @@ TimerWakeUp(
/*
*----------------------------------------------------------------------
*
* Tcl_ServiceModeHook --
* TclpServiceModeHook --
*
* This function is invoked whenever the service mode changes.
*
@@ -1002,18 +1031,11 @@ TimerWakeUp(
*/
void
Tcl_ServiceModeHook(
TclpServiceModeHook(
int mode) /* Either TCL_SERVICE_ALL, or
* TCL_SERVICE_NONE. */
{
ThreadSpecificData *tsdPtr;
if (tclNotifierHooks.serviceModeHookProc) {
tclNotifierHooks.serviceModeHookProc(mode);
return;
}
tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) {
if (!tsdPtr->runLoop) {
@@ -1033,9 +1055,9 @@ Tcl_ServiceModeHook(
/*
*----------------------------------------------------------------------
*
* Tcl_CreateFileHandler --
* TclpCreateFileHandler --
*
* This function registers a file handler with the select notifier.
* This function registers a file handler with the notifier.
*
* Results:
* None.
@@ -1047,7 +1069,7 @@ Tcl_ServiceModeHook(
*/
void
Tcl_CreateFileHandler(
TclpCreateFileHandler(
int fd, /* Handle of stream to watch. */
int mask, /* OR'ed combination of TCL_READABLE,
* TCL_WRITABLE, and TCL_EXCEPTION: indicates
@@ -1057,24 +1079,11 @@ Tcl_CreateFileHandler(
* event. */
ClientData clientData) /* Arbitrary data to pass to proc. */
{
ThreadSpecificData *tsdPtr;
FileHandler *filePtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
if (tclNotifierHooks.createFileHandlerProc) {
tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
return;
}
tsdPtr = TCL_TSD_INIT(&dataKey);
for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
filePtr = filePtr->nextPtr) {
if (filePtr->fd == fd) {
break;
}
}
if (filePtr == NULL) {
filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
filePtr->fd = fd;
filePtr->readyMask = 0;
filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
@@ -1113,7 +1122,7 @@ Tcl_CreateFileHandler(
/*
*----------------------------------------------------------------------
*
* Tcl_DeleteFileHandler --
* TclpDeleteFileHandler --
*
* Cancel a previously-arranged callback arrangement for a file.
*
@@ -1127,47 +1136,34 @@ Tcl_CreateFileHandler(
*/
void
Tcl_DeleteFileHandler(
TclpDeleteFileHandler(
int fd) /* Stream id for which to remove callback
* function. */
{
FileHandler *filePtr, *prevPtr;
int i, numFdBits;
ThreadSpecificData *tsdPtr;
if (tclNotifierHooks.deleteFileHandlerProc) {
tclNotifierHooks.deleteFileHandlerProc(fd);
return;
}
tsdPtr = TCL_TSD_INIT(&dataKey);
numFdBits = -1;
int i, numFdBits = -1;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Find the entry for the given file (and return if there isn't one).
*/
for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
prevPtr = filePtr, filePtr = filePtr->nextPtr) {
if (filePtr == NULL) {
return;
}
if (filePtr->fd == fd) {
break;
}
filePtr = LookUpFileHandler(tsdPtr, fd, &prevPtr);
if (filePtr == NULL) {
return;
}
/*
* Find current max fd.
*/
if (fd+1 == tsdPtr->numFdBits) {
if (fd + 1 == tsdPtr->numFdBits) {
numFdBits = 0;
for (i = fd-1; i >= 0; i--) {
for (i = fd - 1; i >= 0; i--) {
if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
|| FD_ISSET(i, &tsdPtr->checkMasks.writable)
|| FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
numFdBits = i+1;
numFdBits = i + 1;
break;
}
}
@@ -1250,12 +1246,8 @@ FileHandlerEventProc(
*/
tsdPtr = TCL_TSD_INIT(&dataKey);
for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
filePtr = filePtr->nextPtr) {
if (filePtr->fd != fileEvPtr->fd) {
continue;
}
filePtr = LookUpFileHandler(tsdPtr, fileEvPtr->fd, NULL);
if (filePtr != NULL) {
/*
* The code is tricky for two reasons:
* 1. The file handler's desired events could have changed since the
@@ -1284,7 +1276,6 @@ FileHandlerEventProc(
UNLOCK_NOTIFIER_TSD;
filePtr->proc(filePtr->clientData, mask);
}
break;
}
return 1;
}
@@ -1292,7 +1283,7 @@ FileHandlerEventProc(
/*
*----------------------------------------------------------------------
*
* Tcl_WaitForEvent --
* TclpWaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new events on
* the message queue. If the block time is 0, then Tcl_WaitForEvent just
@@ -1309,7 +1300,7 @@ FileHandlerEventProc(
*/
int
Tcl_WaitForEvent(
TclpWaitForEvent(
const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
int result, polling, runLoopRunning;
@@ -1317,9 +1308,6 @@ Tcl_WaitForEvent(
SInt32 runLoopStatus;
ThreadSpecificData *tsdPtr;
if (tclNotifierHooks.waitForEventProc) {
return tclNotifierHooks.waitForEventProc(timePtr);
}
result = -1;
polling = 0;
waitTime = CF_TIMEINTERVAL_FOREVER;
@@ -1343,10 +1331,9 @@ Tcl_WaitForEvent(
*/
if (vTime.sec != 0 || vTime.usec != 0) {
tclScaleTimeProcPtr(&vTime, tclTimeClientData);
TclScaleTime(&vTime);
waitTime = vTime.sec + 1.0e-6 * vTime.usec;
} else {
/*
* The max block time was set to 0.
*
@@ -1357,8 +1344,8 @@ Tcl_WaitForEvent(
* or timers are ready to fire immediately, only one (possibly two
* if one is a version 0 source) will be fired, regardless of the
* value of returnAfterSourceHandled." This can cause some chanio
* tests to fail. So we use a small positive waitTime unless there
* is another RunLoop running.
* tests to fail. So we use a small positive waitTime unless
* there is another RunLoop running.
*/
polling = 1;
@@ -1431,7 +1418,7 @@ QueueFileEvents(
{
SelectMasks readyMasks;
FileHandler *filePtr;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info;
/*
* Queue all detected file events.
@@ -1470,7 +1457,8 @@ QueueFileEvents(
*/
if (filePtr->readyMask == 0) {
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent));
FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
@@ -1485,8 +1473,8 @@ QueueFileEvents(
*
* UpdateWaitingListAndServiceEvents --
*
* CFRunLoopObserver callback for updating waitingList and
* servicing Tcl events.
* CFRunLoopObserver callback for updating waitingList and servicing Tcl
* events.
*
* Results:
* None.
@@ -1503,7 +1491,8 @@ UpdateWaitingListAndServiceEvents(
CFRunLoopActivity activity,
void *info)
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info;
if (tsdPtr->sleeping) {
return;
}
@@ -1626,8 +1615,7 @@ Tcl_Sleep(
vdelay.sec = ms / 1000;
vdelay.usec = (ms % 1000) * 1000;
tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
TclScaleTime(&vdelay);
if (tsdPtr->runLoop) {
CFTimeInterval waitTime;
@@ -1853,7 +1841,7 @@ TclUnixWaitForFile(
*
* Result:
* None. Once started, this routine never exits. It dies with the overall
* process.
* process or terminates its own thread (on notifier termination).
*
* Side effects:
* The trigger pipe used to signal the notifier thread is created when
@@ -2090,9 +2078,9 @@ AtForkChild(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* If a child process unlocks an os_unfair_lock that was created in its parent
* the child will exit with an illegal instruction error. So we reinitialize
* the lock in the child rather than attempt to unlock it.
* If a child process unlocks an os_unfair_lock that was created in its
* parent the child will exit with an illegal instruction error. So we
* reinitialize the lock in the child rather than attempt to unlock it.
*/
#if defined(USE_OS_UNFAIR_LOCK)
+33
View File
@@ -15,8 +15,12 @@ if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
unset -nocomplain x
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testbytestring [llength [info commands testbytestring]]
test append-1.1 {append command} {
unset -nocomplain x
list [append x 1 2 abc "long string"] $x
@@ -53,6 +57,35 @@ test append-3.3 {append errors} -returnCodes error -body {
unset -nocomplain x
append x
} -result {can't read "x": no such variable}
test append-3.4 {append surrogates} -body {
set x \uD83D
append x \uDE02
} -result \uD83D\uDE02
test append-3.5 {append surrogates} -body {
set x \uD83D
set x $x\uDE02
} -result \uD83D\uDE02
test append-3.6 {append surrogates} -body {
set x \uDE02
set x \uD83D$x
} -result \uD83D\uDE02
test append-3.7 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length [append x [testbytestring \x80]]
} -result 2
test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \xC0]
string length $x[testbytestring \x80]
} -result 2
test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
set x [testbytestring \x80]
string length [testbytestring \xC0]$x
} -result 2
test append-3.10 {append surrogates} -body {
set x \uD83D
string range $x 0 end
append x \uDE02
} -result [string range \uD83D\uDE02 0 end]
test append-4.1 {lappend command} {
unset -nocomplain x
+243 -240
View File
File diff suppressed because it is too large Load Diff
+2 -2
View File
@@ -48,10 +48,10 @@ test chan-4.1 {chan command: configure subcommand} -body {
chan configure
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
test chan-4.2 {chan command: [Bug 800753]} -body {
chan configure stdout -eofchar \u0100
chan configure stdout -eofchar Ā
} -returnCodes error -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {
chan configure stdout -eofchar \u0000
chan configure stdout -eofchar \x00
} -returnCodes error -match glob -result {bad value*}
test chan-4.4 {chan command: check valid inValue, no outValue} -body {
chan configure stdout -eofchar [list \x27 {}]
+110 -111
View File
@@ -79,7 +79,7 @@ namespace eval ::tcl::test::io {
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A
chan configure stdout -encoding binary -translation lf -buffering none
chan event $f readable "foo $f"
proc foo {f} {
@@ -115,17 +115,17 @@ set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "a\u4e4d\0"
chan puts -nonewline $f "a乍\x00"
chan close $f
contents $path(test1)
} "a\x4d\x00"
} "aM\x00"
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
chan puts -nonewline $f "a\u4e4d\0"
chan puts -nonewline $f "a乍\x00"
chan close $f
contents $path(test1)
} "a\x93\xe1\x00"
} "a\x93\xE1\x00"
set path(test2) [makeFile {} test2]
test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
@@ -138,7 +138,7 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
chan close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
} " \x1B\$B\$O\x1B(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends escape bytes, check
# for the case where the escape bytes overflow the current IO buffer. The
@@ -273,13 +273,13 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
# (first two bytes of \uff21 in UTF-8). Given those two bytes try
# (first two bytes of A in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes (the
# last byte of \uff21 plus the all of \uff22) appended.
# last byte of A plus the all of B) appended.
set f [open $path(test1) w]
chan configure $f -encoding shiftjis -buffersize 16
chan puts -nonewline $f "12345678901234\uff21\uff22"
chan puts -nonewline $f "12345678901234AB"
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
@@ -421,7 +421,7 @@ test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body {
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x81\u1234\0"
chan puts $f "\x81\u1234\x00"
chan close $f
set f [open $path(test1)]
chan configure $f -translation binary
@@ -432,14 +432,14 @@ test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
chan puts $f "\x88\xea\x92\x9a"
chan puts $f "\x88\xEA\x92\x9A"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
list [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 2 "\u4e00\u4e01"]
} -result [list 2 "一丁"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
@@ -467,20 +467,20 @@ test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
} -result {-1}
test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdef\x1aghijk\nwombat"
chan puts $f "abcdef\x1Aghijk\nwombat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {6 abcdef -1 {}}
test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
chan puts $f "abcdefghijk\nwom\u001abat"
chan puts $f "abcdefghijk\nwom\x1Abat"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
@@ -865,7 +865,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg\x1a"
chan puts -nonewline $f "\nabcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
@@ -883,7 +883,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "abcd\refg\x1a"
chan puts -nonewline $f "abcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
@@ -919,7 +919,7 @@ test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eo
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\n\x1a"
chan puts -nonewline $f "\n\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
chan close $f
@@ -985,10 +985,10 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -b
# if (eof != NULL)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\x1ak9012345\r"
chan puts -nonewline $f "123456\x1Ak9012345\r"
chan close $f
set f [open $path(test1)]
chan configure $f -eofchar \x1a
chan configure $f -eofchar \x1A
list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
chan close $f
@@ -1016,14 +1016,14 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
chan configure $f -encoding iso2022-jp
chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
chan puts $f "there一ok\n丁more bytes\nhere"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding iso2022-jp
list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
} -result [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
@@ -1057,19 +1057,19 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
chan puts $f "123456789012301234\nend"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis -buffersize 16
chan gets $f
} -cleanup {
chan close $f
} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
} -result "123456789012301234"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
@@ -1082,7 +1082,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
@@ -1091,13 +1091,13 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
} -result [list 15 "123456789012301" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
chan configure $f -encoding shiftjis -blocking 0
chan event $f read [namespace code {
lappend x [chan gets $f line] $line [chan blocked $f]
@@ -1110,7 +1110,7 @@ test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
return $x
} -cleanup {
chan close $f
} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
} -result [list -1 "" 1 17 "12345678901230123" 0]
test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
# (bufPtr->nextPtr == NULL)
@@ -1205,7 +1205,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup {
chan puts -nonewline $f "abcdefghijklmno\r"
# here
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan puts -nonewline $f "\x1a"
chan puts -nonewline $f "\x1A"
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
@@ -1361,22 +1361,22 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
chan puts -nonewline $f "\x7b"
chan puts -nonewline $f "\x7B"
after 500 ;# Give the cat process time to catch up
chan configure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
return $x
} -cleanup {
chan close $f
} -result [list "123456789012345" 1 "\u672c" 0]
} -result [list "123456789012345" 1 "本" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xe7"
chan gets stdin; chan puts -nonewline "\xE7"
chan gets stdin; chan puts -nonewline "\x89"
chan gets stdin; chan puts -nonewline "\xa6"
chan gets stdin; chan puts -nonewline "\xA6"
} test1]
set f [openpipe r+ $path(test1)]
chan event $f readable [namespace code {
@@ -1401,7 +1401,7 @@ test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
vwait [namespace which -variable x]
vwait [namespace which -variable x]
lappend x [catch {chan close $f} msg] $msg
} -result "{} timeout {} timeout \u7266 {} eof 0 {}"
} -result "{} timeout {} timeout 牦 {} eof 0 {}"
test chan-io-13.1 {TranslateInputEOL: cr mode} -body {
set f [open $path(test1) w]
@@ -1530,7 +1530,7 @@ test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
chan close $f
} -result "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
# (*chanPtr->inEofChar != '\0')
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\ndefgh"
@@ -1542,7 +1542,7 @@ test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
chan close $f
} -result "abcd\nd"
test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
# (*chanPtr->inEofChar != '\0')
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
@@ -1878,7 +1878,7 @@ test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
} -result [list [list \x1a ""] {auto crlf}]
} -result [list [list \x1A ""] {auto crlf}]
test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
@@ -3091,10 +3091,10 @@ test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a
chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
@@ -3107,11 +3107,11 @@ test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
} -constraints {win} -body {
set f [open $path(test1) w]
chan configure $f -eofchar \x1a -translation lf
chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
@@ -3129,7 +3129,7 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $s
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3150,7 +3150,7 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
chan puts $f $s
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3183,7 +3183,7 @@ test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1aghi 0 qrs 0 {} 1"
} -result "abc def 0 \x1Aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
file delete $path(test1)
set l ""
@@ -3195,7 +3195,7 @@ test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar {}
set x [chan gets $f]
lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3213,7 +3213,7 @@ test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar {}
set x [chan gets $f]
lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3228,7 +3228,7 @@ test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3242,7 +3242,7 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3256,7 +3256,7 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3270,7 +3270,7 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3284,7 +3284,7 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3298,7 +3298,7 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3649,7 +3649,7 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup {
chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3665,11 +3665,11 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
set l ""
} -body {
set f [open $path(test1) w]
chan configure $f -eofchar \x1a -translation lf
chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3689,8 +3689,7 @@ test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a
chan configure $f -translation auto
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3708,7 +3707,7 @@ test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3738,7 +3737,7 @@ test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
file delete $path(test1)
set l ""
@@ -3760,7 +3759,7 @@ test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
file delete $path(test1)
set l ""
@@ -3782,7 +3781,7 @@ test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
@@ -3792,7 +3791,7 @@ test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3810,7 +3809,7 @@ test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3828,7 +3827,7 @@ test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3846,7 +3845,7 @@ test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3864,7 +3863,7 @@ test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3882,7 +3881,7 @@ test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -4638,12 +4637,12 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4652,12 +4651,12 @@ test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4666,12 +4665,12 @@ test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4680,12 +4679,12 @@ test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4694,12 +4693,12 @@ test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4708,12 +4707,12 @@ test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4727,7 +4726,7 @@ test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4741,7 +4740,7 @@ test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4755,7 +4754,7 @@ test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4769,7 +4768,7 @@ test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4783,7 +4782,7 @@ test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4797,7 +4796,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -5167,27 +5166,27 @@ test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
chan puts -nonewline $f \xe7\x89\xa6
chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
chan read $f
} -cleanup {
chan close $f
} -result \u7266
} -result 牦
test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
chan puts -nonewline $f \xe7\x89\xa6
chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
chan read $f
} -cleanup {
chan close $f
} -result \u7266
} -result 牦
test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
file delete $path(test1)
set f [open $path(test1) w]
@@ -5201,7 +5200,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xe7"
chan puts -nonewline $f "\xE7"
chan flush $f
chan configure $f -encoding utf-8 -blocking 0
chan event $f readable [namespace code { lappend x [chan read $f] }]
@@ -5219,7 +5218,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
return $x
} -cleanup {
chan close $f
} -result "{} timeout {} timeout \xe7 timeout"
} -result "{} timeout {} timeout \xE7 timeout"
test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
-constraints {socket} -body {
proc accept {s a p} {chan close $s}
@@ -5533,11 +5532,11 @@ test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
} {{first script} {new script} {yet another} {}}
test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
chan event $f r "first scr\0ipt"
chan event $f r "first scr\x00ipt"
lappend result [string length [chan event $f readable]]
chan event $f r "new scr\0ipt"
chan event $f r "new scr\x00ipt"
lappend result [string length [chan event $f readable]]
chan event $f r "yet ano\0ther"
chan event $f r "yet ano\x00ther"
lappend result [string length [chan event $f readable]]
chan event $f r ""
lappend result [chan event $f readable]
@@ -5983,7 +5982,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6007,7 +6006,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode}
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6031,7 +6030,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6055,7 +6054,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode}
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6079,7 +6078,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation auto -eofchar \x1a
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6103,7 +6102,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation auto
chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6127,7 +6126,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation lf
chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6151,7 +6150,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode}
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation lf -eofchar \x1a
chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6175,7 +6174,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation cr
chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6199,7 +6198,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode}
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar \x1a
chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6223,7 +6222,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -eofchar \x1a -translation crlf
chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6247,7 +6246,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar \x1a
chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6784,7 +6783,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
chan configure $out -encoding koi8-r -translation lf
chan puts $out "\u0410\u0410"
chan puts $out "АА"
chan close $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using chan copy.
@@ -6822,7 +6821,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
set f [open $path(utf8-fcopy.txt) w]
fconfigure $f -encoding utf-8 -translation lf
puts $f "\u0410\u0410"
puts $f "АА"
close $f
} -constraints {fcopy} -body {
# binary to encoding => the input has to be in utf-8 to make sense to the
@@ -7496,7 +7495,7 @@ test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
chan puts $out {
chan puts [testbytestring \xe2]
chan puts [testbytestring \xE2]
exit 1
}
proc readit {pipe} {
+11 -11
View File
@@ -234,7 +234,7 @@ namespace eval ::testClock {
Bias 300 \
StandardBias 0 \
DaylightBias -60 \
StandardStart \x00\x00\x0b\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
StandardStart \x00\x00\x0B\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
}
@@ -36789,16 +36789,16 @@ test clock-58.1 {clock l10n - Japanese localisation} {*}{
-body {
set trouble {}
foreach {date jdate} {
1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5
1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5
1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5
1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5
1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5
1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5
1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5
1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5
2019-04-30 \u5e73\u621031\u5e7404\u670830\u65e5
2019-05-01 \u4ee4\u548c01\u5e7405\u670801\u65e5
1872-12-31 西暦1872年12月31日
1873-01-01 明治06年01月01日
1912-07-29 明治45年07月29日
1912-07-30 大正01年07月30日
1926-12-24 大正15年12月24日
1926-12-25 昭和01年12月25日
1989-01-07 昭和64年01月07日
1989-01-08 平成01年01月08日
2019-04-30 平成31年04月30日
2019-05-01 令和01年05月01日
} {
set status [catch {
set secs [clock scan $date \
+8 -8
View File
@@ -149,10 +149,10 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
set dir [pwd]
} -returnCodes error -body {
cd .\0
cd .\x00
} -cleanup {
cd $dir
} -match glob -result "couldn't change working directory to \".\0\": *"
} -match glob -result "couldn't change working directory to \".\x00\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -186,7 +186,7 @@ test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system jis0208
encoding convertto \u4e4e
encoding convertto 乎
} -cleanup {
encoding system $system
} -result 8C
@@ -194,7 +194,7 @@ test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
encoding system iso8859-1
encoding convertto jis0208 \u4e4e
encoding convertto jis0208 乎
} -cleanup {
encoding system $system
} -result 8C
@@ -211,7 +211,7 @@ test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
encoding convertfrom 8C
} -cleanup {
encoding system $system
} -result \u4e4e
} -result 乎
test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
set system [encoding system]
} -body {
@@ -219,7 +219,7 @@ test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
encoding convertfrom jis0208 8C
} -cleanup {
encoding system $system
} -result \u4e4e
} -result 乎
test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
encoding names foo
} -result {wrong # args: should be "encoding names"}
@@ -1221,7 +1221,7 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
set oldfile $file
} -constraints unix -body {
# introduce some non-ascii characters.
append file \u2022
append file •
file delete -force $file
file rename $oldfile $file
set mtime [file mtime $file]
@@ -1246,7 +1246,7 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
set oldfile $file
} -constraints win -body {
# introduce some non-ascii characters.
append file \u2022
append file •
file delete -force $file
file rename $oldfile $file
set mtime [file mtime $file]
+15 -15
View File
@@ -151,17 +151,17 @@ test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
}
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
lsort -ascii [list \x00 \x7F \x80 \uFFFF]
} [list \x00 \x7F \x80 \uFFFF]
test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
lsort -ascii -nocase [list \x00 \x7F \x80 \uFFFF]
} [list \x00 \x7F \x80 \uFFFF]
test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
lsort -ascii [list \x00 \x7F \x80 \U01ffff \uFFFF]
} [list \x00 \x7F \x80 \uFFFF \U01ffff]
test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
lsort -ascii -nocase [list \x00 \x7F \x80 \U01ffff \uFFFF]
} [list \x00 \x7F \x80 \uFFFF \U01FFFF]
test cmdIL-1.41 {lsort -stride and -index} -body {
lsort -stride 2 -index -2 {a 2 b 1}
} -returnCodes error -result {index "-2" out of range}
@@ -177,7 +177,7 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
set r 1435753299
proc rand {} {
global r
set r [expr {(16807 * $r) % (0x7fffffff)}]
set r [expr {(16807 * $r) % (0x7FFFFFFF)}]
}
} -body {
for {set i 0} {$i < 150} {incr i} {
@@ -396,16 +396,16 @@ test cmdIL-4.23 {DictionaryCompare procedure, case} {
} {ABcd AbCd}
test cmdIL-4.24 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
::tcltest::set_iso8859_1_locale
set result [lsort -dictionary "a b c A B C \xe3 \xc4"]
set result [lsort -dictionary "a b c A B C ã Ä"]
::tcltest::restore_locale
set result
} "A a B b C c \xe3 \xc4"
} "A a B b C c ã Ä"
test cmdIL-4.25 {DictionaryCompare procedure, international characters} {hasIsoLocale} {
::tcltest::set_iso8859_1_locale
set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"]
set result [lsort -dictionary "a23ã a23Å a23ä"]
::tcltest::restore_locale
set result
} "a23\xe3 a23\xe4 a23\xc5"
} "a23ã a23ä a23Å"
test cmdIL-4.26 {DefaultCompare procedure, signed characters} {
set l [lsort [list "abc\200" "abc"]]
set viewlist {}
@@ -472,10 +472,10 @@ test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
} {257 32 256}
test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c
scan [lsort -ascii -nocase [list a\x00a a]] %c%c%c%c%c
} {97 32 97 0 97}
test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c
scan [lsort -ascii -nocase [list a a\x00a]] %c%c%c%c%c
} {97 32 97 0 97}
test cmdIL-5.1 {lsort with list style index} {
+5 -5
View File
@@ -299,19 +299,19 @@ test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
apply {{} {
set x ab\000c
set x ab\x00c
set y [split $x {}]
binary scan $y c* z
return $z
}}
} {97 32 98 32 0 32 99}
test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
split "a0ab1b2bbb3\000c4" ab\000c
split "a0ab1b2bbb3\x00c4" ab\x00c
} {{} 0 {} 1 2 {} {} 3 {} 4}
test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"
# if not UTF-8 aware, result is "a {} {} b qwå {} N wq"
split "a乎b qw幎N wq" " 乎"
} "a b qw幎N wq"
# The tests for Tcl_StringObjCmd are in string.test
# The tests for Tcl_SubstObjCmd are in subst.test
+10 -10
View File
@@ -29,9 +29,9 @@ proc testIEEE {} {
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
@@ -41,19 +41,19 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
@@ -63,11 +63,11 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
+2 -2
View File
@@ -286,10 +286,10 @@ test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
} {4}
test compile-8.1 {CollectArgInfo: binary data} {
list [catch "string length \000foo" msg] $msg
list [catch "string length \x00foo" msg] $msg
} {0 4}
test compile-8.2 {CollectArgInfo: binary data} {
list [catch "string length foo\000" msg] $msg
list [catch "string length foo\x00" msg] $msg
} {0 4}
test compile-8.3 {CollectArgInfo: handle "]" at end of command properly} {
set x ]
+39 -39
View File
@@ -183,7 +183,7 @@ test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
test encoding-8.1 {Tcl_ExternalToUtf} {
set f [open [file join [temporaryDirectory] dummy] w]
fconfigure $f -translation binary -encoding iso8859-1
puts -nonewline $f "ab\x8c\xc1g"
puts -nonewline $f "ab\x8C\xC1g"
close $f
set f [open [file join [temporaryDirectory] dummy] r]
fconfigure $f -translation binary -encoding shiftjis
@@ -219,7 +219,7 @@ test encoding-10.1 {Tcl_UtfToExternal} {
close $f
file delete [file join [temporaryDirectory] dummy]
return $x
} "ab\x8c\xc1g"
} "ab\x8C\xC1g"
proc viewable {str} {
set res ""
@@ -227,7 +227,7 @@ proc viewable {str} {
if {[string is print $c] && [string is ascii $c]} {
append res $c
} else {
append res "\\u[format %4.4x [scan $c %c]]"
append res "\\u[format %4.4X [scan $c %c]]"
}
}
return "$str ($res)"
@@ -258,7 +258,7 @@ test encoding-11.5 {LoadEncodingFile: escape file} {
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022-jp 乎]
} [viewable "\x1b\$B8C\x1b(B"]
} [viewable "\x1B\$B8C\x1B(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
set system [encoding system]
set path [encoding dirs]
@@ -283,24 +283,24 @@ test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding}
} -result {invalid encoding file "splat"}
test encoding-11.8 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16le 😹]
} {=Ø9Þ (=\u00d89\u00de)}
} {=Ø9Þ (=\u00D89\u00DE)}
test encoding-11.9 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16be 😹]
} {Ø=Þ9 (\u00d8=\u00de9)}
} {Ø=Þ9 (\u00D8=\u00DE9)}
# OpenEncodingFile is fully tested by the rest of the tests in this file.
test encoding-12.1 {LoadTableEncoding: normal encoding} {
set x [encoding convertto iso8859-3 \u0120]
append x [encoding convertto iso8859-3 \xD5]
append x [encoding convertfrom iso8859-3 \xD5]
} "\xD5?\u120"
set x [encoding convertto iso8859-3 Ġ]
append x [encoding convertto iso8859-3 Õ]
append x [encoding convertfrom iso8859-3 Õ]
} "Õ?Ġ"
test encoding-12.2 {LoadTableEncoding: single-byte encoding} {
set x [encoding convertto iso8859-3 ab\u0120g]
append x [encoding convertfrom iso8859-3 ab\xD5g]
} "ab\xD5gab\u120g"
set x [encoding convertto iso8859-3 abĠg]
append x [encoding convertfrom iso8859-3 abÕg]
} "abÕgabĠg"
test encoding-12.3 {LoadTableEncoding: multi-byte encoding} {
set x [encoding convertto shiftjis ab乎g]
append x [encoding convertfrom shiftjis ab\x8c\xc1g]
append x [encoding convertfrom shiftjis ab\x8C\xC1g]
} "ab\x8C\xC1gab乎g"
test encoding-12.4 {LoadTableEncoding: double-byte encoding} {
set x [encoding convertto jis0208 乎α]
@@ -317,7 +317,7 @@ test encoding-13.1 {LoadEscapeTable} {
} [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"]
test encoding-15.1 {UtfToUtfProc} {
encoding convertto utf-8 \xA3
encoding convertto utf-8 £
} "\xC2\xA3"
test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
binary scan [testbytestring [encoding convertto utf-8 \x00]] H* z
@@ -351,8 +351,8 @@ test encoding-15.7 {UtfToUtfProc emoji character output} {
list [string length $x] [string length $y] $z
} {3 9 edb882eda0bdeda0bd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83D\xE9
set y [encoding convertto utf-8 \uDE02\uD83D\xE9]
set x \uDE02\uD83Dé
set y [encoding convertto utf-8 \uDE02\uD83Dé]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {3 8 edb882eda0bdc3a9}
@@ -363,14 +363,14 @@ test encoding-15.9 {UtfToUtfProc emoji character output} {
list [string length $x] [string length $y] $z
} {3 7 edb882eda0bd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
set x \uDE02\xE9
set y [encoding convertto utf-8 \uDE02\xE9]
set x \uDE02é
set y [encoding convertto utf-8 \uDE02é]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 5 edb882c3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
set x \uDA02\xE9
set y [encoding convertto utf-8 \uDA02\xE9]
set x \uDA02é
set y [encoding convertto utf-8 \uDA02é]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 5 eda882c3a9}
@@ -425,7 +425,7 @@ test encoding-16.3 {Utf16ToUtfProc} -body {
test encoding-16.4 {Ucs2ToUtfProc} -body {
set val [encoding convertfrom ucs-2 NN]
list $val [format %x [scan $val %c]]
} -result "\u4E4E 4e4e"
} -result "乎 4e4e"
test encoding-16.4 {Ucs2ToUtfProc} -body {
set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
list $val [format %x [scan $val %c]]
@@ -459,18 +459,18 @@ test encoding-21.1 {EscapeToUtfProc} {
test encoding-22.1 {EscapeFromUtfProc} {
} {}
set iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
\u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B
\u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
\u001b\$B\$7\$g\$&\$+!)\u001b(B"
set iso2022encData "\x1B\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\x1B(B
\x1B\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\x1B(B
\x1B\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\x1B(B
casino_japanese@___.com \x1B\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\x1B(B
\x1B\$B\$7\$g\$&\$+!)\x1B(B"
set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
set iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
\u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a
\u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08
\u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
\u3057\u3087\u3046\u304b\uff1f"
set iso2022uniData2 "私どもでは、チップご購入時にご登録いただいたご住所をキャッシュアウトの際の
小切手送付先として使用しております。恐れ入りますが、正しい住所をご登録しなお
お願いいたします。また、大変恐縮ですが、住所変更のあと、日本語サービス部(
casino_japanese@___.com )までご住所変更済の連絡をいただけないで
しょうか?"
cd [temporaryDirectory]
set fid [open iso2022.txt w]
@@ -539,7 +539,7 @@ test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
set env(TCL_FINALIZE_ON_EXIT) 1
exit
}]
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
# Bug #219314 - if we don't free escape encodings correctly on channel
# closure, we go boom
@@ -554,7 +554,7 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
close $f
removeFile iso2022.tcl
list $count [viewable $line]
} [list 3 "乎乞也 (\\u4e4e\\u4e5e\\u4e5f)"]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]
test encoding-24.4 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC0\x80"]
@@ -632,20 +632,20 @@ proc foreach-jisx0208 {varName command} {
}
proc gen-jisx0208-euc-jp {code} {
binary format cc \
[expr {($code >> 8) | 0x80}] [expr {($code & 0xff) | 0x80}]
[expr {($code >> 8) | 0x80}] [expr {($code & 0xFF) | 0x80}]
}
proc gen-jisx0208-iso2022-jp {code} {
binary format a3cca3 \
"\x1b\$B" [expr {$code >> 8}] [expr {$code & 0xff}] "\x1b(B"
"\x1B\$B" [expr {$code >> 8}] [expr {$code & 0xFF}] "\x1B(B"
}
proc gen-jisx0208-cp932 {code} {
set c1 [expr {($code >> 8) | 0x80}]
set c2 [expr {($code & 0xff)| 0x80}]
if {$c1 % 2} {
set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x31 : 0x71)}]
incr c2 [expr {- (0x60 + ($c2 < 0xe0))}]
set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x31 : 0x71)}]
incr c2 [expr {- (0x60 + ($c2 < 0xE0))}]
} else {
set c1 [expr {($c1 >> 1) + ($c1 < 0xdf ? 0x30 : 0x70)}]
set c1 [expr {($c1 >> 1) + ($c1 < 0xDF ? 0x30 : 0x70)}]
incr c2 -2
}
binary format cc $c1 $c2
+5 -5
View File
@@ -169,19 +169,19 @@ test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
encoding system iso8859-1
proc quotenonascii s {
regsub -all {\[|\\|\]} $s {\\&} s
regsub -all "\[\u007f-\uffff\]" $s \
{[apply {c {format {\u%04x} [scan $c %c]}} &]} s
regsub -all "\[\x7F-\xFF\]" $s \
{[apply {c {format {\x%02X} [scan $c %c]}} &]} s
return [subst -novariables $s]
}
} -constraints {exec} -body {
# If this fails, it may give back: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
# If this fails, it may give back: "\xC3\xA9\xC3\xA0\xC3\xBC\xC3\xB1"
# If it does, this means that the UTF -> external conversion did not occur
# before writing out the temp file.
quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"]
quotenonascii [exec [interpreter] $path(cat) << "\xE9\xE0\xFC\xF1"]
} -cleanup {
encoding system $sysenc
rename quotenonascii {}
} -result {\u00e9\u00e0\u00fc\u00f1}
} -result {\xE9\xE0\xFC\xF1}
# I/O redirection: output to file.
+1 -1
View File
@@ -1066,7 +1066,7 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} {
} SUCCESS
test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} İ
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
interp create child
+10 -10
View File
@@ -35,9 +35,9 @@ proc testIEEE {} {
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
@@ -47,19 +47,19 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
@@ -69,11 +69,11 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
set ieeeValues(littleEndian) 0
return 1
+13 -13
View File
@@ -33,9 +33,9 @@ proc testIEEE {} {
switch -exact -- $c {
{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
# little endian
binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xFF d \
ieeeValues(-Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\xBF d \
ieeeValues(-Normal)
binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
ieeeValues(-Subnormal)
@@ -45,21 +45,21 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
ieeeValues(+Subnormal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x3F d \
ieeeValues(+Normal)
binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF0\x7F d \
ieeeValues(+Infinity)
binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
binary scan \x00\x00\x00\x00\x00\x00\xF8\x7F d \
ieeeValues(NaN)
binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
binary scan \x00\x00\x00\x00\x00\x00\xF8\xFF d \
ieeeValues(-NaN)
set ieeeValues(littleEndian) 1
return 1
}
{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xFF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Infinity)
binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \xBF\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Normal)
binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-Subnormal)
@@ -69,13 +69,13 @@ proc testIEEE {} {
ieeeValues(+0)
binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Subnormal)
binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x3F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Normal)
binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF0\x00\x00\x00\x00\x00\x00 d \
ieeeValues(+Infinity)
binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
binary scan \x7F\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(NaN)
binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
binary scan \xFF\xF8\x00\x00\x00\x00\x00\x00 d \
ieeeValues(-NaN)
set ieeeValues(littleEndian) 0
return 1
@@ -351,7 +351,7 @@ test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2!=x
} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1
test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \xFC]}} 1
test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
+2 -2
View File
@@ -271,7 +271,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
file mkdir td1
file rename ~_totally_bogus_user td1
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup {
cleanup
} -constraints {notRoot unixOrWin} -returnCodes error -body {
file mkdir td1
@@ -313,7 +313,7 @@ test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
} -constraints {notRoot} -returnCodes error -body {
file mkdir ~_totally_bogus_user
} -result {user "_totally_bogus_user" doesn't exist}
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup {
test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir ""
+1 -1
View File
@@ -13,7 +13,7 @@ namespace eval ::tcl::test::fileSystemEncoding {
namespace import -force ::tcltest::*
}
variable fname1 \u767b\u9e1b\u9d72\u6a13
variable fname1 登鸛鵲樓
proc autopath {} {
global auto_path
+16 -10
View File
@@ -105,17 +105,17 @@ test format-2.4 {string formatting} {
format "%s %s %% %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. % x x}
test format-2.5 {string formatting, embedded nulls} {
format "%10s" abc\0def
} " abc\0def"
format "%10s" abc\x00def
} " abc\x00def"
test format-2.6 {string formatting, international chars} {
format "%10s" abc\ufeffdef
} " abc\ufeffdef"
format "%10s" abc\uFEFFdef
} " abc\uFEFFdef"
test format-2.7 {string formatting, international chars} {
format "%.5s" abc\ufeffdef
} "abc\ufeffd"
format "%.5s" abc\uFEFFdef
} "abc\uFEFFd"
test format-2.8 {string formatting, international chars} {
format "foo\ufeffbar%s" baz
} "foo\ufeffbarbaz"
format "foo\uFEFFbar%s" baz
} "foo\uFEFFbarbaz"
test format-2.9 {string formatting, width} {
format "a%5sa" f
} "a fa"
@@ -143,13 +143,19 @@ test format-2.16 {string formatting, width and precision} {
test format-2.17 {string formatting, width and precision} {
format "a%5.7sa" foobarbaz
} "afoobarba"
test format-2.18 {string formatting, surrogates} {
format "\uD83D%s" \uDE02
} \uD83D\uDE02
test format-2.19 {string formatting, surrogates} {
format "%s\uDE02" \uD83D
} \uD83D\uDE02
test format-3.1 {Tcl_FormatObjCmd: character formatting} {
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
} "|A|A|A|A|A | A| A|A |"
test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f
} "|\ua2|\u4e4e|\u25a|\uc3|\uff08 | \0| \u6575|\u4e4f |"
format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xA2 0x4E4E 0x25A 0xC3 0xFF08 0 3 0x6575 -4 0x4E4F
} "|¢|乎|ɚ|Ã|( | \x00| 敵|乏 |"
test format-4.1 {e and f formats} {eformat} {
format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053
+25 -25
View File
@@ -42,7 +42,7 @@ proc bgerror {args} {
# Name resolution is often a problem on OSX; not focus of HTTP package anyway.
# Also a problem on other platforms for http-4.14 (test with bad port number).
set HOST localhost
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
set bindata "This is binary data\x0D\x0Amore\x0Dmore\x0Amore\x00null"
catch {unset data}
# Ensure httpd file exists
@@ -620,12 +620,12 @@ test http-5.3 {http::formatQuery} {
http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
http::formatQuery name1 ~bwelch name2 ¡¢¢
} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5 {http::formatQuery} {
set enc [http::config -urlencoding]
http::config -urlencoding iso8859-1
set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
set res [http::formatQuery name1 ~bwelch name2 ¡¢¢]
http::config -urlencoding $enc
set res
} {name1=~bwelch&name2=%A1%A2%A2}
@@ -650,24 +650,24 @@ test http-7.1 {http::mapReply} {
test http-7.2 {http::mapReply} {
# RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
# so make sure this gets converted to utf-8 then urlencoded.
http::mapReply "\u2208"
http::mapReply "∈"
} {%E2%88%88}
test http-7.3 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -returnCodes error -body {
# this would be reverting to http <=2.4 behavior
http::config -urlencoding ""
http::mapReply "\u2208"
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": no such element in array"
} -result "can't read \"formMap(∈)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
set enc [http::config -urlencoding]
} -body {
# this would be reverting to http <=2.4 behavior w/o errors
# (unknown chars become '?')
http::config -urlencoding "iso8859-1"
http::mapReply "\u2208"
http::mapReply "∈"
} -cleanup {
http::config -urlencoding $enc
} -result {%3F}
@@ -715,37 +715,37 @@ test http-idna-2.1 {puny encode: functional test} {
::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
::tcl::idna puny encode a\u20acb\u20acc
::tcl::idna puny encode a€b€c
} abc-k50ab
test http-idna-2.3 {puny encode: functional test} {
::tcl::idna puny encode ABC
} ABC-
test http-idna-2.4 {puny encode: functional test} {
::tcl::idna puny encode A\u20ACB\u20ACC
::tcl::idna puny encode A€B€C
} ABC-k50ab
test http-idna-2.5 {puny encode: functional test} {
::tcl::idna puny encode ABC 0
} abc-
test http-idna-2.6 {puny encode: functional test} {
::tcl::idna puny encode A\u20ACB\u20ACC 0
::tcl::idna puny encode A€B€C 0
} abc-k50ab
test http-idna-2.7 {puny encode: functional test} {
::tcl::idna puny encode ABC 1
} ABC-
test http-idna-2.8 {puny encode: functional test} {
::tcl::idna puny encode A\u20ACB\u20ACC 1
::tcl::idna puny encode A€B€C 1
} ABC-k50ab
test http-idna-2.9 {puny encode: functional test} {
::tcl::idna puny encode abc 0
} abc-
test http-idna-2.10 {puny encode: functional test} {
::tcl::idna puny encode a\u20ACb\u20ACc 0
::tcl::idna puny encode a€b€c 0
} abc-k50ab
test http-idna-2.11 {puny encode: functional test} {
::tcl::idna puny encode abc 1
} ABC-
test http-idna-2.12 {puny encode: functional test} {
::tcl::idna puny encode a\u20ACb\u20ACc 1
::tcl::idna puny encode a€b€c 1
} ABC-k50ab
test http-idna-2.13 {puny encode: edge cases} {
::tcl::idna puny encode ""
@@ -875,43 +875,43 @@ test http-idna-3.1 {puny decode: functional test} {
} abc
test http-idna-3.2 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab
} a\u20acb\u20acc
} a€b€c
test http-idna-3.3 {puny decode: functional test} {
::tcl::idna puny decode ABC-
} ABC
test http-idna-3.4 {puny decode: functional test} {
::tcl::idna puny decode ABC-k50ab
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.5 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.6 {puny decode: functional test} {
::tcl::idna puny decode abc-K50AB
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.7 {puny decode: functional test} {
::tcl::idna puny decode ABC- 0
} abc
test http-idna-3.8 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB 0
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.9 {puny decode: functional test} {
::tcl::idna puny decode ABC- 1
} ABC
test http-idna-3.10 {puny decode: functional test} {
::tcl::idna puny decode ABC-K50AB 1
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.11 {puny decode: functional test} {
::tcl::idna puny decode abc- 0
} abc
test http-idna-3.12 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab 0
} a\u20ACb\u20ACc
} a€b€c
test http-idna-3.13 {puny decode: functional test} {
::tcl::idna puny decode abc- 1
} ABC
test http-idna-3.14 {puny decode: functional test} {
::tcl::idna puny decode abc-k50ab 1
} A\u20ACB\u20ACC
} A€B€C
test http-idna-3.15 {puny decode: edge cases and errors} {
# Is this case actually correct?
binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
@@ -1045,16 +1045,16 @@ test http-idna-4.1 {IDNA encoding} {
::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
::tcl::idna encode a\u20acb\u20acc.def
::tcl::idna encode a€b€c.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
::tcl::idna encode def.a\u20acb\u20acc
::tcl::idna encode def.a€b€c
} def.xn--abc-k50ab
test http-idna-4.4 {IDNA encoding} {
::tcl::idna encode ABC.DEF
} ABC.DEF
test http-idna-4.5 {IDNA encoding} {
::tcl::idna encode A\u20acB\u20acC.def
::tcl::idna encode A€B€C.def
} xn--ABC-k50ab.def
test http-idna-4.6 {IDNA encoding: invalid edge case} {
# Should this be an error?
@@ -1084,7 +1084,7 @@ test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test http-idna-4.10 {IDNA encoding: edge cases} {
::tcl::idna encode pass\u00e9.example.com
::tcl::idna encode passé.example.com
} xn--pass-epa.example.com
test http-idna-5.1 {IDNA decoding} {
+1 -1
View File
@@ -155,7 +155,7 @@ foreach arg [subst -nocommands -novariables {
error stack cannot be uniquely determined.
foo bar
"}
{argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
{argument that contains non-ASCII character, €, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
}] { ;# emacs needs -> "
test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
+63 -64
View File
@@ -108,17 +108,17 @@ set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "a\u4e4d\0"
puts -nonewline $f "a乍\x00"
close $f
contents $path(test1)
} "a\x4d\x00"
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts -nonewline $f "a\u4e4d\0"
puts -nonewline $f "a乍\x00"
close $f
contents $path(test1)
} "a\x93\xe1\x00"
} "a\x93\xE1\x00"
set path(test2) [makeFile {} test2]
test io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
@@ -132,7 +132,7 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
} " \x1B\$B\$O\x1B(B"
test io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends
@@ -295,14 +295,14 @@ test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# in src to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
# (first two bytes of \uff21 in UTF-8). Given those two bytes try
# (first two bytes of A in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes
# (the last byte of \uff21 plus the all of \uff22) appended.
# (the last byte of A plus the all of B) appended.
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis -buffersize 16
puts -nonewline $f "12345678901234\uff21\uff22"
puts -nonewline $f "12345678901234AB"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
@@ -451,7 +451,7 @@ test io-6.3 {Tcl_GetsObj: how many have we used?} {
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x81\u1234\0"
puts $f "\x81\u1234\x00"
close $f
set f [open $path(test1)]
fconfigure $f -translation binary
@@ -462,14 +462,14 @@ test io-6.4 {Tcl_GetsObj: encoding == NULL} {
test io-6.5 {Tcl_GetsObj: encoding != NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts $f "\x88\xea\x92\x9a"
puts $f "\x88\xEA\x92\x9A"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
set x [list [gets $f line] $line]
close $f
set x
} [list 2 "\u4e00\u4e01"]
} [list 2 "一丁"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
@@ -509,7 +509,7 @@ test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
set f [open $path(test1) w]
puts $f "abcdefghijk\nwom\u001abat"
puts $f "abcdefghijk\nwom\x1Abat"
close $f
set f [open $path(test1)]
fconfigure $f -eofchar \x1A
@@ -1052,14 +1052,14 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
set f [open $path(test1) w]
fconfigure $f -encoding iso2022-jp
puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
puts $f "there一ok\n丁more bytes\nhere"
close $f
set f [open $path(test1)]
fconfigure $f -encoding iso2022-jp
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
} [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1086,20 +1086,20 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
puts $f "123456789012301234\nend"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis -buffersize 16
set x [gets $f]
close $f
set x
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
} "123456789012301234"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
@@ -1110,7 +1110,7 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis
@@ -1119,11 +1119,11 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
lappend x [gets $f line] $line
close $f
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
} [list 15 "123456789012301" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
fconfigure $f -encoding shiftjis -blocking 0
fileevent $f read [namespace code "ready $f"]
variable x {}
@@ -1138,7 +1138,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent
vwait [namespace which -variable x]
close $f
set x
} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
} [list -1 "" 1 17 "12345678901230123" 0]
test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
# (bufPtr->nextPtr == NULL)
@@ -1415,19 +1415,19 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
fconfigure $f -encoding shiftjis
vwait [namespace which -variable x]
fconfigure $f -encoding binary -blocking 1
puts -nonewline $f "\x7b"
puts -nonewline $f "\x7B"
after 500 ;# Give the cat process time to catch up
fconfigure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
} [list "123456789012345" 1 "本" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xe7"
gets stdin; puts -nonewline "\xE7"
gets stdin; puts -nonewline "\x89"
gets stdin; puts -nonewline "\xa6"
gets stdin; puts -nonewline "\xA6"
} test1]
set f [open "|[list [interpreter] $path(test1)]" r+]
fileevent $f readable [namespace code {
@@ -1454,7 +1454,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
} "{} timeout {} timeout \u7266 {} eof 0 {}"
} "{} timeout {} timeout 牦 {} eof 0 {}"
test io-12.6 {ReadChars: too many chars read} {
proc driver {cmd args} {
variable buffer
@@ -1464,7 +1464,7 @@ test io-12.6 {ReadChars: too many chars read} {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
[string repeat \uBEEF 20][string repeat . 20]]
[string repeat 뻯 20][string repeat . 20]]
return {initialize finalize watch read}
}
finalize {
@@ -1497,7 +1497,7 @@ test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
[string repeat \uBEEF 10]....\uBEEF]
[string repeat 뻯 10]....뻯]
return {initialize finalize watch read}
}
finalize {
@@ -1524,7 +1524,7 @@ test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
test io-12.8 {ReadChars: multibyte chars split} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xc2\xa0
puts -nonewline $f [string repeat a 9]\xC2\xA0
close $f
set f [open $path(test1)]
fconfigure $f -encoding utf-8 -buffersize 10
@@ -1535,7 +1535,7 @@ test io-12.8 {ReadChars: multibyte chars split} {
test io-12.9 {ReadChars: multibyte chars split} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xc2
puts -nonewline $f [string repeat a 9]\xC2
close $f
set f [open $path(test1)]
fconfigure $f -encoding utf-8 -buffersize 10
@@ -1546,7 +1546,7 @@ test io-12.9 {ReadChars: multibyte chars split} {
test io-12.10 {ReadChars: multibyte chars split} {
set f [open $path(test1) w]
fconfigure $f -translation binary
puts -nonewline $f [string repeat a 9]\xc2
puts -nonewline $f [string repeat a 9]\xC2
close $f
set f [open $path(test1)]
fconfigure $f -encoding utf-8 -buffersize 11
@@ -1732,7 +1732,7 @@ test io-13.10 {TranslateInputEOL: auto mode: \n} {
set x
} "abcd\ndef"
test io-13.11 {TranslateInputEOL: EOF char} {
# (*chanPtr->inEofChar != '\0')
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1745,7 +1745,7 @@ test io-13.11 {TranslateInputEOL: EOF char} {
set x
} "abcd\nd"
test io-13.12 {TranslateInputEOL: find EOF char in src} {
# (*chanPtr->inEofChar != '\0')
# (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -3202,7 +3202,7 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
puts -nonewline $f hello\nthere\nand\rhere\n\x1A
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set c [read $f]
close $f
set c
@@ -3214,11 +3214,11 @@ here
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -eofchar \x1A -translation lf
fconfigure $f -translation lf -eofchar \x1A
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set c [read $f]
close $f
set c
@@ -3235,7 +3235,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3255,7 +3255,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3736,7 +3736,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3751,11 +3751,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -eofchar \x1A -translation lf
fconfigure $f -translation lf -eofchar \x1A
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3775,8 +3775,7 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A
fconfigure $f -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3794,7 +3793,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
puts $f $s
close $f
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -5479,26 +5478,26 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
puts -nonewline $f \xE7\x89\xA6
close $f
set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
set x
} \u7266
} 牦
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f \xe7\x89\xa6
puts -nonewline $f \xE7\x89\xA6
close $f
set f [open $path(test1) r]
fconfigure $f -encoding utf-8
set x [read $f]
close $f
set x
} \u7266
} 牦
test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -5509,7 +5508,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
puts -nonewline $f "\xE7"
flush $f
fconfigure $f -encoding utf-8 -blocking 0
variable x {}
@@ -5527,7 +5526,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA}
vwait [namespace which -variable x]
close $f
set x
} "{} timeout {} timeout \xe7 timeout"
} "{} timeout {} timeout \xE7 timeout"
test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
{socket} {
proc accept {s a p} {close $s}
@@ -5830,11 +5829,11 @@ test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
} {{first script} {new script} {yet another} {}}
test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
fileevent $f r "first scr\0ipt"
fileevent $f r "first scr\x00ipt"
lappend result [string length [fileevent $f readable]]
fileevent $f r "new scr\0ipt"
fileevent $f r "new scr\x00ipt"
lappend result [string length [fileevent $f readable]]
fileevent $f r "yet ano\0ther"
fileevent $f r "yet ano\x00ther"
lappend result [string length [fileevent $f readable]]
fileevent $f r ""
lappend result [fileevent $f readable]
@@ -6391,7 +6390,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6447,7 +6446,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6503,7 +6502,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation auto
fconfigure $f -translation auto -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6531,7 +6530,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation lf
fconfigure $f -translation lf -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6587,7 +6586,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation cr
fconfigure $f -translation cr -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6643,7 +6642,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f
set c 0
set l ""
set f [open $path(test1) r]
fconfigure $f -eofchar \x1A -translation crlf
fconfigure $f -translation crlf -eofchar \x1A
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -7218,7 +7217,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
fconfigure $out -encoding koi8-r -translation lf
puts $out "\u0410\u0410"
puts $out "АА"
close $out
test io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using fcopy.
@@ -7270,7 +7269,7 @@ test io-52.10 {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"
puts $out "АА"
close $out
} -constraints {fcopy} -body {
# binary to encoding => the input has to be
@@ -8390,7 +8389,7 @@ test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
set out [open $path(script) w]
puts $out "catch {load $::tcltestlib Tcltest}"
puts $out {
puts [testbytestring \xe2]
puts [testbytestring \xE2]
exit 1
}
proc readit {pipe} {
@@ -8748,7 +8747,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
read $rfd
} -body {
set result [eof $rfd]
puts -nonewline $wfd "more\u00c2\u00a0data"
puts -nonewline $wfd "more\xC2\xA0data"
lappend result [eof $rfd]
lappend result [read $rfd]
lappend result [eof $rfd]
@@ -8756,7 +8755,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
close $wfd
close $rfd
removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]
} -result [list 1 1 more\xA0data 1]
test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
+2 -2
View File
@@ -494,14 +494,14 @@ test iocmd-12.10 {POSIX open access modes: BINARY} {
} 5
test iocmd-12.11 {POSIX open access modes: BINARY} {
set f [open $path(test1) {WRONLY BINARY TRUNC}]
puts $f \u0248 ;# gets truncated to \u0048
puts $f Ɉ ;# gets truncated to H
close $f
set f [open $path(test1) r]
fconfigure $f -translation binary
set result [read -nonewline $f]
close $f
set result
} \u0048
} H
test iocmd-13.1 {errors in open command} {
list [catch {open} msg] $msg
+7 -7
View File
@@ -45,23 +45,23 @@ test list-1.24 {basic tests} {list} {}
test list-1.25 {basic tests} {list # #} {{#} #}
test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
test list-1.27 {basic null treatment} {
set l [list "" "\0" "\0\0"]
set e "{} \0 \0\0"
set l [list "" "\x00" "\x00\x00"]
set e "{} \x00 \x00\x00"
string equal $l $e
} 1
test list-1.28 {basic null treatment} {
set result "\0a\0b"
set result "\x00a\x00b"
list $result [string length $result]
} "\0a\0b 4"
} "\x00a\x00b 4"
test list-1.29 {basic null treatment} {
set result "\0a\0b"
set result "\x00a\x00b"
set srep "$result 4"
set lrep [list $result [string length $result]]
string equal $srep $lrep
} 1
test list-1.30 {basic null treatment} {
set l [list "\0abc" "xyz"]
set e "\0abc xyz"
set l [list "\x00abc" "xyz"]
set e "\x00abc xyz"
string equal $l $e
} 1

Some files were not shown because too many files have changed in this diff Show More