Compare commits

...
Author SHA1 Message Date
dkf c1c94e4437 [86d249bcba] Make sure that tcltest::runAllTests actually returns 1 on failure 2018-11-07 18:50:09 +00:00
jan.nijtmans bea160e7f6 Start building this branch with Travis. See how far we get 2018-11-01 20:18:12 +00:00
dgp a0c7ff582a Eliminate fallback attempts when broken strtod() routines are detected.
This has long been creating more problems than it solves.
2018-11-01 14:46:07 +00:00
jan.nijtmans b3dceb5360 Make MacOSX compile work (hopefully) and cross-compile on mingw-w64 (compile only, no unit-test yet) 2018-10-31 21:02:42 +00:00
jan.nijtmans 4c1c62892a Merge 8.5 2018-10-30 20:41:01 +00:00
jan.nijtmans 434a115a3c Add support for DragonFly 2018-10-30 20:40:03 +00:00
jan.nijtmans 74707353e8 Add support for TIP #494 to registry and dde. Only effective when compiled against Tcl 9.0 headers. This way we can keep the source-code for those extensions 100% equal in all branches.
Work-around for gcc warning in tclWinFile.c. Discovered by Travis CI.
2018-10-30 20:39:24 +00:00
jan.nijtmans 538c6791ab merge-mark 2018-10-29 19:55:50 +00:00
jan.nijtmans 22a5d73ebf squelch some warnings on higher Visual Studio versions: we are not going to bother on this any more. 2018-10-29 19:54:58 +00:00
dgp ce6023fade [TIP 525] Backport package tcltest 2.5 2018-10-29 14:38:24 +00:00
dgp 4e9742386c merge mark 2018-10-29 14:10:33 +00:00
dgp 030a749dc8 close fork 2018-10-29 14:09:34 +00:00
dgp 2f4c1aecdb [TIP 525] Backport package tcltest 2.5 2018-10-29 14:00:48 +00:00
jan.nijtmans 1ff54c600e merge-mark 2018-10-28 10:07:04 +00:00
jan.nijtmans 1337738c22 Merge (on-purpose) fork, makeing the merge-mark easier 2018-10-28 10:05:42 +00:00
jan.nijtmans 96b9e6e871 Missing -DUNICODE in makefile.vc 2018-10-28 10:04:08 +00:00
jan.nijtmans 52c009322f put back Travis CI build. All merge-marks of previous commit change done. 2018-10-27 19:52:25 +00:00
jan.nijtmans 016dc0c5f0 merge-mark... well ... almost: Except for a missing <include> in tclWinDde.c 2018-10-27 19:43:31 +00:00
jan.nijtmans 97ed5b117d (temporary) backout [0386db909a]: Enable CI builds with Travis. This enables everything else to merge-marked to 8.6. Will put it back in the next commit 2018-10-27 19:36:22 +00:00
jan.nijtmans fbc8feeb40 Backport various minor issues from 8.6:
- gcc compiler warning in tclDate.c
- protect Tcl_UtfToUniCharDString() from ever reading more than "length" bytes from its input, not even in the case of invalid UTF-8. 
- update to latest tzdata
- fix 2 failing test-cases on MacOSX
2018-10-27 19:33:40 +00:00
José Ignacio Marín 5f392f74b6 Update TZ info to tzdata2018g. 2018-10-27 18:07:35 +00:00
jan.nijtmans fef802ea7a Update to latest tzdata (backported from 8.6) 2018-10-27 08:06:42 +00:00
jan.nijtmans d7a697aa50 Missed some version bumps in previous commit 2018-10-27 08:03:56 +00:00
jan.nijtmans 9654f8c692 tclWinDde.c: Backport version 1.4.1 from Tcl 8.6. 2018-10-27 07:53:45 +00:00
jan.nijtmans 125b29bfe3 tclWinReg.c: Code cleanup. Eliminate some unnecessary variables.
tclWinDde.c: Backport improvements (support for TCL_UTF_MAX=6) from androwish: Both androwish and tclsh (all versions) can now use the same dde.dll.
dde: bump version
2018-10-26 18:41:35 +00:00
jan.nijtmans c69ccc749e Backport "registry" version 1.3.3, so all active branches now have the same registry version.
(this commit must -eventually- be merge-marked to core-8-6-branch, since everything is there already)
2018-10-24 21:22:18 +00:00
dkf 983b95bdbd Enable CI builds with Travis. 2018-10-23 11:14:13 +00:00
jan.nijtmans 49cd80a29d Fix "registry" test-cases. Thanks to Harald Oehlmann for spotting this! 2018-10-22 17:48:40 +00:00
dkf c201290179 Expand the build matrix 2018-10-22 13:11:45 +00:00
dkf 0c78f5bbad Disable windows builds. Make test failures fatal. 2018-10-21 10:16:05 +00:00
dkf 2e0a0b5305 Remove old README 2018-10-20 18:02:45 +00:00
dkf 1caba8a761 Add local links 2018-10-20 16:47:29 +00:00
dkf 6efd8f71f2 formatting tweak 2018-10-20 16:44:51 +00:00
dkf e5cf3448bd formatting tweak 2018-10-20 12:54:28 +00:00
dkf ea29292705 formatting fix 2018-10-20 12:01:49 +00:00
dkf d32d625787 Travis CI build 2018-10-20 11:57:59 +00:00
jan.nijtmans 49aba3d99e Add support for "nostub" in genStubs.tcl. Not used by Tcl 8.6, but might be used by Tk 8.7 when linked against Tcl 8.6 2018-10-19 15:51:36 +00:00
dkf 09446c7544 Added another test case. This one is OK. 2018-10-19 09:59:14 +00:00
dkf 8a4ad6884b Make the object mutation operation as unrestricted as possible. 2018-10-18 21:40:17 +00:00
dkf 2021349249 Make fundamental mutation work. MAGICAL MAGIC MAGICS MAGIC. Abracadabra. 2018-10-18 21:38:08 +00:00
José Ignacio Marín 6b0dccd9d5 Update TZ info to tzdata2018f. 2018-10-18 18:23:50 +00:00
dkf e006418946 Tests for advanced object mutation issues. 2018-10-18 14:58:28 +00:00
jan.nijtmans 2881b5c3df Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the correct answer then.
Also backport genStubs.tcl from 8.7: The "deprecated" mark is not used in Tcl 8.6, but it is used by Tk 8.7 when doing "make genstubs" against Tcl 8.6.
2018-10-17 19:55:17 +00:00
jan.nijtmans e0209e39ea Fix test-cases running on Windows 10: [string index $tcl_platform(osVersion) 0] doesn't give the correct answer then (it gives "1", but "10" was expected) 2018-10-17 19:51:47 +00:00
dgp e1196c53f2 Revert addition of "slowTest" as built-in constraint. (no TIP; no version bump).
Let the test file that needs the constraint define it with existing facilities.
2018-10-17 16:12:42 +00:00
dgp 56b431c4c2 Mark test macOSXFCmf-2.8 non-portable. It appears to pass when the older
HFS+ filesystem is in use, often on disk drives in older systems. It appears
to fail when APFS is in use, more typical on newer SSD storage.
2018-10-17 16:06:38 +00:00
dgp ac4291f473 Backport test fix. 2018-10-17 16:03:54 +00:00
dgp bbdb1f12a0 Use the 4 argument form of [makeFile]. 2018-10-09 18:24:57 +00:00
dkf f9a4d9f781 Balance the [makeFile/makeDirectory] and [removeFile/removeDirectory] calls (conditional now, so avoids warnings in filter/constraint cases). 2018-10-09 17:55:20 +00:00
sebres 1a664df87f Balance the [makeFile/makeDirectory] and [removeFile/removeDirectory] calls (conditional now, so avoids warnings in filter/constraint cases). 2018-10-09 16:59:13 +00:00
jan.nijtmans cc4dae5c0f Streamline: Tcl_WinTCharToUtf/Tcl_WinUtfToTChar(): Always initialize DString, and let it return NULL when imput is NULL. That's what seem to assume the callers. 2018-10-07 20:26:33 +00:00
jan.nijtmans 8985ee2114 Better implementations of Tcl_WinTCharToUtf() and Tcl_WinUtfToTChar(). They don't make any assumption on whether encodings are initialized, or specific win32 handling of special characters. 2018-10-05 20:54:59 +00:00
jan.nijtmans 85aac3aef7 Fix wrong usage of Tcl_WinTCharToUtf() contract: nativePath should never be NULL, but actually it can be. 2018-10-05 19:37:38 +00:00
dgp c3c71b5f3c Post-TIP 505 editing of [lreplace] documentation. 2018-10-05 17:20:40 +00:00
jan.nijtmans 9feb8b7c29 In registry, protect "keyName" from being NULL: This actually can lead to crashed (I experienced this ...). Update version to 1.3.3, and align implementation in all branches (core-8-6-branch and higher) 2018-10-04 19:22:37 +00:00
jan.nijtmans 50a1375461 Tcl_UniCharToUtfDString: Don't allocate too much memory for this function.
Tcl_UtfToUniCharDString: Don't allocate too much memory for this function. And make sure that we never access more than 'length' bytes from the string, not even when encountering invalid UTF-8.
2018-10-03 19:24:13 +00:00
jan.nijtmans 3d5f129cb0 Another patch contributed by Gustaf Neumann: shifting negative numbers is undefined behavior in the C standard
https://stackoverflow.com/questions/8415895/is-left-and-right-shifting-negative-integers-defined-behavior
2018-09-28 18:45:34 +00:00
dkf 6cdb3193ec Implementation of TIP 505: Make [lreplace] Accept All Out-of-Range Index Values 2018-09-27 08:19:18 +00:00
dkf bf46b6a1da Updated documentation 2018-09-27 07:44:50 +00:00
jan.nijtmans d5583552c0 Contributed patch from Gustaf Neumann, preventing problems where "localCachePtr" can be NULL 2018-09-25 21:16:32 +00:00
dgp 338b9ec9d2 Silence debugging message in test suite. 2018-09-24 16:15:25 +00:00
jan.nijtmans 6d3aeef45e Give lambda function a name "ReceiveChunked" for easier testing. New function quoteString and code cleanup 2018-09-23 13:27:14 +00:00
jan.nijtmans 63ef0e3d26 Update http version number, and fix some related test-cases 2018-09-22 10:20:28 +00:00
kjnash 39318d91b7 merge bug-46b6edad51-concurrent-http 2018-09-20 13:41:13 +00:00
kjnash d24a3eb2ba merge 8.6 2018-09-15 18:41:23 +00:00
dgp cdce5491b3 Rebase TIP 505 implementation a patch for 8.6. 2018-09-10 15:28:23 +00:00
sebres 9a15a1b586 small code review (duplicate code removed) 2018-09-07 14:24:49 +00:00
dgp 95db69f27b Added test for [631b4c45df]. 2018-09-07 12:04:32 +00:00
sebres e80eaec4d3 amend to [e8ab4d85fa], proc.test: extended with new test-case to cover situation like [631b4c45df] 2018-09-07 11:55:01 +00:00
sebres b9577c0641 closes [631b4c45df]: segfault by usage of wrong length (no string representation) 2018-09-07 10:45:30 +00:00
sebres cb9f3f9268 merge 8.5 2018-08-30 11:13:09 +00:00
sebres 6d88b01d1e test-cases to cover quoting of the newline character, and the documentation extended. 2018-08-30 11:08:51 +00:00
sebres 77a26f5c95 merge 8.5 2018-08-29 16:59:10 +00:00
sebres 9cec6bac27 tcltest: forgotten built-in constraint "slowTest" 2018-08-29 16:58:06 +00:00
sebres 2f19b0f346 small amend to [cae24931ed] (no _CRT_glob in both cases __GNUC__ || TCL_BROKEN_MAINARGS). 2018-08-29 16:55:36 +00:00
sebres 265c9d416f partially cherry-picking of [5099a81b50], never reached 8.6, so for example build for MINGW breaks tests winpipe-8.1 etc, because "*" will be expanded. 2018-08-29 15:55:13 +00:00
sebres db610f91eb code review after merge with 8.5 (restore usage of some functions, after lost by conflict resolving) 2018-08-29 15:49:19 +00:00
sebres afb5bf5583 merge 8.5 ([21b0629c81] 0-day vulnerability - insufficient escape by exec of batch-files for windows) 2018-08-29 15:41:55 +00:00
sebres 9b7ce068fe closes [21b0629c81] 0-day vulnerability - insufficient escape by exec of batch-files for windows 2018-08-29 14:45:57 +00:00
sebres 820a737a2f code review, skip slow test winpipe-8.2 executed args from injectList particularly (normally winpipe-8.3 covers the same but jointly), to enable use parameter -constraints slowTest, added new test with randomly generated potentially dangerous args 2018-08-23 10:26:03 +00:00
sebres c2d61d8dbc code review, restored backwards compatibility of the simplest escape of quote-chars (so reverted several tests winpipe-7.x) 2018-08-23 08:00:32 +00:00
sebres fb0bf9d1b9 fixes escape for special cases (+ more test-cases):
- `%` char to be escaped (quoted) in any case (regardless pairing flag), otherwise `%username%` will be interpolated as username.
- escape of multiple backslashes before quote is different (as without following quote) in unpaired quote syntax (upaired flag set)
2018-08-21 18:52:21 +00:00
sebres 01dd016ad8 because executable (1st argument) always proper escaped now, don't need to replace long path name of batch-executable with short path name (reduced to 16-bit applications only). 2018-08-20 19:58:44 +00:00
sebres d660b325b5 small amend: avoid reset of unpaired quote flag between arguments (previous affects next) + test cases extended with several injection checks. 2018-08-20 16:15:37 +00:00
sebres 26b477b907 win: fixes [21b0629c81] - exec/open process pipe under windows (0-day vulnerability - insufficient escape) 2018-08-20 14:35:44 +00:00
jan.nijtmans 89ff80fbdd merge-mark 2018-08-19 09:16:30 +00:00
jan.nijtmans 90afac281e Minor fix to entier(): Allow it to convert to "wideInt" as well when range is appropriate 2018-08-17 22:15:49 +00:00
sebres aed158b518 win: TclpCreateProcess or [exec process ...] - search for application extended with ".cmd" extension:
automatically tries appending ".com", ".exe", ".bat" and ".cmd", in that order, to the name, looking for an executable.
(partially cherry-picked from 8.6 branch)
2018-08-17 18:26:10 +00:00
dgp 6c78bf0adc Repair breakage in recent refactoring of env.test 2018-08-08 20:48:06 +00:00
jan.nijtmans 8346cad0dd Fix harmless gcc warning 2018-08-08 06:45:29 +00:00
sebres de5637f853 ioTrans.test: fixed cleanup - avoids error deleting "tempchanfile": permission denied: file seems to be locked/opened inside interp $idb 2018-08-03 13:46:30 +00:00
jan.nijtmans c1ae69114b Remove some actually dead code 2018-07-31 19:49:51 +00:00
sebres 5902889825 amend after merge: 8.6th provide additionally an error-code (so missing errCode = "OVERFLOW") 2018-07-26 18:56:41 +00:00
sebres 04c687936c merge 8.5 - bug [d051b77fc1] fixed 2018-07-26 18:51:03 +00:00
sebres 2133e40e58 amend to [d498578df4], still one test for [Bug ba921a8d98] with inplace by subst inside string (compiled as "strcat" instruction) 2018-07-26 18:07:34 +00:00
sebres c7cdc550c4 test cases added to cover width overflow by format (should cause limit exceeded) 2018-07-26 16:46:47 +00:00
sebres 7e727bed70 closes [d051b77fc18d7340]: fixed segfault by integer overflow (if width by format like "%4000000000g" overflows to negative values by scan of length) 2018-07-26 15:57:38 +00:00
dgp 164a7f04c0 New test for [Bug ba921a8d98]. 2018-07-26 15:51:28 +00:00
Kevin B Kenny 814c867db4 Add a note in the 'clock' man page about the interpretation of impossible values on [clock scan] 2018-07-21 18:45:09 +00:00
sebres d00a212e82 win: avoids warning by x64-build in function 'TclWinCPUID' - pointer targets in passing argument 1 of '__cpuid' differ in signedness [-Wpointer-sign] (int* vs unsigned int*) 2018-07-20 15:58:56 +00:00
sebres 7fb72851e8 win: fixes x64-build within gcc-compile runtime env for (mingw64, etc): "$do64bit" may be "amd64|x64|yes", so it could find & copy wrong zlib.dll. 2018-07-20 15:54:11 +00:00
sebres 4a3f32b84a win: fixed test-cases (see [525ccacaef]) running under windows outside of temp-folder 2018-07-16 13:59:29 +00:00
sebres a1790a1683 merge 8.5 2018-07-12 14:25:09 +00:00
sebres 885a163b3c win: closes [3f7af0e21e13f1f5] - avoid "permissions denied" by file delete, if file stat (TclpObjStat) used internally in other worker, for example by usage of file mkdir etc. 2018-07-12 14:17:57 +00:00
sebres 2a46a48670 merge 8.5 2018-07-09 18:15:34 +00:00
sebres 51aecf205d closes [270f78ca95b642fb]: fix the race condition for file mkdir if some worker deletes directory immediately after the succeded create inside 3rd worker. 2018-07-09 17:18:07 +00:00
jan.nijtmans 367ce9ad48 tclDictObj.c:366: warning: dereferencing type-punned pointer will break strict-aliasing rules
Prevent this warning, which gcc 4.4 (a.o.) gives on this construct. void pointers work well already in whatever assignment.
2018-07-05 19:39:19 +00:00
dgp 9da2aebeae Use a thread exit handler, and not a custom exit proc for package cleanup. 2018-06-26 17:00:29 +00:00
dgp ed5ed756bc Restore lost tests. 2018-06-26 14:22:08 +00:00
jan.nijtmans 0839047d8b Simplify ToUtf(), expecially for TCL_UTF_MAX>3 (with correct surrogate handling).
Fix various typo's
2018-06-25 07:22:19 +00:00
pooryorick e2a79c2604 Fix for [3592747]: Let TclNRTailcallEval handle namespace problems. 2018-06-24 07:17:46 +00:00
pooryorick 6cbfdcc4a3 Add a test for no generation of a string representation when comparing with the
empty string.
2018-06-23 14:18:06 +00:00
pooryorick 94ec3d9431 Add another suppress rule for valgrind, factor test code into
tests/tcltests.tcl, and constrained a some tests in the valgrind case.
2018-06-22 15:10:04 +00:00
pooryorick 6c1e9f2b0c merge pyk-tcltest-exit 2018-06-21 22:44:04 +00:00
pooryorick 563bd6e4dd Fix function signature of TclThreadTestFinalize. 2018-06-21 22:43:18 +00:00
pooryorick b418ff1759 merge pyk-tcltest-exit 2018-06-21 22:23:04 +00:00
pooryorick 56ca35e8a9 Add custom exit procedure for tcltests executable. 2018-06-21 22:21:31 +00:00
pooryorick 107fb1eb33 Suppress more valgrind "still reachable" reports and ensure that threads are
fully finalized in thread tests.
2018-06-21 22:16:29 +00:00
pooryorick c911dc937f Add valgrind suppression for dlopen and ensure that processes are reaped in
http11.test.
2018-06-20 19:06:40 +00:00
pooryorick 645241afc1 Remove recent auto_path modification in tests/all.tcl and suppress more
valgrind reports.
2018-06-20 08:03:22 +00:00
pooryorick 03a3c09b1f new file: tools/valgrind_suppress. num-callers bumped from 8 to 24. Valgrind
now issues no "still reachable" reports for cmdAH.test.
2018-06-19 11:47:08 +00:00
jan.nijtmans 3c57d80efe Fix [53cad613d8]: TIP 389 implementation makes Tk tests font-4.12 and font-4.15 fail. One more situation in which high surrogate causes problem 2018-06-18 15:54:38 +00:00
jan.nijtmans 04004f3abc Unbreak build on Windows (and - most likely - some other platforms too) 2018-06-18 15:51:43 +00:00
pooryorick 155e8a1ad5 Avoid valgrind "still reachable" reports stemming from early termination of
threads.
2018-06-18 08:09:32 +00:00
pooryorick 625aca976a Full cleanup of env cache when in a PURIFY build. 2018-06-18 07:06:04 +00:00
pooryorick e9c0ec1219 Plug leak in TclSetEnv. 2018-06-18 05:59:22 +00:00
jan.nijtmans 8047a470ef Fix [53cad613d8a4de166e680f09a6c6399ebddbc17c|53cad613d8]: TIP 389 implementation makes Tk tests font-4.12 and font-4.15 fail. (Fix it in 8.6 too, for benefit of androwish) 2018-06-17 16:07:09 +00:00
pooryorick 2b739c838a Remove dependencies between tests in env.test. 2018-06-17 08:47:29 +00:00
pooryorick 983854ad7b Add tests/tcltests.tcl as a place to store common code for tests. 2018-06-16 22:56:07 +00:00
pooryorick 41a6159754 new package
tcltests
exclude some exec.test tests when running under valgrind
2018-06-16 17:55:31 +00:00
jan.nijtmans df97278634 merge 8.5 2018-06-15 18:35:56 +00:00
jan.nijtmans 06fc5fb636 Align common install locations in SC_PATH_TCLCONFIG and SC_PATH_TKCONFIG. Add FreeBSD (closes [d6d60efd35]) and OpenBSD 8.5 paths 2018-06-15 18:31:24 +00:00
dgp e393000b1d merge 8.5 2018-06-13 16:06:38 +00:00
dgp 83d92bd747 Stop creating a stray child process. 2018-06-13 15:59:15 +00:00
dgp 5a05e0d782 merge 8.5 2018-06-12 17:53:19 +00:00
dgp 9c8f784329 [860a9f1945] Remove test safe-8.8; Mac OS 9 tests are no longer useful. 2018-06-12 17:10:03 +00:00
jan.nijtmans 1efbaebb6a Merge 8.5 (= update Unicode data to Unicode version 11.0) 2018-06-09 07:44:33 +00:00
jan.nijtmans ac47e6953d Update all Unicode tables to Unicode version 11.0 2018-06-09 07:42:42 +00:00
jan.nijtmans 400feb302b Update to latest tzdata (backported from 8.6) 2018-06-09 07:41:47 +00:00
sebres 9c9b3d93f9 merge 8.5 (empty merge point, no functional changes, because does not affect 8.6) 2018-06-08 13:02:59 +00:00
sebres 04d1270786 resolves some warnings by compiling with new gcc-versions (>= 7.x):
- '*' in boolean context, suggest '&&' instead [-Wint-in-bool-context]
  - passing argument 1 of 'Tcl_CreateExitHandler' from incompatible pointer type [-Wincompatible-pointer-types]
2018-06-08 12:50:43 +00:00
sebres b89a3efc56 merge 8.5 2018-06-04 13:52:19 +00:00
sebres 240e6b50d2 fixes [92564326a9] if compiled on some x86 systems (with dirent64 but without DIR64, partially cherry-picked from https://www.androwish.org/index.html/info/6119b8ac2aee8411). 2018-06-04 13:49:38 +00:00
kjnash 754bb107b4 Bugfix - always cleanup persistent socket. 2018-06-01 18:34:07 +00:00
sebres a2ce3dab9b merge 8.5 2018-05-28 13:17:18 +00:00
sebres 6a4d06759e win: searching for FQDN in user-name should be utf-8 safe (user-name could contain non-ascii utf-8 chars) 2018-05-28 13:13:39 +00:00
sebres 6966f0a2b1 merge 8.5 (conflicts resolved, rewritten without winapi-stubs) 2018-05-28 12:26:20 +00:00
sebres 89a84af271 merge-integrate sebres-bug-9e6b569963-8-5-branch to 8.5 2018-05-28 12:05:15 +00:00
sebres 5e7a1545a6 minor indentation fix (no functional changes) 2018-05-25 15:51:23 +00:00
sebres f4651a5660 avoid dual init of stubs (possible race condition, 8.5th only) 2018-05-25 15:48:50 +00:00
sebres a0290b85c5 optimized winapi-stubs loading (8.5th only); if user name specified without domain and equals the current user - try safest and fastest way to get current user-home path (without usage of netapi) 2018-05-25 15:04:27 +00:00
sebres 8145564d30 merge/reintegrate test-cases from bug-9e6b569963 2018-05-25 10:04:01 +00:00
fvogel 6d943ef7b5 Remove test filesystem-1.30.3, this is unstestable 2018-05-24 20:51:45 +00:00
sebres 1c13d543f4 [9e6b569963] win: if user specified without domain (and local user was not found), try to resolve user-home using current domain, so following code's are similar:
file normalize ~$::tcl_platform(user)@$::env(USERDOMAIN)
  file normalize ~$::tcl_platform(user)
2018-05-24 20:49:12 +00:00
sebres 263de53394 merge 8.5, conflicts resolved (rewritten without winapi-stubs) 2018-05-24 20:36:32 +00:00
sebres a410c0d8d5 fixed typo in winFCmd-12.6.2: unneeded extra-bracket removed 2018-05-24 20:20:26 +00:00
sebres ecec1703aa win: TclpGetUserHome should return normalized path (also in case we find domain and NetUserGetInfo returns path), PoC:
file normalize ~$::tcl_platform(user)@$::env(USERDOMAIN)
2018-05-24 20:12:43 +00:00
fvogel 36a1a69178 Add support for ~domain\user style user names, with new test test filesystem-1.30.3. Warning: does not yet work. 2018-05-23 21:08:01 +00:00
fvogel dffe6bc7f1 Add test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} 2018-05-19 07:10:43 +00:00
fvogel 423f761169 Fix [9e6b569963]: file normalize ~user fails on Windows 2018-05-18 19:54:56 +00:00
fvogel ba42e43e97 Add test filesystem-1.30.1 checking file normalize ~$::tcl_platform(user). This test should currently fail when the computer is connected to a Windows domain controller, due to [9e6b569963]: file normalize ~user fails on Windows 2018-05-18 06:18:56 +00:00
jan.nijtmans 7672af7212 merge 8.5 2018-05-14 19:16:24 +00:00
jan.nijtmans eae621b175 Unbreak build when HAVE_FTS is not set.
Move definitions of Tcl_DirEntry and TclDIR to tclWinPort.h, where it actually belongs
2018-05-14 19:14:40 +00:00
jan.nijtmans 6d0cc0c589 Merge 8.5. This adds Emoji 11.0 support, when Tcl is compiled with TCL_UTF_MAX>3. Useful for Androwish, for example. 2018-05-11 09:20:59 +00:00
jan.nijtmans d9bc6cbae2 Add emoji 11.0 to the set. Only active when compiled with TCL_UTF_MAX>3. Also prepare tooling for Unicode 11.0 (while being on it) 2018-05-11 09:14:42 +00:00
jan.nijtmans ede72e80ac merge 8.5 2018-05-11 08:10:17 +00:00
jan.nijtmans 7bf3f83abd Rename Tcl_Dir to TclDIR, making it clear that this macro is not part of the public API 2018-05-11 07:53:20 +00:00
sebres f7f4cbb151 merge 8.5 2018-05-09 10:34:44 +00:00
sebres f5e8751307 amend to [85bcf84100]: replaces DIR with Tcl_Dir (DIR/DIR64 regarding HAVE_STRUCT_DIRENT64) 2018-05-09 10:29:33 +00:00
sebres 47e9dbdc37 prevents UB/segfault by unexpected return-code (not -1/0/1) and avoid warnings like:
tclCmdMZ.c:2815:15: warning: `s1` may be used uninitialized in this function [-Wmaybe-uninitialized]
  s1len = Tcl_NumUtfChars(s1, s1len);
          ^~~~~~~~~~~~~~~~~~~~~~~~~~
2018-05-08 10:16:26 +00:00
sebres 8fd1568405 merge fix for [92564326a98b5510] from 8.5 2018-05-08 09:56:35 +00:00
sebres 78ee8c697e fixes [92564326a98b5510]: wrong x64-aligned handle from readdir64 by opendir/rewinddir/closedir, if HAVE_STRUCT_DIRENT64 used. 2018-05-08 09:49:16 +00:00
pooryorick 5f0cf291f5 Deduplicate code in INST_STR_CMP, StringCmpCmd, and StringEqualCmd. 2018-05-07 07:43:00 +00:00
pooryorick db133f0144 Factor options handling out of StringCmpCmd. 2018-05-06 18:13:54 +00:00
pooryorick 86c6a11cdb Preparation to deduplicate code between byte-compiled and legacy
implementations of [string compare].
2018-05-06 13:45:21 +00:00
pooryorick e383cd7b26 Avoid generating string representation when comparing the empty string. 2018-05-05 17:04:08 +00:00
pooryorick 3a3fd2954f Avoid generating string representation when comparing the empty string. 2018-05-05 16:38:27 +00:00
kjnash 227db01958 Restore production test settings: set tests/httpPipeline.test to non-verbose, and comment out most Log calls in library/http/http.tcl 2018-04-21 14:22:35 +00:00
kjnash 41954059c4 merge 8.6 2018-04-21 13:47:09 +00:00
kjnash b169c964e6 Amend httpPipeline.test tests to use stdout not stderr, and thus avoid the report {Test files exiting with errors} even when all tests pass. 2018-04-21 13:31:16 +00:00
kjnash 3771e638b0 Document the new proc http::registerError in http.n 2018-04-20 20:06:30 +00:00
kjnash 4588d7300e Restore Tcl 8+4 tab convention 2018-04-13 15:48:13 +00:00
kjnash d690b84738 Improve detection and reporting of TLS errors. New command http::registerError to assist the latter. Ensure that http::cleanup cancels any timeout event if not already done. Add comments on non-blocking read/gets. 2018-04-13 15:41:00 +00:00
kjnash 6bc8c27b7f Restore most lines to 80 columns 2018-04-04 13:37:37 +00:00
kjnash 6a58a0cab2 Use coroutines to remove blocking on HTTP connections 2018-04-04 12:00:03 +00:00
kjnash 1357172367 Increase test timeout to 10s. Remove commenting from Log calls that report long delay for [socket]. 2018-04-01 01:09:57 +00:00
kjnash 466fd1d930 Chasing timeout bug: reduce client timeout to 4s in tests; more sanity checking in non-keep-alive tests; tidying; more logging in http.tcl. 2018-03-31 15:27:52 +00:00
kjnash 441e4f6796 For thorough testing, set test file to verbose, and uncomment Log calls in http.tcl. 2018-03-30 10:13:57 +00:00
kjnash 3117af219f Bugfixes. Details in ticket 46b6edad51. 2018-03-30 10:02:44 +00:00
kjnash a0e1b18138 Adapt tests/httpPipeline.test for test without installation. Comment out some Log calls from tests/httpTestScript.tcl 2018-03-29 18:20:56 +00:00
kjnash 70af5c2b82 Implement queuing and pipelining for HTTP requests over a persistent connection. 2018-03-27 14:20:23 +00:00
kjnash d38ae8f974 Adapt fconfigure -translation for two-way pipelined operation. 2018-03-27 08:56:16 +00:00
kjnash 0d887fa465 Define variable tk used in Log calls for testing. 2018-03-27 08:55:21 +00:00
kjnash e9bb0992b0 First step for implementing concurrent requests using the same connection. Define namespace variables socket* and http where they will (eventually) be used. Leave them unused except in http::init where they are initialised. 2018-03-27 08:52:40 +00:00
kjnash f35c0dc2ed Revise tests/http11.test for use with commits from 78b23edb6b onwards. Adjust proc "handler" to conform to http(n) 2018-03-27 08:49:13 +00:00
kjnash e80e214673 BUGFIX. Send "Connection: keep-alive" even if HTTP/1.1. Some servers (including Apache 2.2 on RHEL6) use the discretion granted by RFCs and will close the connection unless this header is sent. 2018-03-27 08:37:06 +00:00
kjnash 731f40c6d9 New http::config option -zip to control whether to send an "Accept-Encoding" request-header for a zipped response. Default true for backward compatibility. 2018-03-27 08:32:37 +00:00
kjnash 767cf6314a Workaround for bug with https and unchunked response. A [read] does not deliver until the server closes the socket. The workaround is to specify the buffer size as the precise length required. 2018-03-27 08:29:43 +00:00
kjnash b00317d174 Changes to response handling in Finish, Eot and Event. Carefully distinguish expected and premature eof. Stricter handling of errors, minor bugfixes. Details in ticket 46b6edad51. 2018-03-27 08:25:14 +00:00
kjnash a8408767a4 Add "array unset socketMapping" in http::init. The sockets are closed and therefore do not belong in socketMapping, which should be unset. 2018-03-27 08:20:14 +00:00
kjnash 4f8b177250 Tidying - add empty else clauses, omit :: at start of command name http::CloseSocket in proc definition, use two lines instead of "return [Finish ...]" because there is no return value! 2018-03-27 08:17:38 +00:00
kjnash 25aad1ab18 Update some Log calls, mainly to specify token. 2018-03-27 08:15:26 +00:00
kjnash 3b48db4a90 Update some comments and a Log. 2018-03-27 08:12:47 +00:00
kjnash 58eff8f224 Rename some variables and commands. Details in ticket 46b6edad51. 2018-03-27 08:10:50 +00:00
kjnash 97721e9675 Add parentheses to some "if" tests; transform one test without changing its outcome. 2018-03-27 08:08:19 +00:00
kjnash d88d33f74d Give all procs an explicit return, except where commented as "Implicit Return". 2018-03-27 08:07:05 +00:00
kjnash 0a9706f48f Adjust to 80 columns except one 82-column line which would be less intelligible. 2018-03-27 08:05:42 +00:00
kjnash 45f91441a5 Adjust whitespace to Tcl 8+4 tab convention. 2018-03-27 08:03:58 +00:00
kjnash 38781266d3 Create new branch named "bug-46b6edad51-concurrent-http" 2018-03-27 07:48:33 +00:00
dgp 843d29b448 Rest of TIP 505 implementation -- mostly undoing dumb things. 2018-03-26 18:59:00 +00:00
dgp 1a73baff09 Work in progress implementing TIP 505. 2018-03-26 16:27:40 +00:00
124 changed files with 8359 additions and 4390 deletions
+145
View File
@@ -0,0 +1,145 @@
dist: trusty
sudo: false
language: c
matrix:
include:
- os: linux
compiler: clang
env:
- MATRIX_EVAL=""
- BUILD_DIR=unix
- os: linux
compiler: clang
env:
- MATRIX_EVAL=""
- BUILD_DIR=unix
- CFGOPT=--disable-shared
- os: linux
compiler: gcc
env:
- MATRIX_EVAL=""
- BUILD_DIR=unix
- os: linux
compiler: gcc
env:
- MATRIX_EVAL=""
- BUILD_DIR=unix
- CFGOPT=--disable-shared
- os: linux
compiler: gcc
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-4.9
env:
- MATRIX_EVAL="CC=gcc-4.9"
- BUILD_DIR=unix
- os: linux
compiler: gcc
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-5
env:
- MATRIX_EVAL="CC=gcc-5"
- BUILD_DIR=unix
- os: linux
compiler: gcc
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-6
env:
- MATRIX_EVAL="CC=gcc-6"
- BUILD_DIR=unix
- os: linux
compiler: gcc
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-7
env:
- MATRIX_EVAL="CC=gcc-7"
- BUILD_DIR=unix
- os: osx
osx_image: xcode8
env:
- MATRIX_EVAL=""
- BUILD_DIR=unix
- os: osx
osx_image: xcode8
env:
- MATRIX_EVAL=""
- BUILD_DIR=macosx
- NO_DIRECT_CONFIGURE=1
- os: osx
osx_image: xcode9
env:
- MATRIX_EVAL=""
- BUILD_DIR=macosx
- NO_DIRECT_CONFIGURE=1
- os: osx
osx_image: xcode10
env:
- MATRIX_EVAL=""
- BUILD_DIR=macosx
- NO_DIRECT_CONFIGURE=1
# Test with mingw-w64 (32 bit)
- os: linux
compiler: i686-w64-mingw32-gcc
addons:
apt:
packages:
- gcc-mingw-w64-base
- binutils-mingw-w64-i686
- gcc-mingw-w64-i686
- gcc-mingw-w64
- gcc-multilib
- wine
env:
- MATRIX_EVAL=""
- BUILD_DIR=win
- CFGOPT=--host=i686-w64-mingw32
- NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
- os: linux
compiler: x86_64-w64-mingw32-gcc
addons:
apt:
packages:
- gcc-mingw-w64-base
- binutils-mingw-w64-x86-64
- gcc-mingw-w64-x86-64
- gcc-mingw-w64
- wine
env:
- MATRIX_EVAL=""
- BUILD_DIR=win
- CFGOPT=--host=x86_64-w64-mingw32 --enable-64bit
- NO_DIRECT_TEST=1
### C builds not currently supported on Windows instances
# - os: windows
# env:
# - MATRIX_EVAL=""
# - BUILD_DIR=win
before_install:
- if [[ "$TRAVIS_OS_NAME" == "osx" ]]; then rvm get stable; fi
- eval "${MATRIX_EVAL}"
- export ERROR_ON_FAILURES=1
- cd ${BUILD_DIR}
install:
- test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
- make
- test -n "$NO_DIRECT_TEST" || make test
-36
View File
@@ -1,36 +0,0 @@
/*
* fixstrtod.c --
*
* Source code for the "fixstrtod" procedure. This procedure is
* used in place of strtod under Solaris 2.4, in order to fix
* a bug where the "end" pointer gets set incorrectly.
*
* Copyright (c) 1995 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include <stdio.h>
#undef strtod
/*
* Declare strtod explicitly rather than including stdlib.h, since in
* somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
*/
extern double strtod(char *, char **);
double
fixstrtod(
char *string,
char **endPtr)
{
double d;
d = strtod(string, endPtr);
if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
*endPtr -= 1;
}
return d;
}
-1
View File
@@ -29,7 +29,6 @@ extern char * malloc(unsigned int numBytes);
extern void qsort(void *base, int n, int size, int (*compar)(
const void *element1, const void *element2));
extern char * realloc(char *ptr, unsigned int numBytes);
extern double strtod(const char *string, char **endPtr);
extern long strtol(const char *string, char **endPtr, int base);
extern unsigned long strtoul(const char *string, char **endPtr, int base);
-252
View File
@@ -1,252 +0,0 @@
/*
* strtod.c --
*
* Source code for the "strtod" library procedure.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#ifndef NULL
#define NULL 0
#endif
static const int maxExponent = 511; /* Largest possible base 10 exponent. Any
* exponent larger than this will already
* produce underflow or overflow, so there's
* no need to worry about additional digits.
*/
static const double powersOf10[] = { /* Table giving binary powers of 10. Entry */
10., /* is 10^2^i. Used to convert decimal */
100., /* exponents into floating-point numbers. */
1.0e4,
1.0e8,
1.0e16,
1.0e32,
1.0e64,
1.0e128,
1.0e256
};
/*
*----------------------------------------------------------------------
*
* strtod --
*
* This procedure converts a floating-point number from an ASCII
* decimal representation to internal double-precision format.
*
* Results:
* The return value is the double-precision floating-point
* representation of the characters in string. If endPtr isn't
* NULL, then *endPtr is filled in with the address of the
* next character after the last one that was part of the
* floating-point number.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
double
strtod(
const char *string, /* A decimal ASCII floating-point number,
* optionally preceded by white space. Must
* have form "-I.FE-X", where I is the integer
* part of the mantissa, F is the fractional
* part of the mantissa, and X is the
* exponent. Either of the signs may be "+",
* "-", or omitted. Either I or F may be
* omitted, or both. The decimal point isn't
* necessary unless F is present. The "E" may
* actually be an "e". E and X may both be
* omitted (but not just one). */
char **endPtr) /* If non-NULL, store terminating character's
* address here. */
{
int sign, expSign = FALSE;
double fraction, dblExp;
const double *d;
register const char *p;
register int c;
int exp = 0; /* Exponent read from "EX" field. */
int fracExp = 0; /* Exponent that derives from the fractional
* part. Under normal circumstatnces, it is
* the negative of the number of digits in F.
* However, if I is very long, the last digits
* of I get dropped (otherwise a long I with a
* large negative exponent could cause an
* unnecessary overflow on I alone). In this
* case, fracExp is incremented one for each
* dropped digit. */
int mantSize; /* Number of digits in mantissa. */
int decPt; /* Number of mantissa digits BEFORE decimal
* point. */
const char *pExp; /* Temporarily holds location of exponent in
* string. */
/*
* Strip off leading blanks and check for a sign.
*/
p = string;
while (isspace(UCHAR(*p))) {
p += 1;
}
if (*p == '-') {
sign = TRUE;
p += 1;
} else {
if (*p == '+') {
p += 1;
}
sign = FALSE;
}
/*
* Count the number of digits in the mantissa (including the decimal
* point), and also locate the decimal point.
*/
decPt = -1;
for (mantSize = 0; ; mantSize += 1)
{
c = *p;
if (!isdigit(c)) {
if ((c != '.') || (decPt >= 0)) {
break;
}
decPt = mantSize;
}
p += 1;
}
/*
* Now suck up the digits in the mantissa. Use two integers to collect 9
* digits each (this is faster than using floating-point). If the mantissa
* has more than 18 digits, ignore the extras, since they can't affect the
* value anyway.
*/
pExp = p;
p -= mantSize;
if (decPt < 0) {
decPt = mantSize;
} else {
mantSize -= 1; /* One of the digits was the point. */
}
if (mantSize > 18) {
fracExp = decPt - 18;
mantSize = 18;
} else {
fracExp = decPt - mantSize;
}
if (mantSize == 0) {
fraction = 0.0;
p = string;
goto done;
} else {
int frac1, frac2;
frac1 = 0;
for ( ; mantSize > 9; mantSize -= 1) {
c = *p;
p += 1;
if (c == '.') {
c = *p;
p += 1;
}
frac1 = 10*frac1 + (c - '0');
}
frac2 = 0;
for (; mantSize > 0; mantSize -= 1) {
c = *p;
p += 1;
if (c == '.') {
c = *p;
p += 1;
}
frac2 = 10*frac2 + (c - '0');
}
fraction = (1.0e9 * frac1) + frac2;
}
/*
* Skim off the exponent.
*/
p = pExp;
if ((*p == 'E') || (*p == 'e')) {
p += 1;
if (*p == '-') {
expSign = TRUE;
p += 1;
} else {
if (*p == '+') {
p += 1;
}
expSign = FALSE;
}
if (!isdigit(UCHAR(*p))) {
p = pExp;
goto done;
}
while (isdigit(UCHAR(*p))) {
exp = exp * 10 + (*p - '0');
p += 1;
}
}
if (expSign) {
exp = fracExp - exp;
} else {
exp = fracExp + exp;
}
/*
* Generate a floating-point number that represents the exponent. Do this
* by processing the exponent one bit at a time to combine many powers of
* 2 of 10. Then combine the exponent with the fraction.
*/
if (exp < 0) {
expSign = TRUE;
exp = -exp;
} else {
expSign = FALSE;
}
if (exp > maxExponent) {
exp = maxExponent;
errno = ERANGE;
}
dblExp = 1.0;
for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
if (exp & 01) {
dblExp *= *d;
}
}
if (expSign) {
fraction /= dblExp;
} else {
fraction *= dblExp;
}
done:
if (endPtr != NULL) {
*endPtr = (char *) p;
}
if (sign) {
return -fraction;
}
return fraction;
}
+13
View File
@@ -453,6 +453,19 @@ If this situation occurs, the first occurrence of the time is chosen.
(For this reason, it is wise to have the input string contain the
time zone when converting local times. This caveat does not apply to
UTC times.)
.PP
If the interpretation of the groups yields an impossible time because
a field is out of range, enough of that field's unit will be added to
or subtracted from the time to bring it in range. Thus, if attempting to
scan or format day 0 of the month, one day will be subtracted from day
1 of the month, yielding the last day of the previous month.
.PP
If the interpretation of the groups yields an impossible time because
a Daylight Saving Time change skips over that time, or an ambiguous
time because a Daylight Saving Time change skips back so that the clock
observes the given time twice, and no time zone specifier (\fB%z\fR
or \fB%Z\fR) is present in the format, the time is interpreted as
if the clock had not changed.
.SH "FORMAT GROUPS"
.PP
The following format groups are recognized by the \fBclock scan\fR and
+17
View File
@@ -217,6 +217,19 @@ information is instead sent to the console, if one is present, or is
discarded.
.RS
.PP
Note that the current escape resp. quoting of arguments for windows works only
with executables using CommandLineToArgv, CRT-library or similar, as well as
with the windows batch files (excepting the newline, see below).
Although it is the common escape algorithm, but, in fact, the way how the
executable parses the command-line (resp. splits it into single arguments)
is decisive.
.PP
Unfortunately, there is currently no way to supply newline character within
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
(also the argument chain) on the first newline character.
But it works properly with an executable (using CommandLineToArgv, etc).
.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
@@ -409,6 +422,10 @@ that sometimes pop up:
With the file \fIcmp.bat\fR looking something like:
.PP
.CS
@gcc %*
.CE
or like another variant using single parameters:
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.SS "WORKING WITH COMMAND BUILT-INS"
+177 -9
View File
@@ -6,14 +6,14 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.7 http "Tcl Bundled Packages"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http ?2.7?\fR
\fBpackage require http ?2.8?\fR
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config ?\fI\-option value\fR ...?
@@ -22,6 +22,8 @@ http \- Client-side implementation of the HTTP/1.1 protocol
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
\fB::http::quoteString\fR \fIvalue\fR
.sp
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
@@ -44,12 +46,14 @@ http \- Client-side implementation of the HTTP/1.1 protocol
.sp
\fB::http::register \fIproto port command\fR
.sp
\fB::http::registerError \fIport\fR ?\fImessage\fR?
.sp
\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
protocol, as defined in RFC 2616.
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
The package implements the GET, POST, and HEAD operations
of HTTP/1.1. It allows configuration of a proxy host to get through
firewalls. The package is compatible with the \fBSafesock\fR security
@@ -95,6 +99,19 @@ comma-separated list of mime type patterns that you are
willing to receive. For example,
.QW "image/gif, image/jpeg, text/*" .
.TP
\fB\-pipeline\fR \fIboolean\fR
.
Specifies whether HTTP/1.1 transactions on a persistent socket will be
pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default
is 1.
.TP
\fB\-postfresh\fR \fIboolean\fR
.
Specifies whether requests that use the \fBPOST\fR method will always use a
fresh socket, overriding the \fB-keepalive\fR option of
command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details.
The default is 0.
.TP
\fB\-proxyhost\fR \fIhostname\fR
.
The name of the proxy host, if any. If this value is the
@@ -116,20 +133,47 @@ an empty list. The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
\fB\-repost\fR \fIboolean\fR
.
Specifies what to do if a POST request over a persistent connection fails
because the server has half-closed the connection. If boolean \fBtrue\fR, the
request
will be automatically retried; if boolean \fBfalse\fR it will not, and the
application
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
retrying the POST. The value \fBtrue\fR should be used only under certain
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
default is 0.
.TP
\fB\-urlencoding\fR \fIencoding\fR
.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
The default is \fButf-8\fR, as specified by RFC
2718. Prior to http 2.5 this was unspecified, and that behavior can be
returned by specifying the empty string (\fB{}\fR), although
\fIiso8859-1\fR is recommended to restore similar behavior but without the
\fB::http::formatQuery\fR throwing an error processing non-latin-1
characters.
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
throwing an error processing non-latin-1 characters.
.TP
\fB\-useragent\fR \fIstring\fR
.
The value of the User-Agent header in the HTTP request. The default is
.QW "\fBTcl http client package 2.7\fR" .
The value of the User-Agent header in the HTTP request. In an unsafe
interpreter, the default value depends upon the operating system, and
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
A safe interpreter cannot determine its operating system, and so the default
in a safe interpreter is to use a Windows 10 value with the current version
numbers of \fBhttp\fR and \fBTcl\fR.
.TP
\fB\-zip\fR \fIboolean\fR
.
If the value is boolean \fBtrue\fR, then by default requests will send a header
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
In either case the default can be overridden for an individual request by
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
of \fBhttp::geturl\fR. The default is 1.
.RE
.TP
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
@@ -227,7 +271,7 @@ Pragma: no-cache
.TP
\fB\-keepalive\fR \fIboolean\fR
.
If true, attempt to keep the connection open for servicing
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
multiple requests. Default is 0.
.TP
\fB\-method\fR \fItype\fR
@@ -334,6 +378,11 @@ encodes the keys and values, and generates one string that has the
proper & and = separators. The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.
.TP
\fB::http::quoteString\fR \fIvalue\fR
.
This procedure does x-url-encoding of string. It takes a single argument and
encodes it.
.TP
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.
This command resets the HTTP transaction identified by \fItoken\fR, if any.
@@ -415,6 +464,17 @@ set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
.
This procedure allows a registered protocol handler to deliver an error
message for use by \fBhttp\fR. Calling this command does not raise an
error. The command is useful when a registered protocol detects an problem
(for example, an invalid TLS certificate) that will cause an error to
propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a
precise error message rather than a general one. The command returns the
value provided by the last call with argument \fImessage\fR, or the empty
string if no such call has been made.
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
@@ -504,6 +564,14 @@ The following elements of
the array are supported:
.RS
.TP
\fBbinary\fR
.
This is boolean \fBtrue\fR if (after decoding any compression specified
by the
.QW "Content-Encoding"
response header) the HTTP response is binary. It is boolean \fBfalse\fR
if the HTTP response is text.
.TP
\fBbody\fR
.
The contents of the URL. This will be empty if the \fB\-channel\fR
@@ -602,6 +670,106 @@ A copy of the \fBContent-Type\fR meta-data value.
.
The requested URL.
.RE
.SH "PERSISTENT CONNECTIONS"
.PP
.SS "BASICS"
.PP
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
.PP
A persistent connection allows multiple HTTP/1.1 transactions to be
carried over the same TCP connection. Pipelining allows a
client to make multiple requests over a persistent connection without
waiting for each response. The server sends responses in the same order
that the requests were received.
.PP
If a POST request fails to complete, typically user confirmation is
needed before sending the request again. The user may wish to verify
whether the server was modified by the failed POST request, before
sending the same request again.
.PP
A HTTP request will use a persistent socket if the call to
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
pipelining where permitted if the \fBhttp::config\fR option
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
.PP
The http package maintains no more than one persistent connection to each
server (i.e. each value of
.QW "domain:port" ).
If \fBhttp::geturl\fR is called to make a request over a persistent
connection while the connection is busy with another request, the new
request will be held in a queue until the connection is free.
.PP
The http package does not support HTTP/1.0 persistent connections
controlled by the \fBKeep-Alive\fR header.
.SS "SPECIAL CASES"
.PP
This subsection discusses issues related to closure of the
persistent connection by the server, automatic retry of failed requests,
the special treatment necessary for POST requests, and the options for
dealing with these cases.
.PP
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
requests that use the POST method. If a POST uses a persistent
connection and is not the first request on that connection,
\fBhttp::geturl\fR waits until it has received the response for the previous
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
uses a new connection for each POST.
.PP
If the server is processing a number of pipelined requests, and sends a
response header
.QW "\fBConnection: close\fR"
with one of the responses (other than the last), then subsequent responses
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
over a new connection.
.PP
A difficulty arises when a HTTP client sends a request over a persistent
connection that has been idle for a while. The HTTP server may
half-close an apparently idle connection while the client is sending a
request, but before the request arrives at the server: in this case (an
.QW "asynchronous close event" )
the request will fail. The difficulty arises because the client cannot
be certain whether the POST modified the state of the server. For HEAD or
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
the failed request. However, if the request was a POST, RFC 7230 forbids
automatic retry by default, suggesting either user confirmation, or
confirmation by user-agent software that has semantic understanding of
the application. The \fBhttp::config\fR option \fB-repost\fR allows for
either possibility.
.PP
Asynchronous close events can occur only in a short interval of time. The
\fBhttp\fR package monitors each persistent connection for closure by the
server. Upon detection, the connection is also closed at the client end,
and subsequent requests will use a fresh connection.
.PP
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
then it will both try to use an existing persistent connection
(if one is available), and it will send the server a
.QW "\fBConnection: keep-alive\fR"
request header asking to keep the connection open for future requests.
.PP
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
\fB-repost\fR relate to persistent connections.
.PP
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
made
over a persistent connection. POST requests will not be pipelined - if the
POST is not the first transaction on the connection, its request will not
be sent until the previous response has finished. GET and HEAD requests
made after a POST will not be sent until the POST response has been
delivered, and will not be sent if the POST fails.
.PP
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
\fB-keepalive\fR, and always open a fresh connection for a POST request.
.PP
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
that fails because it uses a persistent connection that the server has
half-closed (an
.QW "asynchronous close event" ).
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
\fIThe -repost option should be used only if the application understands
that the retry is appropriate\fR - specifically, the application must know
that if the failed POST successfully modified the state of the server, a repeat POST
would have no adverse effect.
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
+30 -10
View File
@@ -17,7 +17,7 @@ lreplace \- Replace elements in a list with new elements
.BE
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
\fIlist\fR with the \fIelement\fR arguments.
\fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace.
@@ -27,23 +27,26 @@ supporting simple index arithmetic and indices relative to the
end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
.PP
If \fIfirst\fR is less than zero, it is considered to refer to before the
first element of the list. For non-empty lists, the element indicated
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
start of the list.
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
to refer to before the first element of the list. This allows \fBlreplace\fR
to prepend elements to \fIlist\fR.
.VS TIP505
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
index of the last element of the list, it is treated as if it is an
index one greater than the last element. This allows \fBlreplace\fR to
append elements to \fIlist\fR.
.VE TIP505
.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
will be inserted into the list before the point specified by \fIfirst\fR
will be inserted into the list before the element specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new arguments to
The \fIelement\fR arguments specify zero or more new elements to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
the list. If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR
is empty, any \fIelement\fR arguments are added to the end of the list.
between \fIfirst\fR and \fIlast\fR are simply deleted.
.SH EXAMPLES
.PP
Replacing an element of a list with another:
@@ -78,9 +81,26 @@ proc lremove {listVariable value} {
set var [\fBlreplace\fR $var $idx $idx]
}
.CE
.PP
.VS TIP505
Appending elements to the list; note that \fBend+2\fR will initially
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
than the index of the final item so they behave identically:
.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:
+12 -2
View File
@@ -8,7 +8,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
@@ -16,7 +16,7 @@
tcltest \- Test harness support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require tcltest\fR ?\fB2.3\fR?
\fBpackage require tcltest\fR ?\fB2.5\fR?
\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
@@ -454,6 +454,7 @@ The valid options for \fBtest\fR are summarized:
?\fB\-output \fIexpectedOutput\fR?
?\fB\-errorOutput \fIexpectedError\fR?
?\fB\-returnCodes \fIcodeList\fR?
?\fB\-errorCode \fIexpectedErrorCode\fR?
?\fB\-match \fImode\fR?
.CE
.PP
@@ -577,6 +578,15 @@ return codes known to \fBreturn\fR, in both numeric and symbolic
form, including extended return codes, are acceptable elements in
the \fIexpectedCodeList\fR. Default value is
.QW "\fBok return\fR" .
.TP
\fB\-errorCode \fIexpectedErrorCode\fR
.
The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR,
a glob pattern that should match the error code reported from evaluation of the
\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns
a code not matching \fIexpectedErrorCode\fR, the test fails. Default value is
.QW "\fB*\fR" .
If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR.
.PP
To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and
+265 -259
View File
@@ -137,8 +137,8 @@ static const crange alphaRangeTable[] = {
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
{0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
@@ -165,45 +165,42 @@ static const crange alphaRangeTable[] = {
{0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
{0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
{0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
{0x1820, 0x1877}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
{0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
{0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
{0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
{0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec},
{0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
{0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
{0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
{0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
{0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
{0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
{0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
{0x3105, 0x312e}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
{0x3400, 0x4db5}, {0x4e00, 0x9fea}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
{0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
{0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae},
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
{0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
{0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
{0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
{0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
#if TCL_UTF_MAX > 4
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba},
{0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf},
{0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
{0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc},
{0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb},
{0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c},
{0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139},
{0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
{0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67},
{0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
{0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
{0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f},
{0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e},
{0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef},
{0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f},
{0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f},
{0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
{0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
{0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
{0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
{0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
{0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
{0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65},
{0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
{0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
{0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
{0xffda, 0xffdc}
#if CHRBITS > 16
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
@@ -212,23 +209,25 @@ static const crange alphaRangeTable[] = {
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
{0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
{0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
{0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
{0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
{0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae},
{0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a},
{0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
{0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
{0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65},
{0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543},
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
{0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
{0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
@@ -264,17 +263,18 @@ static const chr alphaCharTable[] = {
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
#if TCL_UTF_MAX > 4
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1,
0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43,
0xfb44
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
0x1ee64, 0x1ee7e
0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644,
0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46,
0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2,
0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};
@@ -288,7 +288,7 @@ static const crange controlRangeTable[] = {
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
{0xfff9, 0xfffb}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
{0x100000, 0x10fffd}
#endif
@@ -298,8 +298,8 @@ static const crange controlRangeTable[] = {
static const chr controlCharTable[] = {
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
#if TCL_UTF_MAX > 4
,0x110bd, 0xe0001
#if CHRBITS > 16
,0x110bd, 0x110cd, 0xe0001
#endif
};
@@ -320,12 +320,12 @@ static const crange digitRangeTable[] = {
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
{0xff10, 0xff19}
#if TCL_UTF_MAX > 4
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
{0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
{0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#if CHRBITS > 16
,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
{0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
{0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
{0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
{0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
#endif
};
@@ -348,19 +348,20 @@ static const crange punctRangeTable[] = {
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e},
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
{0xff5f, 0xff65}
#if TCL_UTF_MAX > 4
#if CHRBITS > 16
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
{0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
{0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
{0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
{0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x111dd, 0x111df}, {0x11238, 0x1123d},
{0x1144b, 0x1144f}, {0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c},
{0x1173c, 0x1173e}, {0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x16e97, 0x16e9a},
{0x1da87, 0x1da8b}
#endif
};
@@ -371,18 +372,20 @@ static const chr punctCharTable[] = {
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
#if TCL_UTF_MAX > 4
0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14,
0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c,
0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
0xff5b, 0xff5d
#if CHRBITS > 16
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f,
0x1e95e, 0x1e95f
#endif
};
@@ -413,25 +416,25 @@ static const crange lowerRangeTable[] = {
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
{0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
{0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
{0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if TCL_UTF_MAX > 4
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
{0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
{0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
{0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
{0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
{0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
{0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
{0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65},
{0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
{0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
{0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
{0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
{0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
{0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
{0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
{0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
#endif
};
@@ -501,8 +504,8 @@ static const chr lowerCharTable[] = {
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
0xa7b5, 0xa7b7, 0xa7fa
#if TCL_UTF_MAX > 4
0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa
#if CHRBITS > 16
,0x1d4bb, 0x1d7cb
#endif
};
@@ -518,20 +521,22 @@ static const crange upperRangeTable[] = {
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if TCL_UTF_MAX > 4
{0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
{0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
{0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
{0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
{0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
{0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if CHRBITS > 16
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
{0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
{0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
{0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
{0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
{0x1e900, 0x1e921}
#endif
};
@@ -600,8 +605,9 @@ static const chr upperCharTable[] = {
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
#if TCL_UTF_MAX > 4
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
0xa7b8
#if CHRBITS > 16
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
0x1d539, 0x1d546, 0x1d7ca
#endif
@@ -616,85 +622,80 @@ static const chr upperCharTable[] = {
static const crange graphRangeTable[] = {
{0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
{0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
{0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a},
{0x8a0, 0x8b4}, {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983},
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
{0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fd},
{0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
{0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75},
{0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9},
{0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff},
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
{0xc66, 0xc6f}, {0xc78, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
{0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
{0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44},
{0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f},
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
{0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4},
{0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f},
{0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4},
{0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47},
{0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc},
{0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d},
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
{0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
{0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c},
{0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c},
{0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9},
{0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa},
{0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b},
{0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
{0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c},
{0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe},
{0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
{0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf9},
{0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
{0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
{0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
{0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
{0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
{0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
{0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
{0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
{0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
{0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {0xa81, 0xa83},
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
{0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
{0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
{0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
{0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c},
{0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
{0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
{0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
{0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
{0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
{0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
{0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97},
{0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd},
{0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf},
{0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc},
{0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248},
{0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
{0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
{0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
{0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5},
{0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
{0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
{0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878},
{0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
{0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
{0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
{0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
{0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
{0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba},
{0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15},
{0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
{0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
{0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
{0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c},
{0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426},
{0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8},
{0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e},
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {0xa000, 0xa48c},
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
{0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
{0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
{0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
{0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if TCL_UTF_MAX > 4
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9},
{0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
{0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
{0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
{0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
{0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
{0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
{0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
{0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
{0xffe0, 0xffe6}, {0xffe8, 0xffee}
#if CHRBITS > 16
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
@@ -705,80 +706,85 @@ static const crange graphRangeTable[] = {
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
{0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
{0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
{0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d},
{0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8},
{0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176},
{0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211},
{0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
{0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303},
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
{0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c},
{0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9},
{0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659},
{0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a},
{0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2},
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8},
{0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
{0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
{0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
{0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
{0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
{0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
{0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
{0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
{0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
{0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
{0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
{0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
{0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
{0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
{0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
{0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
{0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
{0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
{0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
{0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
{0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
{0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
{0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4},
{0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8},
{0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887},
{0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970},
{0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2},
{0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d},
{0xe0100, 0xe01ef}
#endif
};
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
static const chr graphCharTable[] = {
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if TCL_UTF_MAX > 4
0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87,
0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7,
0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d,
0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41,
0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08,
0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e,
0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a
#endif
};
+4
View File
@@ -2369,6 +2369,10 @@ declare 1 macosx {
export {
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
Tcl_Interp *interp)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
+14 -13
View File
@@ -7606,7 +7606,19 @@ ExprEntierFunc(
if (type == TCL_NUMBER_DOUBLE) {
d = *((const double *) ptr);
if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) {
long result = (long) d;
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
return TCL_OK;
#ifndef TCL_WIDE_INT_IS_LONG
} else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) {
Tcl_WideInt result = (Tcl_WideInt) d;
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
#endif
} else {
mp_int big;
if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
@@ -7615,11 +7627,6 @@ ExprEntierFunc(
}
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
return TCL_OK;
} else {
long result = (long) d;
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
return TCL_OK;
}
}
@@ -8402,18 +8409,12 @@ TclNRTailcallObjCmd(
if (objc > 1) {
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
Tcl_Namespace *ns1Ptr;
/* The tailcall data is in a Tcl list: the first element is the
* namespace, the rest the command to be tailcalled. */
listPtr = Tcl_NewListObj(objc, objv);
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|| (nsPtr != ns1Ptr)) {
Tcl_Panic("Tailcall failed to find the proper namespace");
}
listPtr = Tcl_NewListObj(objc, objv);
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
iPtr->varFramePtr->tailcallPtr = listPtr;
-57
View File
@@ -512,63 +512,6 @@ Tcl_ContinueObjCmd(
return TCL_CONTINUE;
}
/*
*----------------------------------------------------------------------
*
* Tcl_EncodingObjCmd --
*
* This command manipulates encodings.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_EncodingObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int index;
static const char *const optionStrings[] = {
"convertfrom", "convertto", "dirs", "names", "system",
NULL
};
enum options {
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case ENC_CONVERTTO:
return EncodingConverttoObjCmd(dummy, interp, objc, objv);
case ENC_CONVERTFROM:
return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
case ENC_DIRS:
return EncodingDirsObjCmd(dummy, interp, objc, objv);
case ENC_NAMES:
return EncodingNamesObjCmd(dummy, interp, objc, objv);
case ENC_SYSTEM:
return EncodingSystemObjCmd(dummy, interp, objc, objv);
}
return TCL_OK;
}
/*
*-----------------------------------------------------------------------------
*
+3 -14
View File
@@ -2747,21 +2747,10 @@ Tcl_LreplaceObjCmd(
if (first < 0) {
first = 0;
}
/*
* Complain if the user asked for a start element that is greater than the
* list length. This won't ever trigger for the "end-*" case as that will
* be properly constrained by TclGetIntForIndex because we use listLen-1
* (to allow for replacing the last elem).
*/
if ((first >= listLen) && (listLen > 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"list doesn't contain element %s", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
NULL);
return TCL_ERROR;
if (first > listLen) {
first = listLen;
}
if (last >= listLen) {
last = listLen - 1;
}
+198 -167
View File
@@ -2599,10 +2599,8 @@ StringEqualCmd(
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
strCmpFn_t strCmpFn;
const char *string2;
int length2, i, match, nocase = 0, reqlength = -1;
if (objc < 3 || objc > 6) {
str_cmp_args:
@@ -2641,78 +2639,7 @@ StringEqualCmd(
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t) memcmp;
} else if ((objv[0]->typePtr == &tclStringType)
&& (objv[1]->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of String
* type. In benchmark testing this proved the most efficient check
* between the unicode and string comparison operations.
*/
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t)
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
} else {
length1 = Tcl_NumUtfChars(string1, length1);
length2 = Tcl_NumUtfChars(string2, length2);
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
if ((reqlength < 0) && (length1 != length2)) {
match = 1; /* This will be reversed below. */
} else {
length = (length1 < length2) ? length1 : length2;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it
* to length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
}
match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
return TCL_OK;
@@ -2749,11 +2676,194 @@ StringCmpCmd(
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
*/
const char *string1, *string2;
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
strCmpFn_t strCmpFn;
int match, nocase, reqlength, status;
if ((status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength))
!= TCL_OK) {
return status;
}
objv += objc-2;
match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength);
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
return TCL_OK;
}
int TclStringCmp (
Tcl_Obj *value1Ptr,
Tcl_Obj *value2Ptr,
int checkEq, /* comparison is only for equality */
int nocase, /* comparison is not case sensitive */
int reqlength /* requested length */
) {
char *s1, *s2;
int empty, length, match, s1len, s2len;
memCmpFn_t memCmpFn;
if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
/*
* Always match at 0 chars of if it is the same obj.
*/
match = 0;
} else {
if (!nocase && TclIsPureByteArray(value1Ptr)
&& TclIsPureByteArray(value2Ptr)) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if ((value1Ptr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
* memcmp. In benchmark testing this proved the most efficient
* check between the unicode and string comparison operations.
*/
if (nocase) {
s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
} else {
s1len = Tcl_GetCharLength(value1Ptr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == value1Ptr->length)
&& (value1Ptr->bytes != NULL)
&& (s2len == value2Ptr->length)
&& (value2Ptr->bytes != NULL)) {
s1 = value1Ptr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
} else {
s1 = (char *) Tcl_GetUnicode(value1Ptr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
1
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
} else {
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
}
}
}
} else {
if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
switch (TclCheckEmptyString(value2Ptr)) {
case -1:
s1 = "";
s1len = 0;
s2 = TclGetStringFromObj(value2Ptr, &s2len);
break;
case 0:
match = -1;
goto matchdone;
case 1:
default: /* avoid warn: `s2` may be used uninitialized */
match = 0;
goto matchdone;
}
} else if (TclCheckEmptyString(value2Ptr) > 0) {
switch (empty) {
case -1:
s2 = "";
s2len = 0;
s1 = TclGetStringFromObj(value1Ptr, &s1len);
break;
case 0:
match = 1;
goto matchdone;
case 1:
default: /* avoid warn: `s1` may be used uninitialized */
match = 0;
goto matchdone;
}
} else {
s1 = TclGetStringFromObj(value1Ptr, &s1len);
s2 = TclGetStringFromObj(value2Ptr, &s2len);
}
if (!nocase && checkEq) {
/*
* When we have equal-length we can check only for (in)equality.
* We can use memcmp in all (n)eq cases because we
* don't need to worry about lexical LE/BE variance.
*/
memCmpFn = memcmp;
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
if ((reqlength < 0) && !nocase) {
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
} else {
s1len = Tcl_NumUtfChars(s1, s1len);
s2len = Tcl_NumUtfChars(s2, s2len);
memCmpFn = (memCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
}
length = (s1len < s2len) ? s1len : s2len;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it to
* length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
if (checkEq && (s1len != s2len)) {
match = 1; /* This will be reversed below. */
} else {
/*
* The comparison function should compare up to the minimum
* byte length only.
*/
match = memCmpFn(s1, s2, (size_t) length);
}
if ((match == 0) && (reqlength > length)) {
match = s1len - s2len;
}
match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
}
matchdone:
return match;
}
int TclStringCmpOpts (
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
int *nocase,
int *reqlength
)
{
int i, length;
const char *string;
*reqlength = -1;
*nocase = 0;
if (objc < 3 || objc > 6) {
str_cmp_args:
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2762,106 +2872,27 @@ StringCmpCmd(
}
for (i = 1; i < objc-2; i++) {
string2 = TclGetStringFromObj(objv[i], &length2);
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
nocase = 1;
} else if ((length2 > 1)
&& !strncmp(string2, "-length", (size_t)length2)) {
string = TclGetStringFromObj(objv[i], &length);
if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) {
*nocase = 1;
} else if ((length > 1)
&& !strncmp(string, "-length", (size_t)length)) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
i++;
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
return TCL_ERROR;
}
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": must be -nocase or -length",
string2));
string));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
string2, NULL);
string, NULL);
return TCL_ERROR;
}
}
/*
* From now on, we only access the two objects at the end of the argument
* array.
*/
objv += objc-2;
if ((reqlength == 0) || (objv[0] == objv[1])) {
/*
* Always match at 0 chars of if it is the same obj.
*/
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
return TCL_OK;
}
if (!nocase && TclIsPureByteArray(objv[0]) &&
TclIsPureByteArray(objv[1])) {
/*
* Use binary versions of comparisons since that won't cause undue
* type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some reason... :^)
*/
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t) memcmp;
} else if ((objv[0]->typePtr == &tclStringType)
&& (objv[1]->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of String
* type. In benchmark testing this proved the most efficient check
* between the unicode and string comparison operations.
*/
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
strCmpFn = (strCmpFn_t)
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
* case-sensitive and no specific length was requested.
*/
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
if ((reqlength < 0) && !nocase) {
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
} else {
length1 = Tcl_NumUtfChars(string1, length1);
length2 = Tcl_NumUtfChars(string2, length2);
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
length = (length1 < length2) ? length1 : length2;
if (reqlength > 0 && reqlength < length) {
length = reqlength;
} else if (reqlength < 0) {
/*
* The requested length is negative, so we ignore it by setting it to
* length + 1 so we correct the match var.
*/
reqlength = length + 1;
}
match = strCmpFn(string1, string2, (unsigned) length);
if ((match == 0) && (reqlength > length)) {
match = length1 - length2;
}
Tcl_SetObjResult(interp,
Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
return TCL_OK;
}
+4 -55
View File
@@ -1472,7 +1472,7 @@ TclCompileLreplaceCmd(
{
Tcl_Token *tokenPtr, *listTokenPtr;
DefineLineInformation; /* TIP #280 */
int idx1, idx2, i, offset, offset2;
int idx1, idx2, i;
int emptyPrefix=1, suffixStart = 0;
if (parsePtr->numWords < 4) {
@@ -1492,23 +1492,6 @@ TclCompileLreplaceCmd(
return TCL_ERROR;
}
/*
* idx1, idx2 are the conventional encoded forms of the tokens parsed
* as all forms of index values. Values of idx1 that come before the
* list are treated the same as if they were the start of the list.
* Values of idx2 that come after the list are treated the same as if
* they were the end of the list.
*/
if (idx1 == TCL_INDEX_AFTER) {
/*
* [lreplace] treats idx1 value end+1 differently from end+2, etc.
* The operand encoding cannot distinguish them, so we must bail
* out to direct evaluation.
*/
return TCL_ERROR;
}
/*
* General structure of the [lreplace] result is
* prefix replacement suffix
@@ -1520,7 +1503,9 @@ TclCompileLreplaceCmd(
* we must defer to direct evaluation.
*/
if (idx2 == TCL_INDEX_BEFORE) {
if (idx1 == TCL_INDEX_AFTER) {
suffixStart = idx1;
} else if (idx2 == TCL_INDEX_BEFORE) {
suffixStart = idx1;
} else if (idx2 == TCL_INDEX_END) {
suffixStart = TCL_INDEX_AFTER;
@@ -1552,42 +1537,6 @@ TclCompileLreplaceCmd(
emptyPrefix = 0;
}
/*
* [lreplace] raises an error when idx1 points after the list, but
* only when the list is not empty. This is maximum stupidity.
*
* TODO: TIP this nonsense away!
*/
if (idx1 >= TCL_INDEX_START) {
if (emptyPrefix) {
TclEmitOpcode( INST_DUP, envPtr);
} else {
TclEmitInstInt4( INST_OVER, 1, envPtr);
}
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
TclEmitOpcode( INST_DUP, envPtr);
offset = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
/* List is not empty */
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
NULL), envPtr);
TclEmitOpcode( INST_GT, envPtr);
offset2 = CurrentOffset(envPtr);
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
/* Idx1 >= list length ===> raise an error */
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
"list doesn't contain element %d", idx1), NULL), envPtr);
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
envPtr->codeStart + offset + 1);
TclEmitOpcode( INST_POP, envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
envPtr->codeStart + offset2 + 1);
}
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
/*
* This is a "no-op". Example: [lreplace {a b c} 2 0]
+1 -1
View File
@@ -1494,7 +1494,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
#endif
#define TclGetInt4AtPtr(p) \
(((int) TclGetInt1AtPtr(p) << 24) | \
(((int) (TclGetUInt1AtPtr(p) << 24)) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3)))
+1 -1
View File
@@ -1348,7 +1348,7 @@ yyparse (info)
int yychar;
/* The semantic value of the look-ahead symbol. */
YYSTYPE yylval;
YYSTYPE yylval = {0};
/* Number of syntax errors so far. */
int yynerrs;
+1 -1
View File
@@ -153,7 +153,7 @@ typedef struct Dict {
* must be assignable as well as readable.
*/
#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
#define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1)
/*
* The structure below defines the dictionary object type by means of
+12 -1
View File
@@ -723,14 +723,25 @@ TclFinalizeEnvironment(void)
* strings. This may leak more memory that strictly necessary, since some
* of the strings may no longer be in the environment. However,
* determining which ones are ok to delete is n-squared, and is pretty
* unlikely, so we don't bother.
* unlikely, so we don't bother. However, in the case of DPURIFY, just
* free all strings in the cache.
*/
if (env.cache) {
#ifdef PURIFY
int i;
for (i = 0; i < env.cacheSize; i++) {
ckfree(env.cache[i]);
}
#endif
ckfree(env.cache);
env.cache = NULL;
env.cacheSize = 0;
#ifndef USE_PUTENV
if ((env.ourEnviron != NULL)) {
ckfree(env.ourEnviron);
env.ourEnviron = NULL;
}
env.ourEnvironSize = 0;
#endif
}
+10 -80
View File
@@ -5384,88 +5384,10 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
if (valuePtr == value2Ptr) {
match = 0;
} else {
/*
* We only need to check (in)equality when we have equal length
* strings. We can use memcmp in all (n)eq cases because we
* don't need to worry about lexical LE/BE variance.
*/
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
memCmpFn_t memCmpFn;
{
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
|| (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
if (TclIsPureByteArray(valuePtr)
&& TclIsPureByteArray(value2Ptr)) {
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if ((valuePtr->typePtr == &tclStringType)
&& (value2Ptr->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
* memcmp. In benchmark testing this proved the most efficient
* check between the unicode and string comparison operations.
*/
s1len = Tcl_GetCharLength(valuePtr);
s2len = Tcl_GetCharLength(value2Ptr);
if ((s1len == valuePtr->length)
&& (valuePtr->bytes != NULL)
&& (s2len == value2Ptr->length)
&& (value2Ptr->bytes != NULL)) {
s1 = valuePtr->bytes;
s2 = value2Ptr->bytes;
memCmpFn = memcmp;
} else {
s1 = (char *) Tcl_GetUnicode(valuePtr);
s2 = (char *) Tcl_GetUnicode(value2Ptr);
if (
#ifdef WORDS_BIGENDIAN
1
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
} else {
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
}
}
} else {
/*
* strcmp can't do a simple memcmp in order to handle the
* special Tcl \xC0\x80 null encoding for utf-8.
*/
s1 = TclGetStringFromObj(valuePtr, &s1len);
s2 = TclGetStringFromObj(value2Ptr, &s2len);
if (checkEq) {
memCmpFn = memcmp;
} else {
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
}
}
if (checkEq && (s1len != s2len)) {
match = 1;
} else {
/*
* The comparison function should compare up to the minimum
* byte length only.
*/
match = memCmpFn(s1, s2,
(size_t) ((s1len < s2len) ? s1len : s2len));
if (match == 0) {
match = s1len - s2len;
}
}
match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
}
/*
@@ -6142,6 +6064,14 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
/*
Try to determine, without triggering generation of a string
representation, whether one value is not a number.
*/
if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
goto stringCompare;
}
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
/*
+20 -14
View File
@@ -240,9 +240,13 @@ TclFileMakeDirsCmd(
break;
}
for (j = 0; j < pobjc; j++) {
int errCount = 2;
target = Tcl_FSJoinPath(split, j + 1);
Tcl_IncrRefCount(target);
createDir:
/*
* Call Tcl_FSStat() so that if target is a symlink that points to
* a directory we will create subdirectories in that directory.
@@ -269,23 +273,25 @@ TclFileMakeDirsCmd(
* subdirectory.
*/
if (errno != EEXIST) {
errfile = target;
goto done;
} else if ((Tcl_FSStat(target, &statBuf) == 0)
&& S_ISDIR(statBuf.st_mode)) {
/*
* It is a directory that wasn't there before, so keep
* going without error.
*/
Tcl_ResetResult(interp);
} else {
errfile = target;
goto done;
if (errno == EEXIST) {
/* Be aware other workers could delete it immediately after
* creation, so give this worker still one chance (repeat once),
* see [270f78ca95] for description of the race-condition.
* Don't repeat the create always (to avoid endless loop). */
if (--errCount > 0) {
goto createDir;
}
/* Already tried, with delete in-between directly after
* creation, so just continue (assume created successful). */
goto nextPart;
}
/* return with error */
errfile = target;
goto done;
}
nextPart:
/*
* Forget about this sub-path.
*/
+4 -25
View File
@@ -139,7 +139,6 @@ Tcl_FSRenameFileProc TclpObjRenameFile;
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
Tcl_FSUnloadFileProc TclpUnloadFile;
Tcl_FSLinkProc TclpObjLink;
Tcl_FSListVolumesProc TclpObjListVolumes;
@@ -3159,8 +3158,8 @@ Tcl_FSLoadFile(
* present and set to true (any integer > 0) then the unlink is skipped.
*/
int
TclSkipUnlink (Tcl_Obj* shlibFile)
static int
skipUnlink (Tcl_Obj* shlibFile)
{
/* Order of testing:
* 1. On hpux we generally want to skip unlink in general
@@ -3414,7 +3413,7 @@ Tcl_LoadFile(
*/
if (
!TclSkipUnlink (copyToPtr) &&
!skipUnlink (copyToPtr) &&
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
@@ -3683,30 +3682,10 @@ Tcl_FSUnloadFile(
}
return TCL_ERROR;
}
TclpUnloadFile(handle);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclpUnloadFile --
*
* Unloads a library given its handle
*
* This function was once filesystem-specific, but has been made portable by
* having TclpDlopen return a structure that includes procedure pointers.
*
*----------------------------------------------------------------------
*/
void
TclpUnloadFile(
Tcl_LoadHandle handle)
{
if (handle->unloadFileProcPtr != NULL) {
handle->unloadFileProcPtr(handle);
}
return TCL_OK;
}
/*
+2 -2
View File
@@ -1088,7 +1088,7 @@ declare 9 win {
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
Tcl_DirEntry *TclpReaddir(DIR *dir)
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
@@ -1226,7 +1226,7 @@ declare 9 unix {
# Added in 8.4:
declare 10 unix {
Tcl_DirEntry *TclpReaddir(DIR *dir)
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
+17 -1
View File
@@ -2735,6 +2735,10 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
MODULE_SCOPE char * tclEmptyStringRep;
MODULE_SCOPE char tclEmptyString;
enum CheckEmptyStringResult {
TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
};
/*
*----------------------------------------------------------------
* Procedures shared among Tcl modules but not used by the outside world,
@@ -2875,6 +2879,7 @@ MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
@@ -2929,7 +2934,7 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
Tcl_Obj *const *objv, int objc, int *objcPtr);
Tcl_Namespace * TclEnsureNamespace(
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(
Tcl_Interp *interp,
Tcl_Namespace *namespacePtr);
@@ -3150,6 +3155,12 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, int reqlength);
MODULE_SCOPE int TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int *nocase, int *reqlength);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
@@ -4455,6 +4466,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
#define TclIsPureByteArray(objPtr) \
(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
#define TclIsPureDict(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclIsPureList(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
/*
*----------------------------------------------------------------
+6 -11
View File
@@ -13,11 +13,6 @@
#ifndef _TCLINTPLATDECLS
#define _TCLINTPLATDECLS
#ifdef _WIN32
# define Tcl_DirEntry void
# define DIR void
#endif
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
@@ -72,7 +67,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
@@ -129,7 +124,7 @@ EXTERN int TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
Tcl_Channel chan);
@@ -206,7 +201,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
/* 12 */
@@ -269,7 +264,7 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
@@ -302,7 +297,7 @@ typedef struct TclIntPlatStubs {
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
int (*tclpCloseFile) (TclFile file); /* 12 */
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
@@ -335,7 +330,7 @@ typedef struct TclIntPlatStubs {
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
+69 -40
View File
@@ -56,7 +56,6 @@ static const struct {
* Function declarations for things defined in this file.
*/
static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj);
static Object * AllocObject(Tcl_Interp *interp, const char *nameStr,
Namespace *nsPtr, const char *nsNameStr);
static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
@@ -79,8 +78,6 @@ static void ObjectNamespaceDeleted(ClientData clientData);
static void ObjectRenamedTrace(ClientData clientData,
Tcl_Interp *interp, const char *oldName,
const char *newName, int flags);
static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
static void DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
static inline void SquelchCachedName(Object *oPtr);
static int PublicObjectCmd(ClientData clientData,
@@ -392,10 +389,10 @@ InitFoundation(
/* Stand up a phony class for bootstrapping. */
fPtr->objectCls = &fakeCls;
/* referenced in AllocClass to increment the refCount. */
/* referenced in TclOOAllocClass to increment the refCount. */
fakeCls.thisPtr = &fakeObject;
fPtr->objectCls = AllocClass(interp,
fPtr->objectCls = TclOOAllocClass(interp,
AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
/* Corresponding TclOODecrRefCount in KillFoudation */
AddRef(fPtr->objectCls->thisPtr);
@@ -411,7 +408,7 @@ InitFoundation(
fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
fPtr->objectCls->flags |= ROOT_OBJECT;
fPtr->classCls = AllocClass(interp,
fPtr->classCls = TclOOAllocClass(interp,
AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
/* Corresponding TclOODecrRefCount in KillFoudation */
AddRef(fPtr->classCls->thisPtr);
@@ -829,15 +826,15 @@ ObjectRenamedTrace(
/*
* ----------------------------------------------------------------------
*
* DeleteDescendants --
* TclOODeleteDescendants --
*
* Delete all descendants of a particular class.
*
* ----------------------------------------------------------------------
*/
static void
DeleteDescendants(
void
TclOODeleteDescendants(
Tcl_Interp *interp, /* The interpreter containing the class. */
Object *oPtr) /* The object representing the class. */
{
@@ -854,7 +851,8 @@ DeleteDescendants(
/* This condition also covers the case where mixinSubclassPtr ==
* clsPtr
*/
if (!Deleted(mixinSubclassPtr->thisPtr)) {
if (!Deleted(mixinSubclassPtr->thisPtr)
&& !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
mixinSubclassPtr->thisPtr->command);
}
@@ -872,8 +870,10 @@ DeleteDescendants(
if (clsPtr->subclasses.num > 0) {
while (clsPtr->subclasses.num > 0) {
subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
&& !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
subclassPtr->thisPtr->command);
}
TclOORemoveFromSubclasses(subclassPtr, clsPtr);
}
@@ -892,7 +892,8 @@ DeleteDescendants(
while (clsPtr->instances.num > 0) {
instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
/* This condition also covers the case where instancePtr == oPtr */
if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
!(instancePtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
}
TclOORemoveFromInstances(instancePtr, clsPtr);
@@ -909,7 +910,7 @@ DeleteDescendants(
/*
* ----------------------------------------------------------------------
*
* ReleaseClassContents --
* TclOOReleaseClassContents --
*
* Tear down the special class data structure, including deleting all
* dependent classes and objects.
@@ -917,8 +918,8 @@ DeleteDescendants(
* ----------------------------------------------------------------------
*/
static void
ReleaseClassContents(
void
TclOOReleaseClassContents(
Tcl_Interp *interp, /* The interpreter containing the class. */
Object *oPtr) /* The object representing the class. */
{
@@ -940,9 +941,6 @@ ReleaseClassContents(
} else if (IsRootObject(oPtr)) {
Tcl_Panic("deleting class structure for non-deleted %s",
"::oo::object");
} else {
Tcl_Panic("deleting class structure for non-deleted %s",
"general object");
}
}
@@ -1037,6 +1035,7 @@ ReleaseClassContents(
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
}
oPtr->classPtr = NULL;
}
/*
@@ -1082,7 +1081,7 @@ ObjectNamespaceDeleted(
/* Let the dominoes fall */
if (oPtr->classPtr) {
DeleteDescendants(interp, oPtr);
TclOODeleteDescendants(interp, oPtr);
}
/*
@@ -1194,27 +1193,25 @@ ObjectNamespaceDeleted(
}
/*
* Because an object can be a class that is an instance of itself, the
* A class object's class structure should only be cleaned after most of
* the cleanup on the object is done.
*/
/*
* Because an object can be a class that is an instance of itself, the
* class object's class structure should only be cleaned after most of
* the cleanup on the object is done.
*
* The class of objects needs some special care; if it is deleted (and
* we're not killing the whole interpreter) we force the delete of the
* class of classes now as well. Due to the incestuous nature of those two
* classes, if one goes the other must too and yet the tangle can
* sometimes not go away automatically; we force it here. [Bug 2962664]
*/
if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
&& !Tcl_InterpDeleted(interp)) {
&& !Tcl_InterpDeleted(interp)) {
Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
}
if (oPtr->classPtr != NULL) {
ReleaseClassContents(interp, oPtr);
TclOOReleaseClassContents(interp, oPtr);
}
/*
@@ -1325,6 +1322,37 @@ TclOOAddToInstances(
AddRef(oPtr);
}
/*
* ----------------------------------------------------------------------
*
* TclOORemoveFromMixins --
*
* Utility function to remove a class from the list of mixins within an
* object.
*
* ----------------------------------------------------------------------
*/
int
TclOORemoveFromMixins(
Class *mixinPtr, /* The mixin to remove. */
Object *oPtr) /* The object (possibly) containing the
* reference to the mixin. */
{
int i, res = 0;
Class *mixPtr;
FOREACH(mixPtr, oPtr->mixins) {
if (mixinPtr == mixPtr) {
RemoveItem(Class, oPtr->mixins, i);
TclOODecrRefCount(mixPtr->thisPtr);
res++;
break;
}
}
return res;
}
/*
* ----------------------------------------------------------------------
*
@@ -1381,7 +1409,8 @@ TclOOAddToSubclasses(
if (superPtr->subclasses.size == ALLOC_CHUNK) {
superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
} else {
superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list, sizeof(Class *) * superPtr->subclasses.size);
superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
sizeof(Class *) * superPtr->subclasses.size);
}
}
superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
@@ -1456,16 +1485,16 @@ TclOOAddToMixinSubs(
/*
* ----------------------------------------------------------------------
*
* AllocClass --
* TclOOAllocClass --
*
* Allocate a basic class. Does not add class to its
* class's instance list.
* Allocate a basic class. Does not add class to its class's instance
* list.
*
* ----------------------------------------------------------------------
*/
static Class *
AllocClass(
Class *
TclOOAllocClass(
Tcl_Interp *interp, /* Interpreter within which to allocate the
* class. */
Object *useThisObj) /* Object that is to act as the class
@@ -1709,13 +1738,13 @@ TclNewObjectInstanceCommon(
if (TclOOIsReachable(fPtr->classCls, classPtr)) {
/*
* Is a class, so attach a class structure. Note that the AllocClass
* function splices the structure into the object, so we don't have
* to. Once that's done, we need to repatch the object to have the
* right class since AllocClass interferes with that.
* Is a class, so attach a class structure. Note that the
* TclOOAllocClass function splices the structure into the object, so
* we don't have to. Once that's done, we need to repatch the object
* to have the right class since TclOOAllocClass interferes with that.
*/
AllocClass(interp, oPtr);
TclOOAllocClass(interp, oPtr);
TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
} else {
oPtr->classPtr = NULL;
-1
View File
@@ -1444,7 +1444,6 @@ AddSimpleClassChainToCallContext(
if (flags & CONSTRUCTOR) {
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
filterDecl, flags);
} else if (flags & DESTRUCTOR) {
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
filterDecl, flags);
+31 -64
View File
@@ -1083,6 +1083,8 @@ TclOODefineClassObjCmd(
{
Object *oPtr;
Class *clsPtr;
Foundation *fPtr = TclOOGetFoundation(interp);
int wasClass, willBeClass;
/*
* Parse the context to get the object to operate on.
@@ -1118,12 +1120,20 @@ TclOODefineClassObjCmd(
if (clsPtr == NULL) {
return TCL_ERROR;
}
if (oPtr == clsPtr->thisPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not change classes into an instance of themselves", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
/*
* Set the object's class.
*/
wasClass = (oPtr->classPtr != NULL);
willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));
if (oPtr->selfCls != clsPtr) {
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
TclOODecrRefCount(oPtr->selfCls->thisPtr);
@@ -1131,6 +1141,26 @@ TclOODefineClassObjCmd(
AddRef(oPtr->selfCls->thisPtr);
TclOOAddToInstances(oPtr, oPtr->selfCls);
/*
* Create or delete the class guts if necessary.
*/
if (wasClass && !willBeClass) {
/*
* This is the most global of all epochs. Bump it! No cache can be
* trusted!
*/
TclOORemoveFromMixins(oPtr->classPtr, oPtr);
oPtr->fPtr->epoch++;
oPtr->flags |= DONT_DELETE;
TclOODeleteDescendants(interp, oPtr);
oPtr->flags &= ~DONT_DELETE;
TclOOReleaseClassContents(interp, oPtr);
} else if (!wasClass && willBeClass) {
TclOOAllocClass(interp, oPtr);
}
if (oPtr->classPtr != NULL) {
BumpGlobalEpoch(interp, oPtr->classPtr);
} else {
@@ -1539,69 +1569,6 @@ TclOODefineMethodObjCmd(
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* TclOODefineMixinObjCmd --
* Implementation of the "mixin" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
* ----------------------------------------------------------------------
*/
int
TclOODefineMixinObjCmd(
ClientData clientData,
Tcl_Interp *interp,
const int objc,
Tcl_Obj *const *objv)
{
int isInstanceMixin = (clientData != NULL);
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
Class **mixins;
int i;
if (oPtr == NULL) {
return TCL_ERROR;
}
if (!isInstanceMixin && !oPtr->classPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
for (i=1 ; i<objc ; i++) {
Class *clsPtr = GetClassInOuterContext(interp, objv[i],
"may only mix in classes");
if (clsPtr == NULL) {
goto freeAndError;
}
if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not mix a class into itself", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
goto freeAndError;
}
mixins[i-1] = clsPtr;
}
if (isInstanceMixin) {
TclOOObjectSetMixins(oPtr, objc-1, mixins);
} else {
TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
}
TclStackFree(interp, mixins);
return TCL_OK;
freeAndError:
TclStackFree(interp, mixins);
return TCL_ERROR;
}
/*
* ----------------------------------------------------------------------
*
+8
View File
@@ -214,6 +214,7 @@ typedef struct Object {
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
* unknown method handler at that point. */
#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -484,6 +485,8 @@ MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData,
MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp,
Object *useThisObj);
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
Tcl_Class cls, const char *nameStr,
const char *nsNameStr, int objc,
@@ -498,6 +501,8 @@ MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp,
Object *oPtr);
MODULE_SCOPE void TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
@@ -523,7 +528,10 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void TclOOReleaseClassContents(Tcl_Interp *interp,
Object *oPtr);
MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr,
Class *mixinPtr);
MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr,
+7 -1
View File
@@ -991,7 +991,13 @@ TclParseBackslash(
if (readPtr != NULL) {
*readPtr = count;
}
return Tcl_UniCharToUtf(result, dst);
count = Tcl_UniCharToUtf(result, dst);
#if TCL_UTF_MAX > 3
if (!count) {
count = Tcl_UniCharToUtf(-1, dst);
}
#endif
return count;
}
/*
+23 -21
View File
@@ -504,10 +504,11 @@ TclCreateProc(
goto procError;
}
nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
nameLength = Tcl_NumUtfChars(argname, plen);
if (fieldCount == 2) {
valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
fieldValues[1]->length);
const char * value = TclGetString(fieldValues[1]);
valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
} else {
valueLength = 0;
}
@@ -516,7 +517,6 @@ TclCreateProc(
* Check that the formal parameter name is a scalar.
*/
argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
argnamei = argname;
argnamelast = argname[plen-1];
while (plen--) {
@@ -611,7 +611,7 @@ TclCreateProc(
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
localPtr->nameLength = nameLength;
localPtr->frameIndex = i;
localPtr->flags = VAR_ARGUMENT;
localPtr->resolveInfo = NULL;
@@ -1035,7 +1035,6 @@ ProcWrongNumArgs(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
register Var *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
@@ -1059,23 +1058,26 @@ ProcWrongNumArgs(
}
Tcl_IncrRefCount(desiredObjs[0]);
defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (localCt > 0) {
register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
break;
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
break;
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
}
desiredObjs[i] = argObj;
}
desiredObjs[i] = argObj;
}
Tcl_ResetResult(interp);
+56
View File
@@ -434,6 +434,7 @@ Tcl_GetCharLength(
return length;
}
/*
* OK, need to work with the object as a string.
*/
@@ -464,6 +465,50 @@ Tcl_GetCharLength(
}
return numChars;
}
/*
*----------------------------------------------------------------------
*
* TclCheckEmptyString --
*
* Determine whether the string value of an object is or would be the
* empty string, without generating a string representation.
*
* Results:
* Returns 1 if empty, 0 if not, and -1 if unknown.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclCheckEmptyString (
Tcl_Obj *objPtr
) {
int length = -1;
if (objPtr->bytes == tclEmptyStringRep) {
return TCL_EMPTYSTRING_YES;
}
if (TclIsPureList(objPtr)) {
Tcl_ListObjLength(NULL, objPtr, &length);
return length == 0;
}
if (TclIsPureDict(objPtr)) {
Tcl_DictObjSize(NULL, objPtr, &length);
return length == 0;
}
if (objPtr->bytes == NULL) {
return TCL_EMPTYSTRING_UNKNOWN;
}
return objPtr->length == 0;
}
/*
*----------------------------------------------------------------------
@@ -1831,6 +1876,11 @@ Tcl_AppendFormatToObj(
width = 0;
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
if (width < 0) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
format = end;
step = TclUtfToUniChar(format, &ch);
} else if (ch == '*') {
@@ -1951,6 +2001,12 @@ Tcl_AppendFormatToObj(
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
#if TCL_UTF_MAX > 3
if (!length) {
/* Special case for handling upper surrogates. */
length = Tcl_UniCharToUtf(-1, buf);
}
#endif
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
+15 -42
View File
@@ -12,6 +12,10 @@
#include "tclInt.h"
#include "tommath.h"
#ifdef __CYGWIN__
# include <wchar.h>
#endif
#ifdef __GNUC__
#pragma GCC dependency "tcl.decls"
#pragma GCC dependency "tclInt.decls"
@@ -106,10 +110,6 @@ static unsigned short TclWinNToHS(unsigned short ns) {
# define TclWinFlushDirtyChannels doNothing
# define TclWinResetInterfaces doNothing
#if TCL_UTF_MAX < 4
static Tcl_Encoding winTCharEncoding;
#endif
static int
TclpIsAtty(int fd)
{
@@ -188,25 +188,11 @@ Tcl_WinUtfToTChar(
int len,
Tcl_DString *dsPtr)
{
#if TCL_UTF_MAX > 3
WCHAR *wp;
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, 2*size+2);
wp = (WCHAR *)Tcl_DStringValue(dsPtr);
MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
if (len == -1) --size; /* account for 0-byte at string end */
Tcl_DStringSetLength(dsPtr, 2*size);
wp[size] = 0;
return (char *)wp;
#else
if (!winTCharEncoding) {
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
if (!string) {
return NULL;
}
return Tcl_UtfToExternalDString(winTCharEncoding,
string, len, dsPtr);
#endif
return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
}
char *
@@ -215,29 +201,16 @@ Tcl_WinTCharToUtf(
int len,
Tcl_DString *dsPtr)
{
#if TCL_UTF_MAX > 3
char *p;
int size;
if (len > 0) {
Tcl_DStringInit(dsPtr);
if (!string) {
return NULL;
}
if (len < 0) {
len = wcslen((wchar_t *)string);
} else {
len /= 2;
}
size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, size+1);
p = (char *)Tcl_DStringValue(dsPtr);
WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
if (len == -1) --size; /* account for 0-byte at string end */
Tcl_DStringSetLength(dsPtr, size);
p[size] = 0;
return p;
#else
if (!winTCharEncoding) {
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
}
return Tcl_ExternalToUtfDString(winTCharEncoding,
string, len, dsPtr);
#endif
return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
}
#if defined(TCL_WIDE_INT_IS_LONG)
+8 -1
View File
@@ -174,7 +174,6 @@ TclThread_Init(
Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
@@ -1158,6 +1157,14 @@ ThreadExitProc(
Tcl_MutexLock(&threadMutex);
if (self == errorThreadId) {
if (errorProcString) { /* Extra safety */
ckfree(errorProcString);
errorProcString = NULL;
}
errorThreadId = 0;
}
if (threadEvalScript) {
ckfree(threadEvalScript);
threadEvalScript = NULL;
+810 -795
View File
File diff suppressed because it is too large Load Diff
+32 -8
View File
@@ -189,6 +189,13 @@ Tcl_UniCharToUtf(
buf[0] = (char) ((ch >> 18) | 0xF0);
return 4;
}
} else if (ch == -1) {
if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
&& ((buf[2] & 0xCF) == 0)) {
ch = 0xD7C0 + ((buf[0] & 0x07) << 8) + ((buf[1] & 0x3F) << 2)
+ ((buf[2] & 0x30) >> 4);
goto three;
}
#endif
}
@@ -236,7 +243,7 @@ Tcl_UniCharToUtfDString(
*/
oldLength = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX);
string = Tcl_DStringValue(dsPtr) + oldLength;
p = string;
@@ -425,17 +432,27 @@ Tcl_UtfToUniCharDString(
*/
oldLength = Tcl_DStringLength(dsPtr);
/* TODO: fix overreach! */
Tcl_DStringSetLength(dsPtr,
(int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
w = wString;
end = src + length;
for (p = src; p < end; ) {
p = src;
end = src + length - TCL_UTF_MAX;
while (p < end) {
p += TclUtfToUniChar(p, &ch);
*w++ = ch;
}
end += TCL_UTF_MAX;
while (p < end) {
if (Tcl_UtfCharComplete(p, end-p)) {
p += TclUtfToUniChar(p, &ch);
} else {
ch = UCHAR(*p++);
}
*w++ = ch;
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
(oldLength + ((char *) w - (char *) wString)));
@@ -984,7 +1001,11 @@ Tcl_UtfToTitle(
}
while (*src) {
bytes = TclUtfToUniChar(src, &ch);
lowChar = Tcl_UniCharToLower(ch);
lowChar = ch;
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
lowChar = Tcl_UniCharToLower(lowChar);
}
if (bytes < UtfCount(lowChar)) {
memcpy(dst, src, (size_t) bytes);
@@ -1256,8 +1277,9 @@ Tcl_UniCharToLower(
int ch) /* Unicode character to convert. */
{
int info = GetUniCharInfo(ch);
int mode = GetCaseType(info);
if (GetCaseType(info) & 0x02) {
if ((mode & 0x02) && (mode != 0x7)) {
ch += GetDelta(info);
}
return (Tcl_UniChar) ch;
@@ -1291,7 +1313,9 @@ Tcl_UniCharToTitle(
* Subtract or add one depending on the original case.
*/
ch += ((mode & 0x4) ? -1 : 1);
if (mode != 0x7) {
ch += ((mode & 0x4) ? -1 : 1);
}
} else if (mode == 0x4) {
ch -= GetDelta(info);
}
+30 -23
View File
@@ -972,20 +972,24 @@ TclLookupSimpleVar(
}
}
} else { /* Local var: look in frame varFramePtr. */
int localLen, localCt = varFramePtr->numCompiledLocals;
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
const char *localNameStr;
int localCt = varFramePtr->numCompiledLocals;
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
register Tcl_Obj *objPtr = *objPtrPtr;
if (localCt > 0) {
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
const char *localNameStr;
int localLen;
if (objPtr) {
localNameStr = TclGetStringFromObj(objPtr, &localLen);
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
register Tcl_Obj *objPtr = *objPtrPtr;
if ((varLen == localLen) && (varName[0] == localNameStr[0])
if (objPtr) {
localNameStr = TclGetStringFromObj(objPtr, &localLen);
if ((varLen == localLen) && (varName[0] == localNameStr[0])
&& !memcmp(varName, localNameStr, varLen)) {
*indexPtr = i;
return (Var *) &varFramePtr->compiledLocals[i];
*indexPtr = i;
return (Var *) &varFramePtr->compiledLocals[i];
}
}
}
}
@@ -6132,7 +6136,7 @@ AppendLocals(
Interp *iPtr = (Interp *) interp;
Var *varPtr;
int i, localVarCt, added;
Tcl_Obj **varNamePtr, *objNamePtr;
Tcl_Obj *objNamePtr;
const char *varName;
TclVarHashTable *localVarTablePtr;
Tcl_HashSearch search;
@@ -6142,27 +6146,30 @@ AppendLocals(
localVarCt = iPtr->varFramePtr->numCompiledLocals;
varPtr = iPtr->varFramePtr->compiledLocals;
localVarTablePtr = iPtr->varFramePtr->varTablePtr;
varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
if (includeLinks) {
Tcl_InitObjHashTable(&addedTable);
}
for (i = 0; i < localVarCt; i++, varNamePtr++) {
/*
* Skip nameless (temporary) variables and undefined variables.
*/
if (localVarCt > 0) {
Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
if (*varNamePtr && !TclIsVarUndefined(varPtr)
for (i = 0; i < localVarCt; i++, varNamePtr++) {
/*
* Skip nameless (temporary) variables and undefined variables.
*/
if (*varNamePtr && !TclIsVarUndefined(varPtr)
&& (includeLinks || !TclIsVarLink(varPtr))) {
varName = TclGetString(*varNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
if (includeLinks) {
Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
varName = TclGetString(*varNamePtr);
if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
if (includeLinks) {
Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
}
}
}
varPtr++;
}
varPtr++;
}
/*
+2 -2
View File
@@ -1,7 +1,7 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
} else {
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
}
+2177 -335
View File
File diff suppressed because it is too large Load Diff
+1 -1
View File
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.13 [list tclPkgSetup $dir http 2.8.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+2 -2
View File
@@ -1,9 +1,9 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.2 \
package ifneeded registry 1.3.3 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
package ifneeded registry 1.3.2 \
package ifneeded registry 1.3.3 \
[list load [file join $dir tclreg13.dll] registry]
}
+2 -2
View File
@@ -8,5 +8,5 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]]
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]
+34 -13
View File
@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
variable Version 2.4.1
variable Version 2.5.0
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -1841,6 +1841,9 @@ proc tcltest::SubstArguments {argList} {
# is optional; default is {}.
# returnCodes - Expected return codes. This attribute is
# optional; default is {0 2}.
# errorCode - Expected error code. This attribute is
# optional; default is {*}. It is a glob pattern.
# If given, returnCodes defaults to {1}.
# setup - Code to run before $script (above). This
# attribute is optional; default is {}.
# cleanup - Code to run after $script (above). This
@@ -1882,7 +1885,7 @@ proc tcltest::test {name description args} {
# Pre-define everything to null except output and errorOutput. We
# determine whether or not to trap output based on whether or not
# these variables (output & errorOutput) are defined.
lassign {} constraints setup cleanup body result returnCodes match
lassign {} constraints setup cleanup body result returnCodes errorCode match
# Set the default match mode
set match exact
@@ -1892,6 +1895,9 @@ proc tcltest::test {name description args} {
# 'return' being used in the test script).
set returnCodes [list 0 2]
# Set the default error code pattern
set errorCode "*"
# The old test format can't have a 3rd argument (constraints or
# script) that starts with '-'.
if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
@@ -1901,7 +1907,7 @@ proc tcltest::test {name description args} {
set testAttributes($element) $value
}
foreach item {constraints match setup body cleanup \
result returnCodes output errorOutput} {
result returnCodes errorCode output errorOutput} {
if {[info exists testAttributes(-$item)]} {
set testAttributes(-$item) [uplevel 1 \
::concat $testAttributes(-$item)]
@@ -1912,7 +1918,7 @@ proc tcltest::test {name description args} {
}
set validFlags {-setup -cleanup -body -result -returnCodes \
-match -output -errorOutput -constraints}
-errorCode -match -output -errorOutput -constraints}
foreach flag [array names testAttributes] {
if {$flag ni $validFlags} {
@@ -1944,6 +1950,10 @@ proc tcltest::test {name description args} {
foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes]
}
# errorCode without returnCode 1 is meaningless
if {$errorCode ne "*" && 1 ni $returnCodes} {
set returnCodes 1
}
} else {
# This is parsing for the old test command format; it is here
# for backward compatibility.
@@ -1976,7 +1986,7 @@ proc tcltest::test {name description args} {
set code [catch {uplevel 1 $setup} setupMsg]
if {$code == 1} {
set errorInfo(setup) $::errorInfo
set errorCode(setup) $::errorCode
set errorCodeRes(setup) $::errorCode
}
set setupFailure [expr {$code != 0}]
@@ -2003,7 +2013,7 @@ proc tcltest::test {name description args} {
lassign $testResult actualAnswer returnCode
if {$returnCode == 1} {
set errorInfo(body) $::errorInfo
set errorCode(body) $::errorCode
set errorCodeRes(body) $::errorCode
}
}
@@ -2012,6 +2022,11 @@ proc tcltest::test {name description args} {
if {!$setupFailure && ($returnCode ni $returnCodes)} {
set codeFailure 1
}
set errorCodeFailure 0
if {!$setupFailure && !$codeFailure && $returnCode == 1 && \
![string match $errorCode $errorCodeRes(body)]} {
set errorCodeFailure 1
}
# If expected output/error strings exist, we have to compare
# them. If the comparison fails, then so did the test.
@@ -2055,7 +2070,7 @@ proc tcltest::test {name description args} {
set code [catch {uplevel 1 $cleanup} cleanupMsg]
if {$code == 1} {
set errorInfo(cleanup) $::errorInfo
set errorCode(cleanup) $::errorCode
set errorCodeRes(cleanup) $::errorCode
}
set cleanupFailure [expr {$code != 0}]
@@ -2106,7 +2121,7 @@ proc tcltest::test {name description args} {
variable numTests
if {!($setupFailure || $cleanupFailure || $coreFailure
|| $outputFailure || $errorFailure || $codeFailure
|| $scriptFailure)} {
|| $errorCodeFailure || $scriptFailure)} {
if {$testLevel == 1} {
incr numTests(Passed)
if {[IsVerbose pass]} {
@@ -2159,7 +2174,7 @@ proc tcltest::test {name description args} {
failed:\n$setupMsg"
if {[info exists errorInfo(setup)]} {
puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)"
puts [outputChannel] "---- errorCode(setup): $errorCode(setup)"
puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
}
}
if {$scriptFailure} {
@@ -2171,6 +2186,10 @@ proc tcltest::test {name description args} {
($match matching):\n$result"
}
}
if {$errorCodeFailure} {
puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
puts [outputChannel] "---- Error code should have been: '$errorCode'"
}
if {$codeFailure} {
switch -- $returnCode {
0 { set msg "Test completed normally" }
@@ -2186,7 +2205,7 @@ proc tcltest::test {name description args} {
if {[IsVerbose error]} {
if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
puts [outputChannel] "---- errorInfo: $errorInfo(body)"
puts [outputChannel] "---- errorCode: $errorCode(body)"
puts [outputChannel] "---- errorCode: $errorCodeRes(body)"
}
}
}
@@ -2212,7 +2231,7 @@ proc tcltest::test {name description args} {
puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
if {[info exists errorInfo(cleanup)]} {
puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)"
puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)"
puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)"
}
}
if {$coreFailure} {
@@ -2722,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
# shell being tested
#
# Results:
# None.
# Whether there were any failures.
#
# Side effects:
# None.
@@ -2733,6 +2752,7 @@ proc tcltest::runAllTests { {shell ""} } {
variable numTests
variable failFiles
variable DefaultValue
set failFilesAccum {}
FillFilesExisted
if {[llength [info level 0]] == 1} {
@@ -2822,6 +2842,7 @@ proc tcltest::runAllTests { {shell ""} } {
}
if {$Failed > 0} {
lappend failFiles $testFile
lappend failFilesAccum $testFile
}
} elseif {[regexp [join {
{^Number of tests skipped }
@@ -2868,7 +2889,7 @@ proc tcltest::runAllTests { {shell ""} } {
puts [outputChannel] ""
puts [outputChannel] [string repeat ~ 44]
}
return
return [expr {[info exists testFileFailures] || [llength $failFilesAccum]}]
}
#####################################################################
+55 -225
View File
@@ -2,229 +2,59 @@
set TZData(:Africa/Casablanca) {
{-9223372036854775808 -1820 0 LMT}
{-1773012580 0 0 WET}
{-956361600 3600 1 WEST}
{-950490000 0 0 WET}
{-942019200 3600 1 WEST}
{-761187600 0 0 WET}
{-617241600 3600 1 WEST}
{-605149200 0 0 WET}
{-81432000 3600 1 WEST}
{-71110800 0 0 WET}
{141264000 3600 1 WEST}
{147222000 0 0 WET}
{199756800 3600 1 WEST}
{207702000 0 0 WET}
{231292800 3600 1 WEST}
{244249200 0 0 WET}
{265507200 3600 1 WEST}
{271033200 0 0 WET}
{448243200 3600 0 CET}
{504918000 0 0 WET}
{1212278400 3600 1 WEST}
{1220223600 0 0 WET}
{1243814400 3600 1 WEST}
{1250809200 0 0 WET}
{1272758400 3600 1 WEST}
{1281222000 0 0 WET}
{1301788800 3600 1 WEST}
{1312066800 0 0 WET}
{1335664800 3600 1 WEST}
{1342749600 0 0 WET}
{1345428000 3600 1 WEST}
{1348970400 0 0 WET}
{1367114400 3600 1 WEST}
{1373162400 0 0 WET}
{1376100000 3600 1 WEST}
{1382839200 0 0 WET}
{1396144800 3600 1 WEST}
{1403920800 0 0 WET}
{1406944800 3600 1 WEST}
{1414288800 0 0 WET}
{1427594400 3600 1 WEST}
{1434247200 0 0 WET}
{1437271200 3600 1 WEST}
{1445738400 0 0 WET}
{1459044000 3600 1 WEST}
{1465092000 0 0 WET}
{1468116000 3600 1 WEST}
{1477792800 0 0 WET}
{1490493600 3600 1 WEST}
{1495332000 0 0 WET}
{1498960800 3600 1 WEST}
{1509242400 0 0 WET}
{1521943200 3600 1 WEST}
{1526176800 0 0 WET}
{1529200800 3600 1 WEST}
{1540692000 0 0 WET}
{1553997600 3600 1 WEST}
{1557021600 0 0 WET}
{1560045600 3600 1 WEST}
{1572141600 0 0 WET}
{1585447200 3600 1 WEST}
{1587261600 0 0 WET}
{1590285600 3600 1 WEST}
{1603591200 0 0 WET}
{1616896800 3600 1 WEST}
{1618106400 0 0 WET}
{1621130400 3600 1 WEST}
{1635645600 0 0 WET}
{1651975200 3600 1 WEST}
{1667095200 0 0 WET}
{1682215200 3600 1 WEST}
{1698544800 0 0 WET}
{1713060000 3600 1 WEST}
{1729994400 0 0 WET}
{1743904800 3600 1 WEST}
{1761444000 0 0 WET}
{1774749600 3600 1 WEST}
{1792893600 0 0 WET}
{1806199200 3600 1 WEST}
{1824948000 0 0 WET}
{1837648800 3600 1 WEST}
{1856397600 0 0 WET}
{1869098400 3600 1 WEST}
{1887847200 0 0 WET}
{1901152800 3600 1 WEST}
{1919296800 0 0 WET}
{1932602400 3600 1 WEST}
{1950746400 0 0 WET}
{1964052000 3600 1 WEST}
{1982800800 0 0 WET}
{1995501600 3600 1 WEST}
{2014250400 0 0 WET}
{2026951200 3600 1 WEST}
{2045700000 0 0 WET}
{2058400800 3600 1 WEST}
{2077149600 0 0 WET}
{2090455200 3600 1 WEST}
{2107994400 0 0 WET}
{2108602800 0 0 WET}
{2121904800 3600 1 WEST}
{2138234400 0 0 WET}
{2140052400 0 0 WET}
{2153354400 3600 1 WEST}
{2172103200 0 0 WET}
{2184804000 3600 1 WEST}
{2203552800 0 0 WET}
{2216253600 3600 1 WEST}
{2235002400 0 0 WET}
{2248308000 3600 1 WEST}
{2266452000 0 0 WET}
{2279757600 3600 1 WEST}
{2297901600 0 0 WET}
{2311207200 3600 1 WEST}
{2329351200 0 0 WET}
{2342656800 3600 1 WEST}
{2361405600 0 0 WET}
{2374106400 3600 1 WEST}
{2392855200 0 0 WET}
{2405556000 3600 1 WEST}
{2424304800 0 0 WET}
{2437610400 3600 1 WEST}
{2455754400 0 0 WET}
{2469060000 3600 1 WEST}
{2487204000 0 0 WET}
{2500509600 3600 1 WEST}
{2519258400 0 0 WET}
{2531959200 3600 1 WEST}
{2550708000 0 0 WET}
{2563408800 3600 1 WEST}
{2582157600 0 0 WET}
{2595463200 3600 1 WEST}
{2613607200 0 0 WET}
{2626912800 3600 1 WEST}
{2645056800 0 0 WET}
{2658362400 3600 1 WEST}
{2676506400 0 0 WET}
{2689812000 3600 1 WEST}
{2708560800 0 0 WET}
{2721261600 3600 1 WEST}
{2740010400 0 0 WET}
{2752711200 3600 1 WEST}
{2771460000 0 0 WET}
{2784765600 3600 1 WEST}
{2802909600 0 0 WET}
{2816215200 3600 1 WEST}
{2834359200 0 0 WET}
{2847664800 3600 1 WEST}
{2866413600 0 0 WET}
{2879114400 3600 1 WEST}
{2897863200 0 0 WET}
{2910564000 3600 1 WEST}
{2929312800 0 0 WET}
{2942013600 3600 1 WEST}
{2960762400 0 0 WET}
{2974068000 3600 1 WEST}
{2992212000 0 0 WET}
{3005517600 3600 1 WEST}
{3023661600 0 0 WET}
{3036967200 3600 1 WEST}
{3055716000 0 0 WET}
{3068416800 3600 1 WEST}
{3087165600 0 0 WET}
{3099866400 3600 1 WEST}
{3118615200 0 0 WET}
{3131920800 3600 1 WEST}
{3150064800 0 0 WET}
{3163370400 3600 1 WEST}
{3181514400 0 0 WET}
{3194820000 3600 1 WEST}
{3212964000 0 0 WET}
{3226269600 3600 1 WEST}
{3245018400 0 0 WET}
{3257719200 3600 1 WEST}
{3276468000 0 0 WET}
{3289168800 3600 1 WEST}
{3307917600 0 0 WET}
{3321223200 3600 1 WEST}
{3339367200 0 0 WET}
{3352672800 3600 1 WEST}
{3370816800 0 0 WET}
{3384122400 3600 1 WEST}
{3402871200 0 0 WET}
{3415572000 3600 1 WEST}
{3434320800 0 0 WET}
{3447021600 3600 1 WEST}
{3465770400 0 0 WET}
{3479076000 3600 1 WEST}
{3497220000 0 0 WET}
{3510525600 3600 1 WEST}
{3528669600 0 0 WET}
{3541975200 3600 1 WEST}
{3560119200 0 0 WET}
{3573424800 3600 1 WEST}
{3592173600 0 0 WET}
{3604874400 3600 1 WEST}
{3623623200 0 0 WET}
{3636324000 3600 1 WEST}
{3655072800 0 0 WET}
{3668378400 3600 1 WEST}
{3686522400 0 0 WET}
{3699828000 3600 1 WEST}
{3717972000 0 0 WET}
{3731277600 3600 1 WEST}
{3750026400 0 0 WET}
{3762727200 3600 1 WEST}
{3781476000 0 0 WET}
{3794176800 3600 1 WEST}
{3812925600 0 0 WET}
{3825626400 3600 1 WEST}
{3844375200 0 0 WET}
{3857680800 3600 1 WEST}
{3875824800 0 0 WET}
{3889130400 3600 1 WEST}
{3907274400 0 0 WET}
{3920580000 3600 1 WEST}
{3939328800 0 0 WET}
{3952029600 3600 1 WEST}
{3970778400 0 0 WET}
{3983479200 3600 1 WEST}
{4002228000 0 0 WET}
{4015533600 3600 1 WEST}
{4033677600 0 0 WET}
{4046983200 3600 1 WEST}
{4065127200 0 0 WET}
{4078432800 3600 1 WEST}
{4096576800 0 0 WET}
{-1773012580 0 0 +00}
{-956361600 3600 1 +00}
{-950490000 0 0 +00}
{-942019200 3600 1 +00}
{-761187600 0 0 +00}
{-617241600 3600 1 +00}
{-605149200 0 0 +00}
{-81432000 3600 1 +00}
{-71110800 0 0 +00}
{141264000 3600 1 +00}
{147222000 0 0 +00}
{199756800 3600 1 +00}
{207702000 0 0 +00}
{231292800 3600 1 +00}
{244249200 0 0 +00}
{265507200 3600 1 +00}
{271033200 0 0 +00}
{448243200 3600 0 +01}
{504918000 0 0 +00}
{1212278400 3600 1 +00}
{1220223600 0 0 +00}
{1243814400 3600 1 +00}
{1250809200 0 0 +00}
{1272758400 3600 1 +00}
{1281222000 0 0 +00}
{1301788800 3600 1 +00}
{1312066800 0 0 +00}
{1335664800 3600 1 +00}
{1342749600 0 0 +00}
{1345428000 3600 1 +00}
{1348970400 0 0 +00}
{1367114400 3600 1 +00}
{1373162400 0 0 +00}
{1376100000 3600 1 +00}
{1382839200 0 0 +00}
{1396144800 3600 1 +00}
{1403920800 0 0 +00}
{1406944800 3600 1 +00}
{1414288800 0 0 +00}
{1427594400 3600 1 +00}
{1434247200 0 0 +00}
{1437271200 3600 1 +00}
{1445738400 0 0 +00}
{1459044000 3600 1 +00}
{1465092000 0 0 +00}
{1468116000 3600 1 +00}
{1477792800 0 0 +00}
{1490493600 3600 1 +00}
{1495332000 0 0 +00}
{1498960800 3600 1 +00}
{1509242400 0 0 +00}
{1521943200 3600 1 +00}
{1526176800 0 0 +00}
{1529200800 3600 1 +00}
{1540598400 3600 0 +01}
}
+1
View File
@@ -15,6 +15,7 @@ set TZData(:Africa/Ceuta) {
{-1316390400 3600 1 WEST}
{-1301270400 0 0 WET}
{-1293840000 0 0 WET}
{-94694400 0 0 WET}
{-81432000 3600 1 WEST}
{-71110800 0 0 WET}
{141264000 3600 1 WEST}
+43 -213
View File
@@ -3,217 +3,47 @@
set TZData(:Africa/El_Aaiun) {
{-9223372036854775808 -3168 0 LMT}
{-1136070432 -3600 0 -01}
{198291600 0 0 WET}
{199756800 3600 1 WEST}
{207702000 0 0 WET}
{231292800 3600 1 WEST}
{244249200 0 0 WET}
{265507200 3600 1 WEST}
{271033200 0 0 WET}
{1212278400 3600 1 WEST}
{1220223600 0 0 WET}
{1243814400 3600 1 WEST}
{1250809200 0 0 WET}
{1272758400 3600 1 WEST}
{1281222000 0 0 WET}
{1301788800 3600 1 WEST}
{1312066800 0 0 WET}
{1335664800 3600 1 WEST}
{1342749600 0 0 WET}
{1345428000 3600 1 WEST}
{1348970400 0 0 WET}
{1367114400 3600 1 WEST}
{1373162400 0 0 WET}
{1376100000 3600 1 WEST}
{1382839200 0 0 WET}
{1396144800 3600 1 WEST}
{1403920800 0 0 WET}
{1406944800 3600 1 WEST}
{1414288800 0 0 WET}
{1427594400 3600 1 WEST}
{1434247200 0 0 WET}
{1437271200 3600 1 WEST}
{1445738400 0 0 WET}
{1459044000 3600 1 WEST}
{1465092000 0 0 WET}
{1468116000 3600 1 WEST}
{1477792800 0 0 WET}
{1490493600 3600 1 WEST}
{1495332000 0 0 WET}
{1498960800 3600 1 WEST}
{1509242400 0 0 WET}
{1521943200 3600 1 WEST}
{1526176800 0 0 WET}
{1529200800 3600 1 WEST}
{1540692000 0 0 WET}
{1553997600 3600 1 WEST}
{1557021600 0 0 WET}
{1560045600 3600 1 WEST}
{1572141600 0 0 WET}
{1585447200 3600 1 WEST}
{1587261600 0 0 WET}
{1590285600 3600 1 WEST}
{1603591200 0 0 WET}
{1616896800 3600 1 WEST}
{1618106400 0 0 WET}
{1621130400 3600 1 WEST}
{1635645600 0 0 WET}
{1651975200 3600 1 WEST}
{1667095200 0 0 WET}
{1682215200 3600 1 WEST}
{1698544800 0 0 WET}
{1713060000 3600 1 WEST}
{1729994400 0 0 WET}
{1743904800 3600 1 WEST}
{1761444000 0 0 WET}
{1774749600 3600 1 WEST}
{1792893600 0 0 WET}
{1806199200 3600 1 WEST}
{1824948000 0 0 WET}
{1837648800 3600 1 WEST}
{1856397600 0 0 WET}
{1869098400 3600 1 WEST}
{1887847200 0 0 WET}
{1901152800 3600 1 WEST}
{1919296800 0 0 WET}
{1932602400 3600 1 WEST}
{1950746400 0 0 WET}
{1964052000 3600 1 WEST}
{1982800800 0 0 WET}
{1995501600 3600 1 WEST}
{2014250400 0 0 WET}
{2026951200 3600 1 WEST}
{2045700000 0 0 WET}
{2058400800 3600 1 WEST}
{2077149600 0 0 WET}
{2090455200 3600 1 WEST}
{2107994400 0 0 WET}
{2108602800 0 0 WET}
{2121904800 3600 1 WEST}
{2138234400 0 0 WET}
{2140052400 0 0 WET}
{2153354400 3600 1 WEST}
{2172103200 0 0 WET}
{2184804000 3600 1 WEST}
{2203552800 0 0 WET}
{2216253600 3600 1 WEST}
{2235002400 0 0 WET}
{2248308000 3600 1 WEST}
{2266452000 0 0 WET}
{2279757600 3600 1 WEST}
{2297901600 0 0 WET}
{2311207200 3600 1 WEST}
{2329351200 0 0 WET}
{2342656800 3600 1 WEST}
{2361405600 0 0 WET}
{2374106400 3600 1 WEST}
{2392855200 0 0 WET}
{2405556000 3600 1 WEST}
{2424304800 0 0 WET}
{2437610400 3600 1 WEST}
{2455754400 0 0 WET}
{2469060000 3600 1 WEST}
{2487204000 0 0 WET}
{2500509600 3600 1 WEST}
{2519258400 0 0 WET}
{2531959200 3600 1 WEST}
{2550708000 0 0 WET}
{2563408800 3600 1 WEST}
{2582157600 0 0 WET}
{2595463200 3600 1 WEST}
{2613607200 0 0 WET}
{2626912800 3600 1 WEST}
{2645056800 0 0 WET}
{2658362400 3600 1 WEST}
{2676506400 0 0 WET}
{2689812000 3600 1 WEST}
{2708560800 0 0 WET}
{2721261600 3600 1 WEST}
{2740010400 0 0 WET}
{2752711200 3600 1 WEST}
{2771460000 0 0 WET}
{2784765600 3600 1 WEST}
{2802909600 0 0 WET}
{2816215200 3600 1 WEST}
{2834359200 0 0 WET}
{2847664800 3600 1 WEST}
{2866413600 0 0 WET}
{2879114400 3600 1 WEST}
{2897863200 0 0 WET}
{2910564000 3600 1 WEST}
{2929312800 0 0 WET}
{2942013600 3600 1 WEST}
{2960762400 0 0 WET}
{2974068000 3600 1 WEST}
{2992212000 0 0 WET}
{3005517600 3600 1 WEST}
{3023661600 0 0 WET}
{3036967200 3600 1 WEST}
{3055716000 0 0 WET}
{3068416800 3600 1 WEST}
{3087165600 0 0 WET}
{3099866400 3600 1 WEST}
{3118615200 0 0 WET}
{3131920800 3600 1 WEST}
{3150064800 0 0 WET}
{3163370400 3600 1 WEST}
{3181514400 0 0 WET}
{3194820000 3600 1 WEST}
{3212964000 0 0 WET}
{3226269600 3600 1 WEST}
{3245018400 0 0 WET}
{3257719200 3600 1 WEST}
{3276468000 0 0 WET}
{3289168800 3600 1 WEST}
{3307917600 0 0 WET}
{3321223200 3600 1 WEST}
{3339367200 0 0 WET}
{3352672800 3600 1 WEST}
{3370816800 0 0 WET}
{3384122400 3600 1 WEST}
{3402871200 0 0 WET}
{3415572000 3600 1 WEST}
{3434320800 0 0 WET}
{3447021600 3600 1 WEST}
{3465770400 0 0 WET}
{3479076000 3600 1 WEST}
{3497220000 0 0 WET}
{3510525600 3600 1 WEST}
{3528669600 0 0 WET}
{3541975200 3600 1 WEST}
{3560119200 0 0 WET}
{3573424800 3600 1 WEST}
{3592173600 0 0 WET}
{3604874400 3600 1 WEST}
{3623623200 0 0 WET}
{3636324000 3600 1 WEST}
{3655072800 0 0 WET}
{3668378400 3600 1 WEST}
{3686522400 0 0 WET}
{3699828000 3600 1 WEST}
{3717972000 0 0 WET}
{3731277600 3600 1 WEST}
{3750026400 0 0 WET}
{3762727200 3600 1 WEST}
{3781476000 0 0 WET}
{3794176800 3600 1 WEST}
{3812925600 0 0 WET}
{3825626400 3600 1 WEST}
{3844375200 0 0 WET}
{3857680800 3600 1 WEST}
{3875824800 0 0 WET}
{3889130400 3600 1 WEST}
{3907274400 0 0 WET}
{3920580000 3600 1 WEST}
{3939328800 0 0 WET}
{3952029600 3600 1 WEST}
{3970778400 0 0 WET}
{3983479200 3600 1 WEST}
{4002228000 0 0 WET}
{4015533600 3600 1 WEST}
{4033677600 0 0 WET}
{4046983200 3600 1 WEST}
{4065127200 0 0 WET}
{4078432800 3600 1 WEST}
{4096576800 0 0 WET}
{198291600 0 0 +00}
{199756800 3600 1 +00}
{207702000 0 0 +00}
{231292800 3600 1 +00}
{244249200 0 0 +00}
{265507200 3600 1 +00}
{271033200 0 0 +00}
{1212278400 3600 1 +00}
{1220223600 0 0 +00}
{1243814400 3600 1 +00}
{1250809200 0 0 +00}
{1272758400 3600 1 +00}
{1281222000 0 0 +00}
{1301788800 3600 1 +00}
{1312066800 0 0 +00}
{1335664800 3600 1 +00}
{1342749600 0 0 +00}
{1345428000 3600 1 +00}
{1348970400 0 0 +00}
{1367114400 3600 1 +00}
{1373162400 0 0 +00}
{1376100000 3600 1 +00}
{1382839200 0 0 +00}
{1396144800 3600 1 +00}
{1403920800 0 0 +00}
{1406944800 3600 1 +00}
{1414288800 0 0 +00}
{1427594400 3600 1 +00}
{1434247200 0 0 +00}
{1437271200 3600 1 +00}
{1445738400 0 0 +00}
{1459044000 3600 1 +00}
{1465092000 0 0 +00}
{1468116000 3600 1 +00}
{1477792800 0 0 +00}
{1490493600 3600 1 +00}
{1495332000 0 0 +00}
{1498960800 3600 1 +00}
{1509242400 0 0 +00}
{1521943200 3600 1 +00}
{1526176800 0 0 +00}
{1529200800 3600 1 +00}
{1540598400 3600 0 +01}
}
+162 -162
View File
@@ -124,166 +124,166 @@ set TZData(:America/Santiago) {
{1502596800 -10800 1 -04}
{1526180400 -14400 0 -04}
{1534046400 -10800 1 -04}
{1557630000 -14400 0 -04}
{1565496000 -10800 1 -04}
{1589079600 -14400 0 -04}
{1596945600 -10800 1 -04}
{1620529200 -14400 0 -04}
{1629000000 -10800 1 -04}
{1652583600 -14400 0 -04}
{1660449600 -10800 1 -04}
{1684033200 -14400 0 -04}
{1691899200 -10800 1 -04}
{1715482800 -14400 0 -04}
{1723348800 -10800 1 -04}
{1746932400 -14400 0 -04}
{1754798400 -10800 1 -04}
{1778382000 -14400 0 -04}
{1786248000 -10800 1 -04}
{1809831600 -14400 0 -04}
{1818302400 -10800 1 -04}
{1841886000 -14400 0 -04}
{1849752000 -10800 1 -04}
{1873335600 -14400 0 -04}
{1881201600 -10800 1 -04}
{1904785200 -14400 0 -04}
{1912651200 -10800 1 -04}
{1936234800 -14400 0 -04}
{1944100800 -10800 1 -04}
{1967684400 -14400 0 -04}
{1976155200 -10800 1 -04}
{1999738800 -14400 0 -04}
{2007604800 -10800 1 -04}
{2031188400 -14400 0 -04}
{2039054400 -10800 1 -04}
{2062638000 -14400 0 -04}
{2070504000 -10800 1 -04}
{2094087600 -14400 0 -04}
{2101953600 -10800 1 -04}
{2125537200 -14400 0 -04}
{2133403200 -10800 1 -04}
{2156986800 -14400 0 -04}
{2165457600 -10800 1 -04}
{2189041200 -14400 0 -04}
{2196907200 -10800 1 -04}
{2220490800 -14400 0 -04}
{2228356800 -10800 1 -04}
{2251940400 -14400 0 -04}
{2259806400 -10800 1 -04}
{2283390000 -14400 0 -04}
{2291256000 -10800 1 -04}
{2314839600 -14400 0 -04}
{2322705600 -10800 1 -04}
{2346894000 -14400 0 -04}
{2354760000 -10800 1 -04}
{2378343600 -14400 0 -04}
{2386209600 -10800 1 -04}
{2409793200 -14400 0 -04}
{2417659200 -10800 1 -04}
{2441242800 -14400 0 -04}
{2449108800 -10800 1 -04}
{2472692400 -14400 0 -04}
{2480558400 -10800 1 -04}
{2504142000 -14400 0 -04}
{2512612800 -10800 1 -04}
{2536196400 -14400 0 -04}
{2544062400 -10800 1 -04}
{2567646000 -14400 0 -04}
{2575512000 -10800 1 -04}
{2599095600 -14400 0 -04}
{2606961600 -10800 1 -04}
{2630545200 -14400 0 -04}
{2638411200 -10800 1 -04}
{2661994800 -14400 0 -04}
{2669860800 -10800 1 -04}
{2693444400 -14400 0 -04}
{2701915200 -10800 1 -04}
{2725498800 -14400 0 -04}
{2733364800 -10800 1 -04}
{2756948400 -14400 0 -04}
{2764814400 -10800 1 -04}
{2788398000 -14400 0 -04}
{2796264000 -10800 1 -04}
{2819847600 -14400 0 -04}
{2827713600 -10800 1 -04}
{2851297200 -14400 0 -04}
{2859768000 -10800 1 -04}
{2883351600 -14400 0 -04}
{2891217600 -10800 1 -04}
{2914801200 -14400 0 -04}
{2922667200 -10800 1 -04}
{2946250800 -14400 0 -04}
{2954116800 -10800 1 -04}
{2977700400 -14400 0 -04}
{2985566400 -10800 1 -04}
{3009150000 -14400 0 -04}
{3017016000 -10800 1 -04}
{3040599600 -14400 0 -04}
{3049070400 -10800 1 -04}
{3072654000 -14400 0 -04}
{3080520000 -10800 1 -04}
{3104103600 -14400 0 -04}
{3111969600 -10800 1 -04}
{3135553200 -14400 0 -04}
{3143419200 -10800 1 -04}
{3167002800 -14400 0 -04}
{3174868800 -10800 1 -04}
{3198452400 -14400 0 -04}
{3206318400 -10800 1 -04}
{3230506800 -14400 0 -04}
{3238372800 -10800 1 -04}
{3261956400 -14400 0 -04}
{3269822400 -10800 1 -04}
{3293406000 -14400 0 -04}
{3301272000 -10800 1 -04}
{3324855600 -14400 0 -04}
{3332721600 -10800 1 -04}
{3356305200 -14400 0 -04}
{3364171200 -10800 1 -04}
{3387754800 -14400 0 -04}
{3396225600 -10800 1 -04}
{3419809200 -14400 0 -04}
{3427675200 -10800 1 -04}
{3451258800 -14400 0 -04}
{3459124800 -10800 1 -04}
{3482708400 -14400 0 -04}
{3490574400 -10800 1 -04}
{3514158000 -14400 0 -04}
{3522024000 -10800 1 -04}
{3545607600 -14400 0 -04}
{3553473600 -10800 1 -04}
{3577057200 -14400 0 -04}
{3585528000 -10800 1 -04}
{3609111600 -14400 0 -04}
{3616977600 -10800 1 -04}
{3640561200 -14400 0 -04}
{3648427200 -10800 1 -04}
{3672010800 -14400 0 -04}
{3679876800 -10800 1 -04}
{3703460400 -14400 0 -04}
{3711326400 -10800 1 -04}
{3734910000 -14400 0 -04}
{3743380800 -10800 1 -04}
{3766964400 -14400 0 -04}
{3774830400 -10800 1 -04}
{3798414000 -14400 0 -04}
{3806280000 -10800 1 -04}
{3829863600 -14400 0 -04}
{3837729600 -10800 1 -04}
{3861313200 -14400 0 -04}
{3869179200 -10800 1 -04}
{3892762800 -14400 0 -04}
{3900628800 -10800 1 -04}
{3924212400 -14400 0 -04}
{3932683200 -10800 1 -04}
{3956266800 -14400 0 -04}
{3964132800 -10800 1 -04}
{3987716400 -14400 0 -04}
{3995582400 -10800 1 -04}
{4019166000 -14400 0 -04}
{4027032000 -10800 1 -04}
{4050615600 -14400 0 -04}
{4058481600 -10800 1 -04}
{4082065200 -14400 0 -04}
{4089931200 -10800 1 -04}
{1554606000 -14400 0 -04}
{1567915200 -10800 1 -04}
{1586055600 -14400 0 -04}
{1599364800 -10800 1 -04}
{1617505200 -14400 0 -04}
{1630814400 -10800 1 -04}
{1648954800 -14400 0 -04}
{1662264000 -10800 1 -04}
{1680404400 -14400 0 -04}
{1693713600 -10800 1 -04}
{1712458800 -14400 0 -04}
{1725768000 -10800 1 -04}
{1743908400 -14400 0 -04}
{1757217600 -10800 1 -04}
{1775358000 -14400 0 -04}
{1788667200 -10800 1 -04}
{1806807600 -14400 0 -04}
{1820116800 -10800 1 -04}
{1838257200 -14400 0 -04}
{1851566400 -10800 1 -04}
{1870311600 -14400 0 -04}
{1883016000 -10800 1 -04}
{1901761200 -14400 0 -04}
{1915070400 -10800 1 -04}
{1933210800 -14400 0 -04}
{1946520000 -10800 1 -04}
{1964660400 -14400 0 -04}
{1977969600 -10800 1 -04}
{1996110000 -14400 0 -04}
{2009419200 -10800 1 -04}
{2027559600 -14400 0 -04}
{2040868800 -10800 1 -04}
{2059614000 -14400 0 -04}
{2072318400 -10800 1 -04}
{2091063600 -14400 0 -04}
{2104372800 -10800 1 -04}
{2122513200 -14400 0 -04}
{2135822400 -10800 1 -04}
{2153962800 -14400 0 -04}
{2167272000 -10800 1 -04}
{2185412400 -14400 0 -04}
{2198721600 -10800 1 -04}
{2217466800 -14400 0 -04}
{2230171200 -10800 1 -04}
{2248916400 -14400 0 -04}
{2262225600 -10800 1 -04}
{2280366000 -14400 0 -04}
{2293675200 -10800 1 -04}
{2311815600 -14400 0 -04}
{2325124800 -10800 1 -04}
{2343265200 -14400 0 -04}
{2356574400 -10800 1 -04}
{2374714800 -14400 0 -04}
{2388024000 -10800 1 -04}
{2406769200 -14400 0 -04}
{2419473600 -10800 1 -04}
{2438218800 -14400 0 -04}
{2451528000 -10800 1 -04}
{2469668400 -14400 0 -04}
{2482977600 -10800 1 -04}
{2501118000 -14400 0 -04}
{2514427200 -10800 1 -04}
{2532567600 -14400 0 -04}
{2545876800 -10800 1 -04}
{2564017200 -14400 0 -04}
{2577326400 -10800 1 -04}
{2596071600 -14400 0 -04}
{2609380800 -10800 1 -04}
{2627521200 -14400 0 -04}
{2640830400 -10800 1 -04}
{2658970800 -14400 0 -04}
{2672280000 -10800 1 -04}
{2690420400 -14400 0 -04}
{2703729600 -10800 1 -04}
{2721870000 -14400 0 -04}
{2735179200 -10800 1 -04}
{2753924400 -14400 0 -04}
{2766628800 -10800 1 -04}
{2785374000 -14400 0 -04}
{2798683200 -10800 1 -04}
{2816823600 -14400 0 -04}
{2830132800 -10800 1 -04}
{2848273200 -14400 0 -04}
{2861582400 -10800 1 -04}
{2879722800 -14400 0 -04}
{2893032000 -10800 1 -04}
{2911172400 -14400 0 -04}
{2924481600 -10800 1 -04}
{2943226800 -14400 0 -04}
{2955931200 -10800 1 -04}
{2974676400 -14400 0 -04}
{2987985600 -10800 1 -04}
{3006126000 -14400 0 -04}
{3019435200 -10800 1 -04}
{3037575600 -14400 0 -04}
{3050884800 -10800 1 -04}
{3069025200 -14400 0 -04}
{3082334400 -10800 1 -04}
{3101079600 -14400 0 -04}
{3113784000 -10800 1 -04}
{3132529200 -14400 0 -04}
{3145838400 -10800 1 -04}
{3163978800 -14400 0 -04}
{3177288000 -10800 1 -04}
{3195428400 -14400 0 -04}
{3208737600 -10800 1 -04}
{3226878000 -14400 0 -04}
{3240187200 -10800 1 -04}
{3258327600 -14400 0 -04}
{3271636800 -10800 1 -04}
{3290382000 -14400 0 -04}
{3303086400 -10800 1 -04}
{3321831600 -14400 0 -04}
{3335140800 -10800 1 -04}
{3353281200 -14400 0 -04}
{3366590400 -10800 1 -04}
{3384730800 -14400 0 -04}
{3398040000 -10800 1 -04}
{3416180400 -14400 0 -04}
{3429489600 -10800 1 -04}
{3447630000 -14400 0 -04}
{3460939200 -10800 1 -04}
{3479684400 -14400 0 -04}
{3492993600 -10800 1 -04}
{3511134000 -14400 0 -04}
{3524443200 -10800 1 -04}
{3542583600 -14400 0 -04}
{3555892800 -10800 1 -04}
{3574033200 -14400 0 -04}
{3587342400 -10800 1 -04}
{3605482800 -14400 0 -04}
{3618792000 -10800 1 -04}
{3637537200 -14400 0 -04}
{3650241600 -10800 1 -04}
{3668986800 -14400 0 -04}
{3682296000 -10800 1 -04}
{3700436400 -14400 0 -04}
{3713745600 -10800 1 -04}
{3731886000 -14400 0 -04}
{3745195200 -10800 1 -04}
{3763335600 -14400 0 -04}
{3776644800 -10800 1 -04}
{3794785200 -14400 0 -04}
{3808094400 -10800 1 -04}
{3826839600 -14400 0 -04}
{3839544000 -10800 1 -04}
{3858289200 -14400 0 -04}
{3871598400 -10800 1 -04}
{3889738800 -14400 0 -04}
{3903048000 -10800 1 -04}
{3921188400 -14400 0 -04}
{3934497600 -10800 1 -04}
{3952638000 -14400 0 -04}
{3965947200 -10800 1 -04}
{3984692400 -14400 0 -04}
{3997396800 -10800 1 -04}
{4016142000 -14400 0 -04}
{4029451200 -10800 1 -04}
{4047591600 -14400 0 -04}
{4060900800 -10800 1 -04}
{4079041200 -14400 0 -04}
{4092350400 -10800 1 -04}
}
+49 -19
View File
@@ -1,20 +1,56 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Macau) {
{-9223372036854775808 27260 0 LMT}
{-1830412800 28800 0 CST}
{-9223372036854775808 27250 0 LMT}
{-2056692850 28800 0 CST}
{-884509200 32400 0 +09}
{-873280800 36000 1 +09}
{-855918000 32400 0 +09}
{-841744800 36000 1 +09}
{-828529200 32400 0 +10}
{-765363600 28800 0 CT}
{-747046800 32400 1 CDT}
{-733827600 28800 0 CST}
{-716461200 32400 1 CDT}
{-697021200 28800 0 CST}
{-683715600 32400 1 CDT}
{-667990800 28800 0 CST}
{-654771600 32400 1 CDT}
{-636627600 28800 0 CST}
{-623322000 32400 1 CDT}
{-605178000 28800 0 CST}
{-591872400 32400 1 CDT}
{-573642000 28800 0 CST}
{-559818000 32400 1 CDT}
{-541674000 28800 0 CST}
{-528368400 32400 1 CDT}
{-510224400 28800 0 CST}
{-498128400 32400 1 CDT}
{-478774800 28800 0 CST}
{-466678800 32400 1 CDT}
{-446720400 28800 0 CST}
{-435229200 32400 1 CDT}
{-415258200 28800 0 CST}
{-403158600 32400 1 CDT}
{-383808600 28800 0 CST}
{-371709000 32400 1 CDT}
{-352359000 28800 0 CST}
{-340259400 32400 1 CDT}
{-320909400 28800 0 CST}
{-308809800 32400 1 CDT}
{-288855000 28800 0 CST}
{-277360200 32400 1 CDT}
{-257405400 28800 0 CST}
{-245910600 32400 1 CDT}
{-225955800 28800 0 CST}
{-214473600 32400 1 CDT}
{-213856200 32400 1 CDT}
{-194506200 28800 0 CST}
{-182406600 32400 1 CDT}
{-163056600 28800 0 CST}
{-150969600 32400 1 CDT}
{-131619600 28800 0 CST}
{-148537800 32400 1 CDT}
{-132820200 28800 0 CST}
{-117088200 32400 1 CDT}
{-101367000 28800 0 CST}
{-101370600 28800 0 CST}
{-85638600 32400 1 CDT}
{-69312600 28800 0 CST}
{-53584200 32400 1 CDT}
@@ -25,22 +61,16 @@ set TZData(:Asia/Macau) {
{25036200 28800 0 CST}
{40764600 32400 1 CDT}
{56485800 28800 0 CST}
{72201600 32400 1 CDT}
{87922800 28800 0 CST}
{103651200 32400 1 CDT}
{119977200 28800 0 CST}
{135705600 32400 1 CDT}
{72214200 32400 1 CDT}
{88540200 28800 0 CST}
{104268600 32400 1 CDT}
{119989800 28800 0 CST}
{126041400 32400 1 CDT}
{151439400 28800 0 CST}
{167167800 32400 1 CDT}
{182889000 28800 0 CST}
{198617400 32400 1 CDT}
{214338600 28800 0 CST}
{230067000 32400 1 CDT}
{245788200 28800 0 CST}
{261504000 32400 1 CDT}
{277225200 28800 0 CST}
{292953600 32400 1 CDT}
{309279600 28800 0 CST}
{325008000 32400 1 CDT}
{340729200 28800 0 CST}
{295385400 32400 1 CDT}
{309292200 28800 0 CST}
}
+9 -9
View File
@@ -3,13 +3,13 @@
set TZData(:Asia/Manila) {
{-9223372036854775808 -57360 0 LMT}
{-3944621040 29040 0 LMT}
{-2229321840 28800 0 +08}
{-1046678400 32400 1 +08}
{-1038733200 28800 0 +08}
{-873273600 32400 0 +09}
{-794221200 28800 0 +08}
{-496224000 32400 1 +08}
{-489315600 28800 0 +08}
{259344000 32400 1 +08}
{275151600 28800 0 +08}
{-2229321840 28800 0 PST}
{-1046678400 32400 1 PDT}
{-1038733200 28800 0 PST}
{-873273600 32400 0 JST}
{-794221200 28800 0 PST}
{-496224000 32400 1 PDT}
{-489315600 28800 0 PST}
{259344000 32400 1 PDT}
{275151600 28800 0 PST}
}
+1 -1
View File
@@ -6,5 +6,5 @@ set TZData(:Asia/Pyongyang) {
{-1830414600 32400 0 JST}
{-768646800 32400 0 KST}
{1439564400 30600 0 KST}
{1525447800 32400 0 KST}
{1525446000 32400 0 KST}
}
+26 -17
View File
@@ -3,21 +3,30 @@
set TZData(:Asia/Shanghai) {
{-9223372036854775808 29143 0 LMT}
{-2177481943 28800 0 CST}
{-933494400 32400 1 CDT}
{-923130000 28800 0 CST}
{-908784000 32400 1 CDT}
{-891594000 28800 0 CST}
{-662716800 28800 0 CST}
{515520000 32400 1 CDT}
{527007600 28800 0 CST}
{545155200 32400 1 CDT}
{558457200 28800 0 CST}
{576604800 32400 1 CDT}
{589906800 28800 0 CST}
{608659200 32400 1 CDT}
{621961200 28800 0 CST}
{640108800 32400 1 CDT}
{653410800 28800 0 CST}
{671558400 32400 1 CDT}
{684860400 28800 0 CST}
{-933667200 32400 1 CDT}
{-922093200 28800 0 CST}
{-908870400 32400 1 CDT}
{-888829200 28800 0 CST}
{-881049600 32400 1 CDT}
{-767869200 28800 0 CST}
{-745833600 32400 1 CDT}
{-733827600 28800 0 CST}
{-716889600 32400 1 CDT}
{-699613200 28800 0 CST}
{-683884800 32400 1 CDT}
{-670669200 28800 0 CST}
{-652348800 32400 1 CDT}
{-650016000 28800 0 CST}
{515527200 32400 1 CDT}
{527014800 28800 0 CST}
{545162400 32400 1 CDT}
{558464400 28800 0 CST}
{577216800 32400 1 CDT}
{589914000 28800 0 CST}
{608666400 32400 1 CDT}
{621968400 28800 0 CST}
{640116000 32400 1 CDT}
{653418000 28800 0 CST}
{671565600 32400 1 CDT}
{684867600 28800 0 CST}
}
+4 -4
View File
@@ -4,11 +4,11 @@ set TZData(:Asia/Tokyo) {
{-9223372036854775808 33539 0 LMT}
{-2587712400 32400 0 JST}
{-683802000 36000 1 JDT}
{-672314400 32400 0 JST}
{-672310800 32400 0 JST}
{-654771600 36000 1 JDT}
{-640864800 32400 0 JST}
{-640861200 32400 0 JST}
{-620298000 36000 1 JDT}
{-609415200 32400 0 JST}
{-609411600 32400 0 JST}
{-588848400 36000 1 JDT}
{-577965600 32400 0 JST}
{-577962000 32400 0 JST}
}
+1
View File
@@ -68,4 +68,5 @@ set TZData(:Europe/Volgograd) {
{1288479600 10800 0 +03}
{1301180400 14400 0 +04}
{1414274400 10800 0 +03}
{1540681200 14400 0 +04}
}
+162 -162
View File
@@ -103,166 +103,166 @@ set TZData(:Pacific/Easter) {
{1502596800 -18000 1 -06}
{1526180400 -21600 0 -06}
{1534046400 -18000 1 -06}
{1557630000 -21600 0 -06}
{1565496000 -18000 1 -06}
{1589079600 -21600 0 -06}
{1596945600 -18000 1 -06}
{1620529200 -21600 0 -06}
{1629000000 -18000 1 -06}
{1652583600 -21600 0 -06}
{1660449600 -18000 1 -06}
{1684033200 -21600 0 -06}
{1691899200 -18000 1 -06}
{1715482800 -21600 0 -06}
{1723348800 -18000 1 -06}
{1746932400 -21600 0 -06}
{1754798400 -18000 1 -06}
{1778382000 -21600 0 -06}
{1786248000 -18000 1 -06}
{1809831600 -21600 0 -06}
{1818302400 -18000 1 -06}
{1841886000 -21600 0 -06}
{1849752000 -18000 1 -06}
{1873335600 -21600 0 -06}
{1881201600 -18000 1 -06}
{1904785200 -21600 0 -06}
{1912651200 -18000 1 -06}
{1936234800 -21600 0 -06}
{1944100800 -18000 1 -06}
{1967684400 -21600 0 -06}
{1976155200 -18000 1 -06}
{1999738800 -21600 0 -06}
{2007604800 -18000 1 -06}
{2031188400 -21600 0 -06}
{2039054400 -18000 1 -06}
{2062638000 -21600 0 -06}
{2070504000 -18000 1 -06}
{2094087600 -21600 0 -06}
{2101953600 -18000 1 -06}
{2125537200 -21600 0 -06}
{2133403200 -18000 1 -06}
{2156986800 -21600 0 -06}
{2165457600 -18000 1 -06}
{2189041200 -21600 0 -06}
{2196907200 -18000 1 -06}
{2220490800 -21600 0 -06}
{2228356800 -18000 1 -06}
{2251940400 -21600 0 -06}
{2259806400 -18000 1 -06}
{2283390000 -21600 0 -06}
{2291256000 -18000 1 -06}
{2314839600 -21600 0 -06}
{2322705600 -18000 1 -06}
{2346894000 -21600 0 -06}
{2354760000 -18000 1 -06}
{2378343600 -21600 0 -06}
{2386209600 -18000 1 -06}
{2409793200 -21600 0 -06}
{2417659200 -18000 1 -06}
{2441242800 -21600 0 -06}
{2449108800 -18000 1 -06}
{2472692400 -21600 0 -06}
{2480558400 -18000 1 -06}
{2504142000 -21600 0 -06}
{2512612800 -18000 1 -06}
{2536196400 -21600 0 -06}
{2544062400 -18000 1 -06}
{2567646000 -21600 0 -06}
{2575512000 -18000 1 -06}
{2599095600 -21600 0 -06}
{2606961600 -18000 1 -06}
{2630545200 -21600 0 -06}
{2638411200 -18000 1 -06}
{2661994800 -21600 0 -06}
{2669860800 -18000 1 -06}
{2693444400 -21600 0 -06}
{2701915200 -18000 1 -06}
{2725498800 -21600 0 -06}
{2733364800 -18000 1 -06}
{2756948400 -21600 0 -06}
{2764814400 -18000 1 -06}
{2788398000 -21600 0 -06}
{2796264000 -18000 1 -06}
{2819847600 -21600 0 -06}
{2827713600 -18000 1 -06}
{2851297200 -21600 0 -06}
{2859768000 -18000 1 -06}
{2883351600 -21600 0 -06}
{2891217600 -18000 1 -06}
{2914801200 -21600 0 -06}
{2922667200 -18000 1 -06}
{2946250800 -21600 0 -06}
{2954116800 -18000 1 -06}
{2977700400 -21600 0 -06}
{2985566400 -18000 1 -06}
{3009150000 -21600 0 -06}
{3017016000 -18000 1 -06}
{3040599600 -21600 0 -06}
{3049070400 -18000 1 -06}
{3072654000 -21600 0 -06}
{3080520000 -18000 1 -06}
{3104103600 -21600 0 -06}
{3111969600 -18000 1 -06}
{3135553200 -21600 0 -06}
{3143419200 -18000 1 -06}
{3167002800 -21600 0 -06}
{3174868800 -18000 1 -06}
{3198452400 -21600 0 -06}
{3206318400 -18000 1 -06}
{3230506800 -21600 0 -06}
{3238372800 -18000 1 -06}
{3261956400 -21600 0 -06}
{3269822400 -18000 1 -06}
{3293406000 -21600 0 -06}
{3301272000 -18000 1 -06}
{3324855600 -21600 0 -06}
{3332721600 -18000 1 -06}
{3356305200 -21600 0 -06}
{3364171200 -18000 1 -06}
{3387754800 -21600 0 -06}
{3396225600 -18000 1 -06}
{3419809200 -21600 0 -06}
{3427675200 -18000 1 -06}
{3451258800 -21600 0 -06}
{3459124800 -18000 1 -06}
{3482708400 -21600 0 -06}
{3490574400 -18000 1 -06}
{3514158000 -21600 0 -06}
{3522024000 -18000 1 -06}
{3545607600 -21600 0 -06}
{3553473600 -18000 1 -06}
{3577057200 -21600 0 -06}
{3585528000 -18000 1 -06}
{3609111600 -21600 0 -06}
{3616977600 -18000 1 -06}
{3640561200 -21600 0 -06}
{3648427200 -18000 1 -06}
{3672010800 -21600 0 -06}
{3679876800 -18000 1 -06}
{3703460400 -21600 0 -06}
{3711326400 -18000 1 -06}
{3734910000 -21600 0 -06}
{3743380800 -18000 1 -06}
{3766964400 -21600 0 -06}
{3774830400 -18000 1 -06}
{3798414000 -21600 0 -06}
{3806280000 -18000 1 -06}
{3829863600 -21600 0 -06}
{3837729600 -18000 1 -06}
{3861313200 -21600 0 -06}
{3869179200 -18000 1 -06}
{3892762800 -21600 0 -06}
{3900628800 -18000 1 -06}
{3924212400 -21600 0 -06}
{3932683200 -18000 1 -06}
{3956266800 -21600 0 -06}
{3964132800 -18000 1 -06}
{3987716400 -21600 0 -06}
{3995582400 -18000 1 -06}
{4019166000 -21600 0 -06}
{4027032000 -18000 1 -06}
{4050615600 -21600 0 -06}
{4058481600 -18000 1 -06}
{4082065200 -21600 0 -06}
{4089931200 -18000 1 -06}
{1554606000 -21600 0 -06}
{1567915200 -18000 1 -06}
{1586055600 -21600 0 -06}
{1599364800 -18000 1 -06}
{1617505200 -21600 0 -06}
{1630814400 -18000 1 -06}
{1648954800 -21600 0 -06}
{1662264000 -18000 1 -06}
{1680404400 -21600 0 -06}
{1693713600 -18000 1 -06}
{1712458800 -21600 0 -06}
{1725768000 -18000 1 -06}
{1743908400 -21600 0 -06}
{1757217600 -18000 1 -06}
{1775358000 -21600 0 -06}
{1788667200 -18000 1 -06}
{1806807600 -21600 0 -06}
{1820116800 -18000 1 -06}
{1838257200 -21600 0 -06}
{1851566400 -18000 1 -06}
{1870311600 -21600 0 -06}
{1883016000 -18000 1 -06}
{1901761200 -21600 0 -06}
{1915070400 -18000 1 -06}
{1933210800 -21600 0 -06}
{1946520000 -18000 1 -06}
{1964660400 -21600 0 -06}
{1977969600 -18000 1 -06}
{1996110000 -21600 0 -06}
{2009419200 -18000 1 -06}
{2027559600 -21600 0 -06}
{2040868800 -18000 1 -06}
{2059614000 -21600 0 -06}
{2072318400 -18000 1 -06}
{2091063600 -21600 0 -06}
{2104372800 -18000 1 -06}
{2122513200 -21600 0 -06}
{2135822400 -18000 1 -06}
{2153962800 -21600 0 -06}
{2167272000 -18000 1 -06}
{2185412400 -21600 0 -06}
{2198721600 -18000 1 -06}
{2217466800 -21600 0 -06}
{2230171200 -18000 1 -06}
{2248916400 -21600 0 -06}
{2262225600 -18000 1 -06}
{2280366000 -21600 0 -06}
{2293675200 -18000 1 -06}
{2311815600 -21600 0 -06}
{2325124800 -18000 1 -06}
{2343265200 -21600 0 -06}
{2356574400 -18000 1 -06}
{2374714800 -21600 0 -06}
{2388024000 -18000 1 -06}
{2406769200 -21600 0 -06}
{2419473600 -18000 1 -06}
{2438218800 -21600 0 -06}
{2451528000 -18000 1 -06}
{2469668400 -21600 0 -06}
{2482977600 -18000 1 -06}
{2501118000 -21600 0 -06}
{2514427200 -18000 1 -06}
{2532567600 -21600 0 -06}
{2545876800 -18000 1 -06}
{2564017200 -21600 0 -06}
{2577326400 -18000 1 -06}
{2596071600 -21600 0 -06}
{2609380800 -18000 1 -06}
{2627521200 -21600 0 -06}
{2640830400 -18000 1 -06}
{2658970800 -21600 0 -06}
{2672280000 -18000 1 -06}
{2690420400 -21600 0 -06}
{2703729600 -18000 1 -06}
{2721870000 -21600 0 -06}
{2735179200 -18000 1 -06}
{2753924400 -21600 0 -06}
{2766628800 -18000 1 -06}
{2785374000 -21600 0 -06}
{2798683200 -18000 1 -06}
{2816823600 -21600 0 -06}
{2830132800 -18000 1 -06}
{2848273200 -21600 0 -06}
{2861582400 -18000 1 -06}
{2879722800 -21600 0 -06}
{2893032000 -18000 1 -06}
{2911172400 -21600 0 -06}
{2924481600 -18000 1 -06}
{2943226800 -21600 0 -06}
{2955931200 -18000 1 -06}
{2974676400 -21600 0 -06}
{2987985600 -18000 1 -06}
{3006126000 -21600 0 -06}
{3019435200 -18000 1 -06}
{3037575600 -21600 0 -06}
{3050884800 -18000 1 -06}
{3069025200 -21600 0 -06}
{3082334400 -18000 1 -06}
{3101079600 -21600 0 -06}
{3113784000 -18000 1 -06}
{3132529200 -21600 0 -06}
{3145838400 -18000 1 -06}
{3163978800 -21600 0 -06}
{3177288000 -18000 1 -06}
{3195428400 -21600 0 -06}
{3208737600 -18000 1 -06}
{3226878000 -21600 0 -06}
{3240187200 -18000 1 -06}
{3258327600 -21600 0 -06}
{3271636800 -18000 1 -06}
{3290382000 -21600 0 -06}
{3303086400 -18000 1 -06}
{3321831600 -21600 0 -06}
{3335140800 -18000 1 -06}
{3353281200 -21600 0 -06}
{3366590400 -18000 1 -06}
{3384730800 -21600 0 -06}
{3398040000 -18000 1 -06}
{3416180400 -21600 0 -06}
{3429489600 -18000 1 -06}
{3447630000 -21600 0 -06}
{3460939200 -18000 1 -06}
{3479684400 -21600 0 -06}
{3492993600 -18000 1 -06}
{3511134000 -21600 0 -06}
{3524443200 -18000 1 -06}
{3542583600 -21600 0 -06}
{3555892800 -18000 1 -06}
{3574033200 -21600 0 -06}
{3587342400 -18000 1 -06}
{3605482800 -21600 0 -06}
{3618792000 -18000 1 -06}
{3637537200 -21600 0 -06}
{3650241600 -18000 1 -06}
{3668986800 -21600 0 -06}
{3682296000 -18000 1 -06}
{3700436400 -21600 0 -06}
{3713745600 -18000 1 -06}
{3731886000 -21600 0 -06}
{3745195200 -18000 1 -06}
{3763335600 -21600 0 -06}
{3776644800 -18000 1 -06}
{3794785200 -21600 0 -06}
{3808094400 -18000 1 -06}
{3826839600 -21600 0 -06}
{3839544000 -18000 1 -06}
{3858289200 -21600 0 -06}
{3871598400 -18000 1 -06}
{3889738800 -21600 0 -06}
{3903048000 -18000 1 -06}
{3921188400 -21600 0 -06}
{3934497600 -18000 1 -06}
{3952638000 -21600 0 -06}
{3965947200 -18000 1 -06}
{3984692400 -21600 0 -06}
{3997396800 -18000 1 -06}
{4016142000 -21600 0 -06}
{4029451200 -18000 1 -06}
{4047591600 -21600 0 -06}
{4060900800 -18000 1 -06}
{4079041200 -21600 0 -06}
{4092350400 -18000 1 -06}
}
+12 -12
View File
@@ -26,7 +26,7 @@ set TZData(:Pacific/Fiji) {
{1509804000 46800 1 +12}
{1515852000 43200 0 +12}
{1541253600 46800 1 +12}
{1547906400 43200 0 +12}
{1547301600 43200 0 +12}
{1572703200 46800 1 +12}
{1579356000 43200 0 +12}
{1604152800 46800 1 +12}
@@ -48,7 +48,7 @@ set TZData(:Pacific/Fiji) {
{1856959200 46800 1 +12}
{1863007200 43200 0 +12}
{1888408800 46800 1 +12}
{1895061600 43200 0 +12}
{1894456800 43200 0 +12}
{1919858400 46800 1 +12}
{1926511200 43200 0 +12}
{1951308000 46800 1 +12}
@@ -60,7 +60,7 @@ set TZData(:Pacific/Fiji) {
{2046261600 46800 1 +12}
{2052309600 43200 0 +12}
{2077711200 46800 1 +12}
{2084364000 43200 0 +12}
{2083759200 43200 0 +12}
{2109160800 46800 1 +12}
{2115813600 43200 0 +12}
{2140610400 46800 1 +12}
@@ -70,7 +70,7 @@ set TZData(:Pacific/Fiji) {
{2204114400 46800 1 +12}
{2210162400 43200 0 +12}
{2235564000 46800 1 +12}
{2242216800 43200 0 +12}
{2241612000 43200 0 +12}
{2267013600 46800 1 +12}
{2273666400 43200 0 +12}
{2298463200 46800 1 +12}
@@ -82,7 +82,7 @@ set TZData(:Pacific/Fiji) {
{2393416800 46800 1 +12}
{2399464800 43200 0 +12}
{2424866400 46800 1 +12}
{2431519200 43200 0 +12}
{2430914400 43200 0 +12}
{2456316000 46800 1 +12}
{2462968800 43200 0 +12}
{2487765600 46800 1 +12}
@@ -104,7 +104,7 @@ set TZData(:Pacific/Fiji) {
{2740572000 46800 1 +12}
{2746620000 43200 0 +12}
{2772021600 46800 1 +12}
{2778674400 43200 0 +12}
{2778069600 43200 0 +12}
{2803471200 46800 1 +12}
{2810124000 43200 0 +12}
{2834920800 46800 1 +12}
@@ -116,7 +116,7 @@ set TZData(:Pacific/Fiji) {
{2929874400 46800 1 +12}
{2935922400 43200 0 +12}
{2961324000 46800 1 +12}
{2967976800 43200 0 +12}
{2967372000 43200 0 +12}
{2992773600 46800 1 +12}
{2999426400 43200 0 +12}
{3024223200 46800 1 +12}
@@ -126,7 +126,7 @@ set TZData(:Pacific/Fiji) {
{3087727200 46800 1 +12}
{3093775200 43200 0 +12}
{3119176800 46800 1 +12}
{3125829600 43200 0 +12}
{3125224800 43200 0 +12}
{3150626400 46800 1 +12}
{3157279200 43200 0 +12}
{3182076000 46800 1 +12}
@@ -138,7 +138,7 @@ set TZData(:Pacific/Fiji) {
{3277029600 46800 1 +12}
{3283077600 43200 0 +12}
{3308479200 46800 1 +12}
{3315132000 43200 0 +12}
{3314527200 43200 0 +12}
{3339928800 46800 1 +12}
{3346581600 43200 0 +12}
{3371378400 46800 1 +12}
@@ -160,7 +160,7 @@ set TZData(:Pacific/Fiji) {
{3624184800 46800 1 +12}
{3630232800 43200 0 +12}
{3655634400 46800 1 +12}
{3662287200 43200 0 +12}
{3661682400 43200 0 +12}
{3687084000 46800 1 +12}
{3693736800 43200 0 +12}
{3718533600 46800 1 +12}
@@ -172,7 +172,7 @@ set TZData(:Pacific/Fiji) {
{3813487200 46800 1 +12}
{3819535200 43200 0 +12}
{3844936800 46800 1 +12}
{3851589600 43200 0 +12}
{3850984800 43200 0 +12}
{3876386400 46800 1 +12}
{3883039200 43200 0 +12}
{3907836000 46800 1 +12}
@@ -182,7 +182,7 @@ set TZData(:Pacific/Fiji) {
{3971340000 46800 1 +12}
{3977388000 43200 0 +12}
{4002789600 46800 1 +12}
{4009442400 43200 0 +12}
{4008837600 43200 0 +12}
{4034239200 46800 1 +12}
{4040892000 43200 0 +12}
{4065688800 46800 1 +12}
+3 -2
View File
@@ -4,8 +4,9 @@ set TZData(:Pacific/Honolulu) {
{-9223372036854775808 -37886 0 LMT}
{-2334101314 -37800 0 HST}
{-1157283000 -34200 1 HDT}
{-1155436200 -37800 0 HST}
{-880198200 -34200 1 HDT}
{-1155436200 -34200 0 HST}
{-880201800 -34200 1 HWT}
{-769395600 -34200 1 HPT}
{-765376200 -37800 0 HST}
{-712150200 -36000 0 HST}
}
+6 -2
View File
@@ -13,10 +13,14 @@
package prefer latest
package require Tcl 8.5-
package require tcltest 2.2
namespace import tcltest::*
configure {*}$argv -testdir [file dir [info script]]
namespace import ::tcltest::*
configure {*}$argv -testdir [file dirname [file dirname [file normalize [
info script]/...]]]
if {[singleProcess]} {
interp debug {} -frame 1
}
runAllTests
proc exit args {}
+29 -11
View File
@@ -157,17 +157,24 @@ test async-4.1 {async interrupting bytecode sequence} -constraints {
}
} -body {
apply {{handle} {
global aresult
set aresult {Async event not delivered}
testasync marklater $handle
for {set i 0} {
$i < 2500000 && $aresult eq "Async event not delivered"
} {incr i} {
nothing
}
global aresult
set aresult {Async event not delivered}
testasync marklater $handle
# allow plenty of time to pass in case valgrind is running
set start [clock seconds]
while {
[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
} {
# be less busy
after 100
nothing
}
return $aresult
}} $hm
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
@@ -179,12 +186,20 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
global aresult
set aresult {Async event not delivered}
testasync marklater $handle
for {set i 0} {
$i < 2500000 && $aresult eq "Async event not delivered"
} {incr i} {}
# allow plenty of time to pass in case valgrind is running
set start [clock seconds]
while {
[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
} {
# be less busy
after 100
}
return $aresult
}} $hm
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
@@ -201,6 +216,9 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
return $aresult
}]] $hm
} -result {test pattern} -cleanup {
# give other threads some time to go way so that valgrind doesn't pick up
# "still reachable" cases from early thread termination
after 100
testasync delete $hm
}
+4 -11
View File
@@ -13,16 +13,11 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# TODO: This test is likely worthless. Confirm and remove
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testbytestring [llength [info commands testbytestring]]
namespace eval ::tcl::test::io {
namespace import ::tcltest::*
@@ -35,18 +30,16 @@ namespace eval ::tcl::test::io {
variable msg
variable expected
::tcltest::loadTestedCommands
loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
testConstraint fileevent [llength [info commands fileevent]]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# You need a *very* special environment to do some tests. In particular,
# many file systems do not support large-files...
+22 -7
View File
@@ -23,7 +23,7 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint linkDirectory [expr {
![testConstraint win] ||
([string index $tcl_platform(osVersion) 0] >= 5
($::tcl_platform(osVersion) >= 5.0
&& [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
@@ -1040,7 +1040,7 @@ test cmdAH-20.7.1 {
Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
file atime [file join [temporaryDirectory] CON.txt]
} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
} -match regexp -result {could not (?:get access time|read)} -returnCodes error
if {[testConstraint unix] && [file exists /tmp]} {
removeFile touch.me /tmp
@@ -1281,7 +1281,7 @@ test cmdAH-24.14.1 {
Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
file mtime [file join [temporaryDirectory] CON.txt]
} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error
# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
@@ -1345,7 +1345,12 @@ test cmdAH-27.4 {
test cmdAH-27.4.1 {
Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
} -constraints {win} -body {
file size [file join [temporaryDirectory] con.txt]
try {
set res [file size [file join [temporaryDirectory] con.txt]]
} trap {POSIX ENOENT} {} {
set res 0
}
set res
} -result 0
catch {testsetplatform $platform}
@@ -1447,8 +1452,13 @@ test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {w
test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
unset -nocomplain stat
} -body {
file stat [file join [temporaryDirectory] CON.txt] stat
lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
try {
file stat [file join [temporaryDirectory] CON.txt] stat
set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
} trap {POSIX ENOENT} {} {
set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
}
set res
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat
@@ -1498,7 +1508,12 @@ test cmdAH-29.6 {
test cmdAH-29.6.1 {
Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
} -constraints {win} -body {
file type [file join [temporaryDirectory] CON.txt]
try {
set res [file type [file join [temporaryDirectory] CON.txt]]
} trap {POSIX ENOENT} {} {
set res {characterSpecial}
}
set res
} -result "characterSpecial"
# Error conditions
+235 -170
View File
@@ -16,49 +16,96 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
# Some tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
#
# These tests will run on any platform (and indeed crashed on the Mac). So put
# them before you test for the existance of exec.
#
test env-1.1 {propagation of env values to child interpreters} -setup {
catch {interp delete child}
catch {unset env(test)}
} -body {
interp create child
set env(test) garbage
child eval {set env(test)}
} -cleanup {
interp delete child
unset env(test)
} -result {garbage}
#
# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
# runs.
#
test env-1.2 {lappend to env value} -setup {
catch {unset env(test)}
} -body {
set env(test) aaaaaaaaaaaaaaaa
append env(test) bbbbbbbbbbbbbb
unset env(test)
}
test env-1.3 {reflection of env by "array names"} -setup {
catch {interp delete child}
catch {unset env(test)}
} -body {
interp create child
child eval {set env(test) garbage}
expr {"test" in [array names env]}
} -cleanup {
interp delete child
catch {unset env(test)}
} -result {1}
package require tcltests
set printenvScript [makeFile {
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
global printenvScript
catch {exec [interpreter] $printenvScript} out
if {$out eq "child process exited abnormally"} {
set out {}
}
return $out
}
proc envrestore {} {
# Restore the environment variables at the end of the test.
global env
variable env2
foreach name [array names env] {
unset env($name)
}
array set env $env2
return
}
proc envprep {} {
# Save the current environment variables at the start of the test.
global env
variable keep
variable env2
set env2 [array get env]
foreach name [array names env] {
# Keep some environment variables that support operation of the tcltest
# package.
if {[string toupper $name] ni [string toupper $keep]} {
unset env($name)
}
}
return
}
proc encodingrestore {} {
variable sysenc
encoding system $sysenc
return
}
proc encodingswitch encoding {
variable sysenc
# Need to run [getenv] in known encoding, so save the current one here...
set sysenc [encoding system]
encoding system $encoding
return
}
proc setup1 {} {
global env
envprep
encodingswitch iso8859-1
}
proc setup2 {} {
global env
setup1
set env(NAME1) {test string}
set env(NAME2) {new value}
set env(XYZZY) {garbage}
}
proc cleanup1 {} {
encodingrestore
envrestore
}
variable keep {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
}
variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
encoding system iso8859-1
proc lrem {listname name} {
upvar $listname list
@@ -70,7 +117,7 @@ set printenvScript [makeFile {
}
proc mangle s {
regsub -all {\[|\\|\]} $s {\\&} s
regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s
return [subst -novariables $s]
}
proc manglechar c {
@@ -84,161 +131,154 @@ set printenvScript [makeFile {
lrem names ComSpec
lrem names ""
}
foreach name {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
} {
foreach name @keep@ {
lrem names $name
}
foreach p $names {
puts "[mangle $p]=[mangle $env($p)]"
puts [mangle $p]=[mangle $env($p)]
}
exit
} printenv]
}] printenv]
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
global printenvScript tcltest
catch {exec [interpreter] $printenvScript} out
if {$out eq "child process exited abnormally"} {
set out {}
}
return $out
test env-1.1 {propagation of env values to child interpreters} -setup {
catch {interp delete child}
catch {unset env(test)}
} -body {
interp create child
set env(test) garbage
child eval {set env(test)}
} -cleanup {
interp delete child
unset env(test)
} -result {garbage}
# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
# runs.
test env-1.2 {lappend to env value} -setup {
catch {unset env(test)}
} -body {
set env(test) aaaaaaaaaaaaaaaa
append env(test) bbbbbbbbbbbbbb
unset env(test)
}
# Save the current environment variables at the start of the test.
set env2 [array get env]
foreach name [array names env] {
# Keep some environment variables that support operation of the tcltest
# package.
if {[string toupper $name] ni {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
SECURITYSESSIONID LANG WINDIR TERM
CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
}} {
unset env($name)
}
}
# Need to run 'getenv' in known encoding, so save the current one here...
set sysenc [encoding system]
test env-2.1 {adding environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
getenv
test env-1.3 {reflection of env by "array names"} -setup {
catch {interp delete child}
catch {unset env(test)}
} -body {
interp create child
child eval {set env(test) garbage}
expr {"test" in [array names env]}
} -cleanup {
encoding system $sysenc
} -result {}
test env-2.2 {adding environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
interp delete child
catch {unset env(test)}
} -result 1
test env-2.1 {
adding environment variables
} -constraints exec -setup setup1 -body {
getenv
} -cleanup cleanup1 -result {}
test env-2.2 {
adding environment variables
} -constraints exec -setup setup1 -body {
set env(NAME1) "test string"
getenv
} -cleanup {
encoding system $sysenc
} -result {NAME1=test string}
test env-2.3 {adding environment variables} -setup {
encoding system iso8859-1
} -cleanup cleanup1 -result {NAME1=test string}
test env-2.3 {adding environment variables} -constraints exec -setup {
setup1
set env(NAME1) "test string"
} -constraints {exec} -body {
} -body {
set env(NAME2) "more"
getenv
} -cleanup {
encoding system $sysenc
} -result {NAME1=test string
} -cleanup cleanup1 -result {NAME1=test string
NAME2=more}
test env-2.4 {adding environment variables} -setup {
encoding system iso8859-1
test env-2.4 {
adding environment variables
} -constraints exec -setup {
setup1
set env(NAME1) "test string"
set env(NAME2) "more"
} -constraints {exec} -body {
} -body {
set env(XYZZY) "garbage"
getenv
} -cleanup {
encoding system $sysenc
} -cleanup { cleanup1
} -result {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME1) "test string"
set env(NAME2) "new value"
set env(XYZZY) "garbage"
test env-3.1 {changing environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
test env-3.1 {
changing environment variables
} -constraints exec -setup setup2 -body {
set result [getenv]
unset env(NAME2)
set result
} -cleanup {
encoding system $sysenc
cleanup1
} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
unset -nocomplain env(NAME2)
test env-4.1 {unsetting environment variables: default} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
test env-4.1 {
unsetting environment variables
} -constraints exec -setup setup2 -body {
unset -nocomplain env(NAME2)
getenv
} -cleanup {
encoding system $sysenc
} -result {NAME1=test string
} -cleanup cleanup1 -result {NAME1=test string
XYZZY=garbage}
test env-4.2 {unsetting environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
unset env(NAME1)
getenv
} -cleanup {
unset env(XYZZY)
encoding system $sysenc
} -result {XYZZY=garbage}
unset -nocomplain env(NAME1) env(XYZZY)
test env-4.3 {setting international environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
# env-4.2 is deleted
test env-4.3 {
setting international environment variables
} -constraints exec -setup setup1 -body {
set env(\ua7) \ub6
getenv
} -cleanup {
encoding system $sysenc
} -result {\u00a7=\u00b6}
test env-4.4 {changing international environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
} -cleanup cleanup1 -result {\u00a7=\u00b6}
test env-4.4 {
changing international environment variables
} -constraints exec -setup setup1 -body {
set env(\ua7) \ua7
getenv
} -cleanup {
encoding system $sysenc
} -result {\u00a7=\u00a7}
test env-4.5 {unsetting international environment variables} -setup {
encoding system iso8859-1
} -cleanup cleanup1 -result {\u00a7=\u00a7}
test env-4.5 {
unsetting international environment variables
} -constraints exec -setup {
setup1
set env(\ua7) \ua7
} -body {
set env(\ub6) \ua7
unset env(\ua7)
getenv
} -constraints {exec} -cleanup {
unset env(\ub6)
encoding system $sysenc
} -result {\u00b6=\u00a7}
} -cleanup cleanup1 -result {\u00b6=\u00a7}
test env-5.0 {corner cases - set a value, it should exist} -body {
test env-5.0 {
corner cases - set a value, it should exist
} -setup setup1 -body {
set env(temp) a
set env(temp)
} -cleanup {
unset env(temp)
} -result {a}
test env-5.1 {corner cases - remove one elem at a time} -setup {
set x [array get env]
} -body {
} -cleanup cleanup1 -result a
test env-5.1 {
corner cases - remove one elem at a time
} -setup setup1 -body {
# When no environment variables exist, the env var will contain no
# entries. The "array names" call synchs up the C-level environ array with
# the Tcl level env array. Make sure an empty Tcl array is created.
@@ -246,9 +286,9 @@ test env-5.1 {corner cases - remove one elem at a time} -setup {
unset env($e)
}
array size env
} -cleanup {
array set env $x
} -result {0}
} -cleanup cleanup1 -result 0
test env-5.2 {corner cases - unset the env array} -setup {
interp create i
} -body {
@@ -262,42 +302,54 @@ test env-5.2 {corner cases - unset the env array} -setup {
} -cleanup {
interp delete i
} -result {0}
test env-5.3 {corner cases: unset the env in master should unset child} -setup {
setup1
interp create i
} -body {
# Variables deleted in a master interp should be deleted in child interp
# too.
i eval { set env(THIS_SHOULD_EXIST) a}
i eval {set env(THIS_SHOULD_EXIST) a}
set result [set env(THIS_SHOULD_EXIST)]
unset env(THIS_SHOULD_EXIST)
lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
} -cleanup {
cleanup1
interp delete i
} -result {a 1}
test env-5.4 {corner cases - unset the env array} -setup {
setup1
interp create i
} -body {
# The info exists command should be in synch with the env array.
# Know Bug: 1737
i eval { set env(THIS_SHOULD_EXIST) a}
i eval {set env(THIS_SHOULD_EXIST) a}
set result [info exists env(THIS_SHOULD_EXIST)]
lappend result [set env(THIS_SHOULD_EXIST)]
lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
cleanup1
interp delete i
} -result {1 a 1}
test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
test env-5.5 {
corner cases - cannot have null entries on Windows
} -constraints win -body {
set env() a
catch {set env()}
} -result 1
} -cleanup cleanup1 -result 1
test env-6.1 {corner cases - add lots of env variables} -body {
test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
set size [array size env]
for {set i 0} {$i < 100} {incr i} {
set env(BOGUS$i) $i
}
expr {[array size env] - $size}
} -result 100
} -cleanup cleanup1 -result 100
test env-7.1 {[219226]: whole env array should not be unset by read} -body {
set n [array size env]
@@ -310,16 +362,20 @@ test env-7.1 {[219226]: whole env array should not be unset by read} -body {
return $n
} -result 0
test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
test env-7.2 {
[219226]: links to env elements should not be removed by read
} -setup setup1 -body {
apply {{} {
set ::env(test7_2) ok
upvar env(test7_2) elem
set ::env(PATH)
return $elem
}}
} -result ok
} -cleanup cleanup1 -result ok
test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
test env-7.3 {
[9b4702]: testing existence of env(some_thing) should not destroy trace
} -setup setup1 -body {
apply {{} {
catch {unset ::env(test7_3)}
proc foo args {
@@ -330,16 +386,25 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
set ::env(not_yet_existent) "Now I'm here";
return [info exists ::env(test7_3)]
}}
} -result 1
} -cleanup cleanup1 -result 1
# Restore the environment variables at the end of the test.
test env-8.0 {
memory usage - valgrind does not report reachable memory
} -body {
set res [set env(__DUMMY__) {i'm with dummy}]
unset env(__DUMMY__)
return $res
} -result {i'm with dummy}
foreach name [array names env] {
unset env($name)
}
array set env $env2
# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}
removeFile $printenvScript
::tcltest::cleanupTests
return
+15 -10
View File
@@ -11,9 +11,14 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.
package require tcltest 2
namespace import -force ::tcltest::*
package require tcltests
# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
@@ -325,11 +330,11 @@ test exec-8.2 {long input and output} {exec} {
# Commands that return errors.
test exec-9.1 {commands returning errors} {exec} {
test exec-9.1 {commands returning errors} {exec notValgrind} {
set x [catch {exec gorp456} msg]
list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.2 {commands returning errors} {exec} {
test exec-9.2 {commands returning errors} {exec notValgrind} {
string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
@@ -339,7 +344,7 @@ test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
} -returnCodes error -result {foo bar
child process exited abnormally}
test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body {
exec gorp456 | [interpreter] echo a b c
} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
test exec-9.6 {commands returning errors} -constraints {exec} -body {
@@ -428,13 +433,13 @@ test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
test exec-10.22 {errors in exec invocation} -constraints exec -body {
test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec echo test > ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
# Commands in background.
@@ -510,7 +515,7 @@ test exec-13.1 {setting errorCode variable} {exec} {
test exec-13.2 {setting errorCode variable} {exec} {
list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.3 {setting errorCode variable} {exec} {
test exec-13.3 {setting errorCode variable} {exec notValgrind} {
set x [catch {exec _weird_cmd_} msg]
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
@@ -548,7 +553,7 @@ test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
test exec-14.3 {unknown switch} -constraints {exec} -body {
exec -gorp
} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
test exec-14.4 {-- switch} -constraints {exec} -body {
test exec-14.4 {-- switch} -constraints {exec notValgrind} -body {
exec -- -gorp
} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
test exec-14.5 {-ignorestderr switch} {exec} {
@@ -662,7 +667,7 @@ test exec-18.2 {exec cat deals with weird file names} -body {
# Note that this test cannot be adapted to work on Windows; that platform has
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
# that there is a POSIX shell...
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind} -setup {
set tmpfile [makeFile {0} tmpfile.exec-19.1]
} -body {
# Note that we have to allow for the current contents of the temporary
@@ -675,7 +680,7 @@ test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
{for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
exec /bin/sh -c \
{for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
# The above four shell invokations take about 3 seconds to finish, so allow
# The above four shell invocations take about 3 seconds to finish, so allow
# 5s (in case the machine is busy)
after 5000
# Check that no bytes have got lost through mixups with overlapping
+9
View File
@@ -7196,6 +7196,15 @@ test expr-51.1 {test round-to-even on input} {
expr 6.9294956446009195e15
} 6929495644600920.0
test expr-52.1 {
comparison with empty string does not generate string representation
} {
set a [list one two three]
list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
string match {*no string representation*} [
::tcl::unsupported::representation $a]]
} {0 0 1 1}
# cleanup
+5 -6
View File
@@ -65,11 +65,10 @@ if {[testConstraint unix]} {
# Also used in winFCmd...
if {[testConstraint win]} {
set major [string index $tcl_platform(osVersion) 0]
if {[testConstraint nt] && $major > 4} {
if {$major > 5} {
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
if {$::tcl_platform(osVersion) >= 6.0} {
testConstraint winVista 1
} elseif {$major == 5} {
} else {
testConstraint win2000orXP 1
}
}
@@ -78,7 +77,7 @@ if {[testConstraint win]} {
testConstraint darwin9 [expr {
[testConstraint unix]
&& $tcl_platform(os) eq "Darwin"
&& [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
&& [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
@@ -2309,7 +2308,7 @@ test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
if {
[testConstraint win] &&
([string index $tcl_platform(osVersion) 0] < 5
($::tcl_platform(osVersion) < 5.0
|| [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
} then {
testConstraint linkDirectory 0
+1 -1
View File
@@ -23,7 +23,7 @@ testConstraint testtranslatefilename [llength [info commands testtranslatefilena
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
if {[string index $tcl_platform(osVersion) 0] < 5 \
if {$::tcl_platform(osVersion) < 5.0 \
|| [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
testConstraint linkDirectory 0
}
+6
View File
@@ -264,6 +264,12 @@ removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} -body {
file normalize ~noonewiththisname
} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.30.1 {normalisation of existing user} -body {
catch {file normalize ~$::tcl_platform(user)}
} -result {0}
test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
file normalize ~nonexistentuser@nonexistentdomain
} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform unix
file normalize /foo/../bar
+14
View File
@@ -585,6 +585,20 @@ test format-19.3 {Bug 2830354} {
string length [format %340f 0]
} 340
test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \
-constraints {longIs32bit} -body {
# in case of overflow into negative, it produces width -2 (and limit exceeded),
# in case of width will be unsigned, it will be outside limit (2GB for 32bit)...
# and it don't throw an error in case the bug is not fixed (and probably no segfault).
format %[expr {0xffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"
test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
# limit should exceeds in any case,
# and it don't throw an error in case the bug is not fixed (and probably no segfault).
format %[expr {0xffffffffffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"
# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
set x [dict create a b c d]
+3 -3
View File
@@ -86,7 +86,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
test http-1.1 {http::config} {
http::config -useragent UserAgent
http::config
} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
test http-1.2 {http::config} {
http::config -proxyfilter
} http::ProxyRequired
@@ -101,10 +101,10 @@ test http-1.4 {http::config} {
set x [http::config]
http::config {*}$savedconf
set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
test http-1.5 {http::config} -returnCodes error -body {
http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
test http-1.6 {http::config} -setup {
set oldenc [http::config -urlencoding]
} -body {
+8 -4
View File
@@ -515,10 +515,7 @@ proc handler {var sock token} {
set chunk [read $sock]
append data $chunk
#::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
if {[eof $sock]} {
#::http::Log "handler eof $sock"
chan event $sock readable {}
}
return [string length $chunk]
}
test http11-3.0 "-handler,close,identity" -setup {
@@ -666,6 +663,13 @@ test http11-4.3 "normal post request, check channel query length" -setup {
# -------------------------------------------------------------------------
# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}
foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
if {[llength [info proc $p]]} {rename $p {}}
}
+866
View File
@@ -0,0 +1,866 @@
# httpPipeline.test
#
# Test HTTP/1.1 concurrent requests including
# queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2
namespace import -force ::tcltest::*
package require http 2.8
set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
source [file join $sourcedir httpTestScript.tcl]
# ------------------------------------------------------------------------------
# (1) Define the test scripts that will be used to generate logs for analysis -
# and also define the "correct" results.
# ------------------------------------------------------------------------------
proc ReturnTestScriptAndResult {ca cb delay te} {
switch -- $ca {
1 {set start {
START
KEEPALIVE 0
PIPELINE 0
}}
2 {set start {
START
KEEPALIVE 0
PIPELINE 1
}}
3 {set start {
START
KEEPALIVE 1
PIPELINE 0
}}
4 {set start {
START
KEEPALIVE 1
PIPELINE 1
}}
default {
return -code error {no matching script}
}
}
set middle "
[list DELAY $delay]
"
switch -- $cb {
1 {set end {
GET a
GET b
GET c
GET a
STOP
}
set resShort {1 ? ? ?}
set resLong {1 2 3 4}
}
2 {set end {
GET a
HEAD b
GET c
HEAD a
HEAD c
STOP
}
set resShort {1 ? ? ? ?}
set resLong {1 2 3 4 5}
}
3 {set end {
HEAD a
GET b
HEAD c
HEAD b
GET a
GET b
STOP
}
set resShort {1 ? ? ? ? ?}
set resLong {1 2 3 4 5 6}
}
4 {set end {
GET a
GET b
GET c
GET a
POST b address=home code=brief paid=yes
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 ? ? ? 5 ? ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
5 {set end {
POST a address=home code=brief paid=yes
POST b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
POST a address=home code=brief paid=yes
POST b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
POST a address=home code=brief paid=yes
POST b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
STOP
}
set resShort {1 2 3 4 5 6 7 8 9}
set resLong {1 2 3 4 5 6 7 8 9}
}
6 {set end {
POST a address=home code=brief paid=yes
GET b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
GET a address=home code=brief paid=yes
GET b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
POST a address=home code=brief paid=yes
HEAD b address=home code=brief paid=yes
GET c address=home code=brief paid=yes
STOP
}
set resShort {1 ? 3 ? ? 6 7 ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
7 {set end {
GET b address=home code=brief paid=yes
POST a address=home code=brief paid=yes
GET a address=home code=brief paid=yes
POST c address=home code=brief paid=yes
GET b address=home code=brief paid=yes
HEAD b address=home code=brief paid=yes
POST c address=home code=brief paid=yes
POST a address=home code=brief paid=yes
GET c address=home code=brief paid=yes
STOP
}
set resShort {1 2 ? 4 ? ? 7 8 ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
8 {set end {
# Telling the server to close the connection.
GET a
GET b close=y
GET c
GET a
GET b
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 ? 3 ? ? ? ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
9 {set end {
# Telling the server to close the connection.
GET a
POST b close=y address=home code=brief paid=yes
GET c
GET a
GET b
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 2 3 ? ? ? ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
10 {set end {
# Telling the server to close the connection.
GET a
GET b close=y
POST c address=home code=brief paid=yes
GET a
GET b
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 ? 3 ? ? ? ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
11 {set end {
# Telling the server to close the connection twice.
GET a
GET b close=y
GET c
GET a
GET b close=y
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 ? 3 ? ? 6 ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
12 {set end {
# Telling the server to delay before sending the response.
GET a
GET b delay=1
GET c
GET a
GET b
STOP
}
set resShort {1 ? ? ? ?}
set resLong {1 2 3 4 5}
}
13 {set end {
# Making the server close the connection (time out).
GET a
WAIT 2000
GET b
GET c
GET a
GET b
STOP
}
set resShort {1 2 ? ? ?}
set resLong {1 2 3 4 5}
}
14 {set end {
# Making the server close the connection (time out) twice.
GET a
WAIT 2000
GET b
GET c
GET a
WAIT 2000
GET b
GET c
GET a
GET b
GET c
STOP
}
set resShort {1 2 ? ? 5 ? ? ? ?}
set resLong {1 2 3 4 5 6 7 8 9}
}
15 {set end {
POST a address=home code=brief paid=yes
POST b address=home code=brief paid=yes close=y delay=1
POST c address=home code=brief paid=yes delay=1
POST a address=home code=brief paid=yes close=y
WAIT 2000
POST b address=home code=brief paid=yes delay=1
POST c address=home code=brief paid=yes close=y
POST a address=home code=brief paid=yes
POST b address=home code=brief paid=yes close=y
POST c address=home code=brief paid=yes
STOP
}
set resShort {1 2 3 4 5 6 7 8 9}
set resLong {1 2 3 4 5 6 7 8 9}
}
16 {set end {
POST a address=home code=brief paid=yes
GET b address=home code=brief paid=yes
POST c address=home code=brief paid=yes close=y
GET a address=home code=brief paid=yes
GET b address=home code=brief paid=yes close=y
POST c address=home code=brief paid=yes
WAIT 2000
POST a address=home code=brief paid=yes
HEAD b address=home code=brief paid=yes close=y
GET c address=home code=brief paid=yes
STOP
}
set resShort {1 ? 3 4 ? 6 7 ? 9}
set resLong {1 2 3 4 5 6 7 8 9}
}
17 {set end {
GET b address=home code=brief paid=yes
POST a address=home code=brief paid=yes
GET a address=home code=brief paid=yes
POST c address=home code=brief paid=yes close=y
GET b address=home code=brief paid=yes
HEAD b address=home code=brief paid=yes close=y
POST c address=home code=brief paid=yes
WAIT 2000
POST a address=home code=brief paid=yes
WAIT 2000
GET c address=home code=brief paid=yes
STOP
}
set resShort {1 2 3 4 5 ? 7 8 9}
set resLong {1 2 3 4 5 6 7 8 9}
}
18 {set end {
REPOST 0
GET a
WAIT 2000
POST b address=home code=brief paid=yes
GET c
GET a
STOP
}
set resShort {1 2 ? ?}
set resLong {1 2 3 4}
# resShort is overwritten below for the case ($te == 1).
}
19 {set end {
REPOST 0
GET a
WAIT 2000
GET b address=home code=brief paid=yes
GET c
GET a
STOP
}
set resShort {1 2 ? ?}
set resLong {1 2 3 4}
}
20 {set end {
POSTFRESH 1
GET a
WAIT 2000
POST b address=home code=brief paid=yes
GET c
GET a
STOP
}
set resShort {1 3 ?}
set resLong {1 3 4}
}
21 {set end {
POSTFRESH 1
GET a
WAIT 2000
GET b address=home code=brief paid=yes
GET c
GET a
STOP
}
set resShort {1 2 ? ?}
set resLong {1 2 3 4}
}
22 {set end {
GET a
WAIT 2000
KEEPALIVE 0
POST b address=home code=brief paid=yes
KEEPALIVE 1
GET c
GET a
STOP
}
set resShort {1 3 ?}
set resLong {1 3 4}
}
23 {set end {
GET a
WAIT 2000
KEEPALIVE 0
GET b address=home code=brief paid=yes
KEEPALIVE 1
GET c
GET a
STOP
}
set resShort {1 3 ?}
set resLong {1 3 4}
}
24 {set end {
GET a
KEEPALIVE 0
POST b address=home code=brief paid=yes
KEEPALIVE 1
GET c
GET a
STOP
}
set resShort {1 ? ?}
set resLong {1 3 4}
}
25 {set end {
GET a
KEEPALIVE 0
GET b address=home code=brief paid=yes
KEEPALIVE 1
GET c
GET a
STOP
}
set resShort {1 ? ?}
set resLong {1 3 4}
}
default {
return -code error {no matching script}
}
}
if {$ca < 3} {
# Not Keep-Alive.
set result "Passed all sanity checks."
} elseif {$ca == 3} {
# Keep-Alive, not pipelined.
set result {}
append result "Passed all sanity checks.\n"
append result "Have overlaps including response body:\n"
} else {
# Keep-Alive, pipelined: ($ca == 4)
set result {}
append result "Passed all sanity checks.\n"
append result "Overlap-free without response body:\n"
append result "$resShort"
}
# - The special case of test *.18*-testEof needs test results to be
# individually written.
# - These test -repost 0 when there is a POST to apply it to, and the server
# timeout has not been detected.
if {($cb == 18) && ($te == 1)} {
if {$ca < 3} {
# Not Keep-Alive.
set result "Passed all sanity checks."
} elseif {$ca == 3 && $delay == 0} {
# Keep-Alive, not pipelined.
set result [MakeMessage {
|Problems with sanity checks:
|Wrong sequence for token ::http::2 - {A B C D X X X}
|- and error(s) X
|Wrong sequence for token ::http::3 - {A X X}
|- and error(s) X
|Wrong sequence for token ::http::4 - {A X X X}
|- and error(s) X
|
|Have overlaps including response body:
|
}]
} elseif {$ca == 3} {
# Keep-Alive, not pipelined.
set result [MakeMessage {
|Problems with sanity checks:
|Wrong sequence for token ::http::2 - {A B C D X X X}
|- and error(s) X
|
|Have overlaps including response body:
|
}]
} elseif {$delay == 0} {
# Keep-Alive, pipelined: ($ca == 4)
set result [MakeMessage {
|Problems with sanity checks:
|Wrong sequence for token ::http::2 - {A B C D X X X}
|- and error(s) X
|Wrong sequence for token ::http::3 - {A X X}
|- and error(s) X
|Wrong sequence for token ::http::4 - {A X X X}
|- and error(s) X
|
|Overlap-free without response body:
|
}]
} else {
set result [MakeMessage {
|Problems with sanity checks:
|Wrong sequence for token ::http::2 - {A B C D X X X}
|- and error(s) X
|
|Overlap-free without response body:
|
}]
}
}
return [list "$start$middle$end" $result]
}
# ------------------------------------------------------------------------------
# Proc MakeMessage
# ------------------------------------------------------------------------------
# WHD's one-line command to generate multi-line strings from readable code.
#
# Example:
# set blurb [MakeMessage {
# |This command allows multi-line strings to be created with readable
# |code, and without breaking the rules for indentation.
# |
# |The command shifts the entire block of text to the left, omitting
# |the pipe character and the spaces to its left.
# }]
# ------------------------------------------------------------------------------
proc MakeMessage {in} {
regsub -all -line {^\s*\|} [string trim $in] {}
# N.B. Implicit Return.
}
proc ReturnTestScript {ca cb delay te} {
lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
return $script
}
proc ReturnTestResult {ca cb delay te} {
lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
return $result
}
# ------------------------------------------------------------------------------
# (2) Command to run a test script and use httpTest to analyse the logs.
# ------------------------------------------------------------------------------
namespace import httpTestScript::runHttpTestScript
namespace import httpTestScript::cleanupHttpTestScript
namespace import httpTest::cleanupHttpTest
namespace import httpTest::logAnalyse
namespace import httpTest::setHttpTestOptions
proc RunTest {header footer delay te} {
set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
set skipOverlaps 0
set notPiped {}
set notIncluded {}
# --------------------------------------------------------------------------
# Custom code for specific tests
# --------------------------------------------------------------------------
if {$header < 3} {
set skipOverlaps 1
for {set i 1} {$i <= $num} {incr i} {
lappend notPiped $i
}
} elseif {$header > 2 && $footer == 18 && $te == 1} {
set skipOverlaps 1
if {$delay == 0} {
# Transaction 1 is conventional.
# Check that transactions 2,3,4 are cancelled.
set notPiped {1}
set notIncluded $notPiped
} else {
# Transaction 1 is conventional.
# Check that transaction 2 is cancelled.
# The timing of transactions 3 and 4 is uncertain.
set notPiped {1 3 4}
set notIncluded $notPiped
}
} elseif {$footer in {20 22 23 24 25}} {
# Transaction 2 uses its own socket.
set notPiped 2
set notIncluded $notPiped
} else {
}
# --------------------------------------------------------------------------
# End of custom code for specific tests
# --------------------------------------------------------------------------
set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
lassign $Results msg cleanE cleanF dirtyE dirtyF
if {$msg eq {}} {
set msg "Passed all sanity checks."
} else {
set msg "Problems with sanity checks:\n$msg"
}
if 0 {
puts $msg
puts "Overlap-free including response body:\n$cleanF"
puts "Have overlaps including response body:\n$dirtyF"
puts "Overlap-free without response body:\n$cleanE"
puts "Have overlaps without response body:\n$dirtyE"
}
if {$header < 3} {
# No ordering, just check that transactions all finish
set result $msg
} elseif {$header == 3} {
# Not pipelined - check overlaps with response body.
set result "$msg\nHave overlaps including response body:\n$dirtyF"
} else {
# Pipelined - check overlaps without response body. Check that the
# first request, the first requests after replay, and POSTs are clean.
set result "$msg\nOverlap-free without response body:\n$cleanE"
}
set ::nTokens $num
return $result
}
# ------------------------------------------------------------------------------
# (3) VERBOSITY CONTROL
# ------------------------------------------------------------------------------
# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
# If still obscure, uncomment #Log and ##Log lines in the http package.
# ------------------------------------------------------------------------------
setHttpTestOptions -verbose 0
# ------------------------------------------------------------------------------
# (4) Define the base URLs used for testing. Each must have a query string.
# ------------------------------------------------------------------------------
# - A HTTP/1.1 server is required. It should be configured to provide
# persistent connections when requested to do so, and to close these
# connections if they are idle for one second.
# - The resource must be served with status 200 in response to a valid GET or
# POST.
# - The value of "page" is always specified in the query-string. Different
# resources for the three values of "page" allow testing of both chunked and
# unchunked transfer encoding.
# - The variables "close" and "delay" may be specified in the query-string (for
# a GET) or the request body (for a POST).
# - "delay" is a numerical value in seconds, and causes the server to delay
# the response, including headers.
# - "close", if it has the value "y", instructs the server to close the
# connection ater the current request.
# - Any other variables should be ignored.
# ------------------------------------------------------------------------------
namespace eval ::httpTestScript {
variable URL
array set URL {
a http://test-tcl-http.kerlin.org/index.html?page=privacy
b http://test-tcl-http.kerlin.org/index.html?page=conditions
c http://test-tcl-http.kerlin.org/index.html?page=welcome
}
}
# ------------------------------------------------------------------------------
# (5) Define the tests
# ------------------------------------------------------------------------------
# Constraints:
# - serverNeeded - the URLs defined at (4) must be available, and must have the
# properties specified there.
# - duplicate - the value of -pipeline does not matter if -keepalive 0
# - timeout1s - tests that work correctly only if the server closes
# persistent connections after one second.
#
# Server timeout of persistent connections should be 1s. Delays of 2s are
# intended to cause timeout.
# Servers are usually configured to use a longer timeout: this will cause the
# tests to fail. The "2000" could be replaced with a larger number, but the
# tests will then be inconveniently slow.
# ------------------------------------------------------------------------------
#testConstraint serverNeeded 1
#testConstraint timeout1s 1
#testConstraint duplicate 1
# ------------------------------------------------------------------------------
# Proc SetTestEof - to edit the command ::http::KeepSocket
# ------------------------------------------------------------------------------
# The usual line in command ::http::KeepSocket is " set TEST_EOF 0".
# Whether the value set in the file is 0 or 1, change it here to the value
# specified by the argument.
#
# It is worth doing all tests for both values of the argument.
#
# test 0 - ::http::KeepSocket is unchanged, detects server eof where possible
# and closes the connection.
# test 1 - ::http::KeepSocket is edited, does not detect server eof, so the
# reaction to finding server eof can be tested without the difficulty
# of testing in the few milliseconds of an asynchronous close event.
# ------------------------------------------------------------------------------
proc SetTestEof {test} {
set body [info body ::http::KeepSocket]
set subs " set TEST_EOF $test"
set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
if {$count != 1} {
return -code error {proc ::http::KeepSocket has unexpected form}
}
proc ::http::KeepSocket {token} $newBody
return
}
for {set header 1} {$header <= 4} {incr header} {
if {$header == 4} {
setHttpTestOptions -dotted 1
set match glob
} else {
setHttpTestOptions -dotted 0
set match exact
}
if {$header == 2} {
set cons0 {serverNeeded duplicate}
} else {
set cons0 serverNeeded
}
for {set footer 1} {$footer <= 25} {incr footer} {
foreach {delay label} {
0 a
1 b
2 c
3 d
5 e
8 f
12 g
100 h
500 i
2000 j
} {
foreach te {0 1} {
if {$te} {
set tag testEof
} else {
set tag normal
}
set suffix {}
set cons $cons0
# ------------------------------------------------------------------
# Custom code for individual tests
# ------------------------------------------------------------------
if {$footer in {18}} {
# Custom code:
if {($label eq "j") && ($te == 1)} {
continue
}
if {$te == 1} {
# The test (of REPOST 0) is useful if tag is "testEof"
# (server timeout without client reaction). The same test
# has a different result if tag is "normal".
set suffix " - extra test for -repost 0 - ::http::2 must be"
append suffix " cancelled"
if {($delay == 0)} {
append suffix ", along with ::http::3 ::http::4 if"
append suffix " the test creates these before ::http::2"
append suffix " is cancelled"
}
} else {
}
} elseif {$footer in {19}} {
set suffix " - extra test for -repost 0"
} elseif {$footer in {20 21}} {
set suffix " - extra test for -postfresh 1"
if {($footer == 20)} {
append suffix " - ::http::2 uses a separate socket"
append suffix ", other requests use a persistent connection"
}
} elseif {$footer in {22 23 24 25}} {
append suffix " - ::http::2 uses a separate socket"
append suffix ", other requests use a persistent connection"
} else {
}
if {($footer >= 13 && $footer <= 23)} {
# Test use WAIT and depend on server timeout before this time.
lappend cons timeout1s
}
# ------------------------------------------------------------------
# End of custom code.
# ------------------------------------------------------------------
set name "pipeline test header $header footer $footer delay $delay $tag$suffix"
# Here's the test:
test httpPipeline-${header}.${footer}${label}-${tag} $name \
-constraints $cons \
-setup [string map [list TE $te] {
# Restore default values for tests:
http::config -pipeline 1 -postfresh 0 -repost 1
http::init
set http::http(uid) 0
SetTestEof {TE}
}] -body [list RunTest $header $footer $delay $te] -cleanup {
# Restore default values for tests:
http::config -pipeline 1 -postfresh 0 -repost 1
cleanupHttpTestScript
SetTestEof 0
cleanupHttpTest
after 2000
# Wait for persistent sockets on the server to time out.
} -result [ReturnTestResult $header $footer $delay $te] -match $match
}
}
}
}
# ------------------------------------------------------------------------------
# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
# ------------------------------------------------------------------------------
# These tests are a bit awkward because the main test kit analyses whether all
# requests are satisfied, with retries if necessary, and it has result analysis
# for processing retry logs.
# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
# is a one-off.
# - Tests *.18a-testEof depend on client/server timing - the test needs to call
# http::geturl for all requests before the POST (request 2) is cancelled.
# We test that requests 2, 3, 4 are all cancelled.
# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
# added to the write queue before request 2 is completed. We simply check that
# request 2 is cancelled.
# - The behaviour is different if all connections are allowed to time out
# (label "j"). This case is not needed to test -repost 0, and is omitted.
# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
# effect).
# ------------------------------------------------------------------------------
unset header footer delay label suffix match cons name te
namespace delete ::httpTest
namespace delete ::httpTestScript
::tcltest::cleanupTests
+505
View File
@@ -0,0 +1,505 @@
# httpTest.tcl
#
# Test HTTP/1.1 concurrent requests including
# queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ------------------------------------------------------------------------------
# "Package" httpTest for analysis of Log output of http requests.
# ------------------------------------------------------------------------------
# This is a specialised test kit for examining the presence, ordering, and
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
# connection; and also for testing reconnection in accordance with RFC 7230 when
# the connection is lost.
#
# This kit is probably not useful for other purposes. It depends on the
# presence of specific Log commands in the http library, and it interprets the
# logs that these commands create.
# ------------------------------------------------------------------------------
package require http
namespace eval ::http {
variable TestStartTimeInMs [clock milliseconds]
# catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
}
namespace eval ::httpTest {
variable testResults {}
variable testOptions
array set testOptions {
-verbose 0
-dotted 1
}
# -verbose - 0 quiet 1 write to stdout 2 write more
# -dotted - (boolean) use dots for absences in lists of transactions
}
proc httpTest::Puts {txt} {
variable testOptions
if {$testOptions(-verbose) > 0} {
puts stdout $txt
flush stdout
}
return
}
# http::Log
#
# A special-purpose logger used for running tests.
# - Processes Log calls that have "^" in their arguments, and records them in
# variable ::httpTest::testResults.
# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).
proc http::Log {args} {
variable TestStartTimeInMs
set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
set txt [list $time {*}$args]
if {[string first ^ $txt] != -1} {
::httpTest::LogRecord $txt
::httpTest::Puts $txt
} elseif {$::httpTest::testOptions(-verbose) > 1} {
::httpTest::Puts $txt
}
return
}
# Called by http::Log (the "testing" version) to record logs for later analysis.
proc httpTest::LogRecord {txt} {
variable testResults
set pos [string first ^ $txt]
set len [string length $txt]
if {$pos > $len - 3} {
puts stdout "Logging Error: $txt"
puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
a letter then a numeral."
flush stdout
} elseif {$pos == -1} {
# Called by mistake.
} else {
set letter [string index $txt [incr pos]]
set number [string index $txt [incr pos]]
# Max 9 requests!
lappend testResults [list $letter $number]
}
return
}
# ------------------------------------------------------------------------------
# Commands for analysing the logs recorded when calling http::geturl.
# ------------------------------------------------------------------------------
# httpTest::TestOverlaps --
#
# The main test for correct behaviour of pipelined and sequential
# (non-pipelined) transactions. Other tests should be run first to detect
# any inconsistencies in the data (e.g. absence of the elements that are
# examined here).
#
# Examine the sequence $someResults for each transaction from 1 to $n,
# ignoring any that are listed in $badTrans.
# Determine whether the elements "B" to $term for one transaction overlap
# elements "B" to $term for the previous and following transactions.
#
# Transactions in the list $badTrans are not included in "clean" or
# "dirty", but their possible overlap with other transactions is noted.
# Transactions in the list $notPiped are a subset of $badTrans, and
# their possible overlap with other transactions is NOT noted.
#
# Arguments:
# someResults - list of results, each of the form {letter numeral}
# n - number of HTTP transactions
# term - letter that indicated end of search range. "E" for testing
# overlaps from start of request to end of response headers.
# "F" to extend to the end of the response body.
# msg - the cumulative message from sanity checks. Append to it only
# to report a test failure.
# badTrans - list of transaction numbers not to be assessed as "clean" or
# "dirty"
# notPiped - subset of badTrans. List of transaction numbers that cannot
# taint another transaction by overlapping with it, because it
# used a different socket.
#
# Return value: [list $msg $clean $dirty]
# msg - warning messages: nothing will be appended to argument $msg if there
# is an error with the test.
# clean - list of transactions that have no overlap with other transactions
# dirty - list of transactions that have YES overlap with other transactions
proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
variable testOptions
# Check whether transactions overlap:
set clean {}
set dirty {}
for {set i 1} {$i <= $n} {incr i} {
if {$i in $badTrans} {
continue
}
set myStart [lsearch -exact $someResults [list B $i]]
set myEnd [lsearch -exact $someResults [list $term $i]]
if {($myStart == -1 || $myEnd == -1)} {
set res "Cannot find positions of transaction $i"
append msg $res \n
Puts $res
}
set overlaps {}
for {set j $myStart} {$j <= $myEnd} {incr j} {
lassign [lindex $someResults $j] letter number
if {$number != $i && $letter ne "A" && $number ni $notPiped} {
lappend overlaps $number
}
}
if {[llength $overlaps] == 0} {
set res "Transaction $i has no overlaps"
Puts $res
lappend clean $i
if {$testOptions(-dotted)} {
# N.B. results from different segments are concatenated.
lappend dirty .
} else {
}
} else {
set res "Transaction $i overlaps with [join $overlaps { }]"
Puts $res
lappend dirty $i
if {$testOptions(-dotted)} {
# N.B. results from different segments are concatenated.
lappend clean .
} else {
}
}
}
return [list $msg $clean $dirty]
}
# httpTest::PipelineNext --
#
# Test whether prevPair, pair are valid as consecutive elements of a pipelined
# sequence (Start 1), (End 1), (Start 2), (End 2) ...
# Numbers are integers increasing (by 1 if argument "any" is false), and need
# not begin with 1.
# The first element of the sequence has prevPair {} and is always passed as
# valid.
#
# Arguments;
# Start - string that labels the start of a segment
# End - string that labels the end of a segment
# prevPair - previous "pair" (list of string and number) element of a
# sequence, or {} if argument "pair" is the first in the
# sequence.
# pair - current "pair" (list of string and number) element of a
# sequence
# any - (boolean) iff true, accept any increasing sequence of integers.
# If false, integers must increase by 1.
#
# Return value - boolean, true iff the two pairs are valid consecutive elements.
proc httpTest::PipelineNext {Start End prevPair pair any} {
if {$prevPair eq {}} {
return 1
}
lassign $prevPair letter number
lassign $pair newLetter newNumber
if {$letter eq $Start} {
return [expr {($newLetter eq $End) && ($newNumber == $number)}]
} elseif {$any} {
set nxt [list $Start [expr {$number + 1}]]
return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
} else {
set nxt [list $Start [expr {$number + 1}]]
return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
}
}
# httpTest::TestPipeline --
#
# Given a sequence of "pair" elements, check that the elements whose string is
# $Start or $End form a valid pipeline. Ignore other elements.
#
# Return value: {} if valid pipeline, otherwise a non-empty error message.
proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
set sequence {}
set prevPair {}
set ok 1
set any [llength $badTrans]
foreach pair $someResults {
lassign $pair letter number
if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
lappend sequence $pair
if {![PipelineNext $Start $End $prevPair $pair $any]} {
set ok 0
break
}
set prevPair $pair
}
}
if {!$ok} {
set res "$desc are not pipelined: {$sequence}"
append msg $res \n
Puts $res
}
return $msg
}
# httpTest::TestSequence --
#
# Examine each transaction from 1 to $n, ignoring any that are listed
# in $badTrans.
# Check that each transaction has elements A to F, in alphabetical order.
proc httpTest::TestSequence {someResults n msg badTrans} {
variable testOptions
for {set i 1} {$i <= $n} {incr i} {
if {$i in $badTrans} {
continue
}
set sequence {}
foreach pair $someResults {
lassign $pair letter number
if {$number == $i} {
lappend sequence $letter
}
}
if {$sequence eq {A B C D E F}} {
} else {
set res "Wrong sequence for token ::http::$i - {$sequence}"
append msg $res \n
Puts $res
if {"X" in $sequence} {
set res "- and error(s) X"
append msg $res \n
Puts $res
}
if {"Y" in $sequence} {
set res "- and warnings(s) Y"
append msg $res \n
Puts $res
}
}
}
return $msg
}
#
# Arguments:
# someResults - list of elements, each a list of a letter and a number
# n - (positive integer) the number of HTTP requests
# msg - accumulated warning messages
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# badTrans - list of transaction numbers not to be assessed as "clean" or
# "dirty" by their overlaps
# for 1/2 includes all transactions
# for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
# notPiped - subset of badTrans. List of transaction numbers that cannot
# taint another transaction by overlapping with it, because it
# used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg - warning messages: nothing will be appended to argument $msg if there
# is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
# (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
# (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
# (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
# (including response body)
proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
variable testOptions
# Check that stages for "good" transactions are all present and correct:
set msg [TestSequence $someResults $n $msg $badTrans]
# Check that requests are pipelined:
set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]
# Check that responses are pipelined:
set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]
if {$skipOverlaps} {
set cleanE {}
set dirtyE {}
set cleanF {}
set dirtyF {}
} else {
Puts "Overlaps including response body (test for non-pipelined case)"
lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF
Puts "Overlaps without response body (test for pipelined case)"
lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
}
return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}
# httpTest::ProcessRetries --
#
# Command to examine results for socket-changing records [PQR],
# divide the results into segments for each connection, and analyse each segment
# individually.
# (Could add $sock to the logging to simplify this, but never mind.)
#
# In each segment, identify any transactions that are not included, and
# any that are aborted, to assist subsequent testing.
#
# Prepend A records (socket-independent) to each segment for transactions that
# were scheduled (by A) but not completed (by F). Pass each segment to
# MostAnalysis for processing.
proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
variable testOptions
set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
if {$nextRetry == -1} {
return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
}
set badTrans $notIncluded
set tryCount 0
set try $nextRetry
incr tryCount
lassign [lindex $someResults $try] letter number
Puts "Processing retry [lindex $someResults $try]"
set beforeTry [lrange $someResults 0 $try-1]
Puts [join $beforeTry \n]
set afterTry [lrange $someResults $try+1 end]
set dummyTry {}
for {set i 1} {$i <= $n} {incr i} {
set first [lsearch -exact $beforeTry [list A $i]]
set last [lsearch -exact $beforeTry [list F $i]]
if {$first == -1} {
set res "Transaction $i was not started in connection number $tryCount"
# So lappend it to badTrans and don't include it in the call below of MostAnalysis.
# append msg $res \n
Puts $res
if {$i ni $badTrans} {
lappend badTrans $i
} else {
}
} elseif {$last == -1} {
set res "Transaction $i was started but unfinished in connection number $tryCount"
# So lappend it to badTrans and don't include it in the call below of MostAnalysis.
# append msg $res \n
Puts $res
lappend badTrans $i
lappend dummyTry [list A $i]
} else {
set res "Transaction $i was started and finished in connection number $tryCount"
# So include it in the call below of MostAnalysis.
# So lappend it to notIncluded and don't include it in the recursive call of
# ProcessRetries which handles the later connections.
# append msg $res \n
Puts $res
lappend notIncluded $i
}
}
# Analyse the part of the results before the first replay:
set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1
# Pass the rest of the results to be processed recursively.
set afterTry [concat $dummyTry $afterTry]
set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2
set cleanE [concat $cleanE1 $cleanE2]
set cleanF [concat $cleanF1 $cleanF2]
set dirtyE [concat $dirtyE1 $dirtyE2]
set dirtyF [concat $dirtyF1 $dirtyF2]
return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}
# httpTest::logAnalyse --
#
# The main command called to analyse logs for a single test.
#
# Arguments:
# n - (positive integer) the number of HTTP requests
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# notIncluded - list of transaction numbers not to be assessed as "clean" or
# "dirty" by their overlaps
# notPiped - subset of notIncluded. List of transaction numbers that cannot
# taint another transaction by overlapping with it, because it
# used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg - warning messages: {} if there is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
# (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
# (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
# (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
# (including response body)
proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
variable testResults
variable testOptions
# Check that each data item has the correct form {letter numeral}.
set ii 0
set ok 1
foreach pair $testResults {
lassign $pair letter number
if { [string match {[A-Z]} $letter]
&& [string match {[0-9]} $number]
} {
# OK
} else {
set ok 0
set res "Error: testResults has bad element {$pair} at position $ii"
append msg $res \n
Puts $res
}
incr ii
}
if {!$ok} {
return $msg
}
set msg {}
Puts [join $testResults \n]
ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
# N.B. Implicit Return.
}
proc httpTest::cleanupHttpTest {} {
variable testResults
set testResults {}
return
}
proc httpTest::setHttpTestOptions {key args} {
variable testOptions
if {$key ni {-dotted -verbose}} {
return -code error {valid options are -dotted, -verbose}
}
set testOptions($key) {*}$args
}
namespace eval httpTest {
namespace export cleanupHttpTest logAnalyse setHttpTestOptions
}
+509
View File
@@ -0,0 +1,509 @@
# httpTestScript.tcl
#
# Test HTTP/1.1 concurrent requests including
# queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ------------------------------------------------------------------------------
# "Package" httpTestScript for executing test scripts written in a convenient
# shorthand.
# ------------------------------------------------------------------------------
# ------------------------------------------------------------------------------
# Documentation for "package" httpTestScript.
# ------------------------------------------------------------------------------
# To use the package:
# (a) define URLs as the values of elements in the array ::httpTestScript
# (b) define a script in terms of the commands
# START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
# referring to URLs by the name of the corresponding array element. The
# script can include any other Tcl commands, and evaluates in the
# httpTestScript namespace.
# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
# command.
# ------------------------------------------------------------------------------
# START
# Must be the first command of the script.
#
# STOP
# Must be present in the script to avoid waiting for client timeout.
# Usually the last command, but can be elsewhere to end a script prematurely.
# Subsequent httpTestScript commands will have no effect.
#
# DELAY ms
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl. Default 500ms.
#
# KEEPALIVE
# Set the value passed to http::geturl for the -keepalive option. The command
# applies to subsequent requests in the script. Default 1.
#
# WAIT ms
# Pause for a time in ms before sending subsequent requests.
#
# PIPELINE boolean
# Set the value of -pipeline using http::config. The last PIPELINE command
# in the script applies to every request. Default 1.
#
# POSTFRESH boolean
# Set the value of -postfresh using http::config. The last POSTFRESH command
# in the script applies to every request. Default 0.
#
# REPOST boolean
# Set the value of -repost using http::config. The last REPOST command
# in the script applies to every request. Default 1 for httpTestScript.
# (Default value in http is 0).
#
# GET uriCode ?arg ...?
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
# ::httpTestScript::URL($uriCode).
# args - strings that will be joined by "&" and appended to the query
# string with a preceding "&".
#
# HEAD uriCode ?arg ...?
# Send a HTTP request using the HEAD method.
# Arguments: as for GET
#
# POST uriCode ?arg ...?
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
# ::httpTestScript::URL($uriCode).
# args - strings that will be joined by "&" and used as the request body.
# ------------------------------------------------------------------------------
namespace eval ::httpTestScript {
namespace export runHttpTestScript cleanupHttpTestScript
}
# httpTestScript::START --
# Initialise, and create a long-stop timeout.
proc httpTestScript::START {} {
variable CountRequestedSoFar
variable RequestsWhenStopped
variable KeepAlive
variable Delay
variable TimeOutCode
variable TimeOutDone
variable StartDone
variable StopDone
variable CountFinishedSoFar
variable RequestList
variable RequestsMade
variable ExtraTime
variable ActualKeepAlive
if {[info exists StartDone] && ($StartDone == 1)} {
set msg {START has been called twice without an intervening STOP}
return -code error $msg
}
set StartDone 1
set StopDone 0
set TimeOutDone 0
set CountFinishedSoFar 0
set CountRequestedSoFar 0
set RequestList {}
set RequestsMade {}
set ExtraTime 0
set ActualKeepAlive 1
# Undefined until a STOP command:
unset -nocomplain RequestsWhenStopped
# Default values:
set KeepAlive 1
set Delay 500
# Default values for tests:
KEEPALIVE 1
PIPELINE 1
POSTFRESH 0
REPOST 1
set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
# set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
return
}
# httpTestScript::STOP --
# Do not process any more commands. The commands will be executed but will
# silently do nothing.
proc httpTestScript::STOP {} {
variable CountRequestedSoFar
variable CountFinishedSoFar
variable RequestsWhenStopped
variable TimeOutCode
variable StartDone
variable StopDone
variable RequestsMade
if {$StopDone} {
# Don't do anything on a second call.
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
set StopDone 1
set StartDone 0
set RequestsWhenStopped $CountRequestedSoFar
unset -nocomplain StartDone
if {$CountFinishedSoFar == $RequestsWhenStopped} {
if {[info exists TimeOutCode]} {
after cancel $TimeOutCode
}
set ::httpTestScript::FOREVER 0
}
return
}
# httpTestScript::DELAY --
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl. Default 500ms.
proc httpTestScript::DELAY {t} {
variable StartDone
variable StopDone
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
variable Delay
set Delay $t
return
}
# httpTestScript::KEEPALIVE --
# Set the value passed to http::geturl for the -keepalive option. Default 1.
proc httpTestScript::KEEPALIVE {b} {
variable StartDone
variable StopDone
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
variable KeepAlive
set KeepAlive $b
return
}
# httpTestScript::WAIT --
# Pause for a time in ms before processing any more commands.
proc httpTestScript::WAIT {t} {
variable StartDone
variable StopDone
variable ExtraTime
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
if {(![string is integer -strict $t]) || $t < 0} {
return -code error {argument to WAIT must be a non-negative integer}
}
incr ExtraTime $t
return
}
# httpTestScript::PIPELINE --
# Pass a value to http::config -pipeline.
proc httpTestScript::PIPELINE {b} {
variable StartDone
variable StopDone
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
::http::config -pipeline $b
##::http::Log http(-pipeline) is now [::http::config -pipeline]
return
}
# httpTestScript::POSTFRESH --
# Pass a value to http::config -postfresh.
proc httpTestScript::POSTFRESH {b} {
variable StartDone
variable StopDone
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
::http::config -postfresh $b
##::http::Log http(-postfresh) is now [::http::config -postfresh]
return
}
# httpTestScript::REPOST --
# Pass a value to http::config -repost.
proc httpTestScript::REPOST {b} {
variable StartDone
variable StopDone
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
::http::config -repost $b
##::http::Log http(-repost) is now [::http::config -repost]
return
}
# httpTestScript::GET --
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
# ::httpTestScript::URL($uriCode).
# args - strings that will each be preceded by "&" and appended to the query
# string.
proc httpTestScript::GET {uriCode args} {
variable RequestList
lappend RequestList GET
RequestAfter $uriCode 0 {} {*}$args
return
}
# httpTestScript::HEAD --
# Send a HTTP request using the HEAD method.
# Arguments: as for GET
proc httpTestScript::HEAD {uriCode args} {
variable RequestList
lappend RequestList HEAD
RequestAfter $uriCode 1 {} {*}$args
return
}
# httpTestScript::POST --
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
# ::httpTestScript::URL($uriCode).
# args - strings that will be joined by "&" and used as the request body.
proc httpTestScript::POST {uriCode args} {
variable RequestList
lappend RequestList POST
RequestAfter $uriCode 0 {use} {*}$args
return
}
proc httpTestScript::RequestAfter {uriCode validate query args} {
variable CountRequestedSoFar
variable Delay
variable ExtraTime
variable StartDone
variable StopDone
variable KeepAlive
if {$StopDone} {
return
}
if {![info exists StartDone]} {
return -code error {initialise the script by calling command START}
}
incr CountRequestedSoFar
set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]
# Could pass values of -pipeline, -postfresh, -repost if it were
# useful to change these mid-script.
after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
return
}
proc httpTestScript::Requester {uriCode keepAlive validate query args} {
variable URL
::http::config -accept {*/*}
set absUrl $URL($uriCode)
if {$query eq {}} {
if {$args ne {}} {
append absUrl & [join $args &]
}
set queryArgs {}
} elseif {$validate} {
return -code error {cannot have both -validate (HEAD) and -query (POST)}
} else {
set queryArgs [list -query [join $args &]]
}
if {[catch {
::http::geturl $absUrl \
-validate $validate \
-timeout 10000 \
{*}$queryArgs \
-keepalive $keepAlive \
-command ::httpTestScript::WhenFinished
} token]} {
set msg $token
catch {puts stdout "Error: $msg"}
return
} else {
# Request will begin.
}
return
}
proc httpTestScript::TimeOutNow {} {
variable TimeOutDone
set TimeOutDone 1
set ::httpTestScript::FOREVER 0
return
}
proc httpTestScript::WhenFinished {hToken} {
variable CountFinishedSoFar
variable RequestsWhenStopped
variable TimeOutCode
variable StopDone
variable RequestList
variable RequestsMade
variable ActualKeepAlive
upvar #0 $hToken state
if {[catch {
if { [info exists state(transfer)]
&& ($state(transfer) eq "chunked")
} {
set Trans chunked
} else {
set Trans unchunked
}
if { [info exists ::httpTest::testOptions(-verbose)]
&& ($::httpTest::testOptions(-verbose) > 0)
} {
puts "Token $hToken
Response $state(http)
Status $state(status)
Method $state(method)
Transfer $Trans
Size $state(currentsize)
URL $state(url)
"
}
if {!$state(-keepalive)} {
set ActualKeepAlive 0
}
if {[info exists state(method)]} {
lappend RequestsMade $state(method)
} else {
lappend RequestsMade UNKNOWN
}
set tk [namespace tail $hToken]
if { ($state(http) != {HTTP/1.1 200 OK})
|| ($state(status) != {ok})
|| (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
} {
::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
}
} err]} {
::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
}
incr CountFinishedSoFar
if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
if {[info exists TimeOutCode]} {
after cancel $TimeOutCode
}
if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
}
set ::httpTestScript::FOREVER 0
}
return
}
proc httpTestScript::runHttpTestScript {scr} {
variable TimeOutDone
variable RequestsWhenStopped
after idle [list namespace eval ::httpTestScript $scr]
vwait ::httpTestScript::FOREVER
# N.B. does not automatically execute in this namespace, unlike some other events.
# Release when all requests have been served or have timed out.
if {$TimeOutDone} {
return -code error {test script timed out}
}
return $RequestsWhenStopped
}
proc httpTestScript::cleanupHttpTestScript {} {
variable TimeOutDone
variable RequestsWhenStopped
if {![info exists RequestsWhenStopped]} {
return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
}
for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
http::cleanup ::http::$i
}
return
}
+5 -10
View File
@@ -15,14 +15,8 @@
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testbytestring [llength [info commands testbytestring]]
namespace eval ::tcl::test::io {
namespace import ::tcltest::*
@@ -35,15 +29,16 @@ namespace eval ::tcl::test::io {
variable msg
variable expected
loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
testConstraint fileevent [llength [info commands fileevent]]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testobj [llength [info commands testobj]]
# You need a *very* special environment to do some tests. In
+13 -4
View File
@@ -21,10 +21,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
# Custom constraints used in this file
testConstraint fcopy [llength [info commands fcopy]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
#----------------------------------------------------------------------
@@ -395,7 +395,7 @@ test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} unixOrPc {
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrPc} {
list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
@@ -3781,7 +3781,6 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
testConstraint notValgrind [expr {![testConstraint valgrind]}]
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
#puts <<$tcltest::mainThread>>main
@@ -3834,6 +3833,16 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
rename track {}
# cleanup
# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}
foreach file [list test1 test2 test3 test4] {
removeFile $file
}
+1 -1
View File
@@ -1240,8 +1240,8 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
set res
}]
} -cleanup {
tempdone
interp delete $idb
tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
interp create slave
+1 -1
View File
@@ -608,7 +608,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
variable copy 1
}
} -constraints {testchannel knownBug} -body {
# This test to check the validity of aquired Tcl_Channel references is not
# This test to check the validity of acquired Tcl_Channel references is not
# possible because even a backgrounded fcopy will immediately start to
# copy data, without waiting for the event loop. This is done only in case
# of an underflow on the read size!. So stacking transforms after the
+4 -4
View File
@@ -100,10 +100,10 @@ test lreplace-1.26 {lreplace command} {
} {a {} {}}
test lreplace-1.27 {lreplace command} -body {
lreplace x 1 1
} -returnCodes 1 -result {list doesn't contain element 1}
} -result x
test lreplace-1.28 {lreplace command} -body {
lreplace x 1 1 y
} -returnCodes 1 -result {list doesn't contain element 1}
} -result {x y}
test lreplace-1.29 {lreplace command} -body {
lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
@@ -128,10 +128,10 @@ test lreplace-2.5 {lreplace errors} {
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
list [catch {lreplace x 3 2} msg] $msg
} {1 {list doesn't contain element 3}}
} {0 x}
test lreplace-2.7 {lreplace errors} {
list [catch {lreplace x 2 2} msg] $msg
} {1 {list doesn't contain element 2}}
} {0 x}
test lreplace-3.1 {lreplace won't modify shared argument objects} {
proc p {} {
+11 -11
View File
@@ -99,7 +99,7 @@ test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
[catch {file attributes foo.test -hidden} msg] $msg \
[file delete -force -- foo.test]
} {0 {} 0 1 {}}
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot nonPortable} {
catch {file delete -force -- foo.test}
close [open foo.test w]
catch {
@@ -151,16 +151,16 @@ test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} {
file attributes dir.test -hidden 1
}
set res [list \
[catch {glob *.test} msg] $msg \
[catch {glob -types FOOT *.test} msg] $msg \
[catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
[catch {glob -types FOOTT *.test} msg] $msg \
[catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
[catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
[catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
[catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
[catch {glob -types hidden *.test} msg] $msg \
[catch {glob -types {hidden FOOT} *.test} msg] $msg \
[catch {lsort [glob *.test]} msg] $msg \
[catch {lsort [glob -types FOOT *.test]} msg] $msg \
[catch {lsort [glob -types {{macintosh type FOOT}} *.test]} msg] $msg \
[catch {lsort [glob -types FOOTT *.test]} msg] $msg \
[catch {lsort [glob -types {{macintosh type FOOTT}} *.test]} msg] $msg \
[catch {lsort [glob -types {{macintosh type {}}} *.test]} msg] $msg \
[catch {lsort [glob -types {{macintosh creator FOOC}} *.test]} msg] $msg \
[catch {lsort [glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test]} msg] $msg \
[catch {lsort [glob -types hidden *.test]} msg] $msg \
[catch {lsort [glob -types {hidden FOOT} *.test]} msg] $msg \
]
cd ..
file delete -force globtest
-2
View File
@@ -1210,8 +1210,6 @@ namespace eval ::tcl::test::main {
Bug 1775878
} -constraints {
exec Tcltest
} -setup {
catch {set f [open "|[list [interpreter]]" w+]}
} -body {
exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
set f [open result]
+100
View File
@@ -1804,6 +1804,106 @@ test oo-13.4 {OO: changing an object's class} -body {
foo destroy
bar destroy
} -result {::foo ::foo ::foo ::bar}
test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
oo::object create fooObj
} -body {
oo::objdefine fooObj {
class oo::class
}
oo::define fooObj {
method x {} {expr 1+2+3}
}
[fooObj new] x
} -cleanup {
fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
oo::class create foo
unset -nocomplain ::result
} -body {
set result dangling
oo::define foo {
method x {} {expr 1+2+3}
}
oo::class create boo {
superclass foo
destructor {set ::result "ok"}
}
boo new
foo create bar
oo::objdefine foo {
class oo::object
}
list $result [catch {bar x} msg] $msg
} -cleanup {
catch {bar destroy}
foo destroy
} -result {ok 1 {invalid command name "bar"}}
test oo-13.7 {OO: changing an object's class} -setup {
oo::class create foo
oo::class create bar
unset -nocomplain result
} -body {
oo::define bar method x {} {return ok}
oo::define foo {
method x {} {expr 1+2+3}
self mixin foo
}
lappend result [foo x]
oo::objdefine foo class bar
lappend result [foo x]
} -cleanup {
foo destroy
bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
oo::class create foo
} -body {
oo::define foo {
method x {} {expr 1+2+3}
}
oo::objdefine foo class foo
} -cleanup {
foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
set i [interp create]
} -body {
$i eval {
oo::objdefine oo::object {
class oo::class
}
}
} -cleanup {
interp delete $i
} -returnCodes error -result {may not modify the class of the root object class}
test oo-13.10 {OO: changing an object's class: roots are special} -setup {
set i [interp create]
} -body {
$i eval {
oo::objdefine oo::class {
class oo::object
}
}
} -cleanup {
interp delete $i
} -returnCodes error -result {may not modify the class of the class of classes}
test oo-13.11 {OO: changing an object's class in a tricky place} -setup {
oo::class create cls
unset -nocomplain result
} -body {
set result gorp
list [catch {
oo::define cls {
method x {} {return}
self class oo::object
::set ::result ok
method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that.
}
} msg] $msg $result
} -cleanup {
cls destroy
} -result {1 {attempt to misuse API} ok}
# todo: changing a class subtype (metaclass) to another class subtype
test oo-14.1 {OO: mixins} {
+6
View File
@@ -0,0 +1,6 @@
#! /usr/bin/env tclsh
package ifneeded tcltests 0.1 "
source [list $dir/tcltests.tcl]
package provide tcltests 0.1
"
+5 -1
View File
@@ -10,6 +10,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2
package require tcltests
namespace eval ::tcl::test::platform {
namespace import ::tcltest::testConstraint
@@ -67,7 +68,10 @@ test platform-3.1 {CPU ID on Windows/UNIX} \
# format of string it produces consists of two non-empty words separated by a
# hyphen.
package require platform
test platform-4.1 {format of platform::identify result} -match regexp -body {
test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body {
# [identify] may attempt to [exec] dpkg-architecture, which may not exist,
# in which case fork will not be followed by exec, and valgrind will issue
# "still reachable" reports.
platform::identify
} -result {^([^-]+-)+[^-]+$}
test platform-4.2 {format of platform::generic result} -match regexp -body {
+16
View File
@@ -110,6 +110,14 @@ test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple name
proc p {b:a b::a} {
}
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
set v 2
binary scan AB cc a b
proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
p
} -result [expr {65+66+4}] -cleanup {
rename p {}
}
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -383,6 +391,14 @@ test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
interp delete slave
unset lambda
} {}
test proc-7.5 {[631b4c45df] Crash in argument processing} {
binary scan A c val
proc foo [list [list from $val]] {}
rename foo {}
unset -nocomplain val
} {}
# cleanup
catch {rename p ""}
+6 -6
View File
@@ -19,7 +19,7 @@ testConstraint reg 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::regver [package require registry 1.3.2]
set ::regver [package require registry 1.3.3]
}]} {
testConstraint reg 1
}
@@ -33,7 +33,7 @@ testConstraint english [expr {
test registry-1.0 {check if we are testing the right dll} {win reg} {
set ::regver
} {1.3.2}
} {1.3.3}
test registry-1.1 {argument parsing for registry command} {win reg} {
list [catch {registry} msg] $msg
} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
@@ -283,7 +283,7 @@ test registry-4.7 {GetKeyNames: Unicode} {win reg english} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} "baz\u00c7bar blat"
test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
test registry-4.8 {GetKeyNames: Unicode} {win reg} {
registry delete HKEY_CURRENT_USER\\TclFoobar
registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
registry set HKEY_CURRENT_USER\\TclFoobar\\blat
@@ -487,7 +487,7 @@ test registry-6.17 {GetValue: Unicode value names} {win reg} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} foobar
test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
test registry-6.18 {GetValue: values with Unicode strings} {win reg} {
registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
registry delete HKEY_CURRENT_USER\\TclFoobar
@@ -505,7 +505,7 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {
registry delete HKEY_CURRENT_USER\\TclFoobar
set result
} "foo ba r baz"
test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
test registry-6.21 {GetValue: very long value names and values} {win reg} {
registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
registry delete HKEY_CURRENT_USER\\TclFoobar
@@ -604,7 +604,7 @@ test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
registry values \\\\\\
} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body {
registry values \\\\\\HKEY_CLASSES_ROOT
} -returnCodes error -result {unable to open key: The network address is invalid.}
test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
+4 -8
View File
@@ -308,14 +308,10 @@ test safe-8.7 {safe source control on file} -setup {
unset log
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} -setup {
catch {safe::interpDelete $i}
safe::interpCreate $i
} -body {
$i eval {source -rsrc Init}
} -returnCodes error -cleanup {
safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.8 {safe source forbids -rsrc} emptyTest {
# Disabled this test. It was only useful for long unsupported
# Mac OS 9 systems. [Bug 860a9f1945]
} {}
test safe-8.9 {safe source and return} -setup {
set returnScript [makeFile {return "ok"} return.tcl]
catch {safe::interpDelete $i}
+6
View File
@@ -2015,6 +2015,12 @@ test string-29.4 {string cat, many args} {
list $r1 $r2
} {0 0}
test string-30.1.1 {[Bug ba921a8d98]: string cat} {
string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]
} hellohello
test string-30.1.2 {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"
} hellohello
# cleanup
+20
View File
@@ -688,6 +688,26 @@ if {[testConstraint testnrelevels]} {
namespace delete testnre
}
test tailcall-14.1 {in a deleted namespace} -body {
namespace eval ns {
proc p args {
tailcall [namespace current] $args
}
namespace delete [namespace current]
p
}
} -returnCodes 1 -result {namespace "::ns" not found}
test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
namespace eval ns {
proc p args {
tailcall [namespace current] {*}$args
}
namespace delete [namespace current]
p
}
} -returnCodes 1 -result {namespace "::ns" not found}
# cleanup
::tcltest::cleanupTests
+10 -3
View File
@@ -908,7 +908,9 @@ removeFile load.tcl
# [interpreter]
test tcltest-13.1 {interpreter} {
-constraints notValgrind
-setup {
#to do: Why is $::tcltest::tcltest being saved and restored here?
set old $::tcltest::tcltest
set ::tcltest::tcltest tcltest
}
@@ -920,6 +922,11 @@ test tcltest-13.1 {interpreter} {
}
-result {tcltest tclsh tclsh}
-cleanup {
# writing ::tcltest::tcltest triggers a trace that sets up the stdio
# constraint, which involves a call to [exec] that might fail after
# "fork" and before "exec", in which case the forked process will not
# have a chance to clean itself up before exiting, which causes
# valgrind to issue numerous "still reachable" reports.
set ::tcltest::tcltest $old
}
}
@@ -1200,7 +1207,7 @@ test tcltest-21.2 {force a test command failure} {
} {1}
}
-returnCodes 1
-result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
-result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
}
test tcltest-21.3 {test command with setup} {
@@ -1293,7 +1300,7 @@ test tcltest-21.7 {test command - bad flag} {
}
}
-returnCodes 1
-result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
-result {bad option "-foobar": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
}
# alternate test command format (these are the same as 21.1-21.6, with the
@@ -1313,7 +1320,7 @@ test tcltest-21.8 {force a test command failure} \
} \
-returnCodes 1 \
-cleanup {set ::tcltest::currentFailure $fail} \
-result {bad option "1": must be -body, -cleanup, -constraints, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
-result {bad option "1": must be -body, -cleanup, -constraints, -errorCode, -errorOutput, -match, -output, -result, -returnCodes, or -setup}
test tcltest-21.9 {test command with setup} \
-setup {set foo 1} \
+11
View File
@@ -0,0 +1,11 @@
#! /usr/bin/env tclsh
package require tcltest 2.2
namespace import ::tcltest::*
testConstraint exec [llength [info commands exec]]
testConstraint fcopy [llength [info commands fcopy]]
testConstraint fileevent [llength [info commands fileevent]]
testConstraint thread [
expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind [expr {![testConstraint valgrind]}]
+36 -31
View File
@@ -11,25 +11,19 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.2
namespace import -force ::tcltest::*
}
# when thread::release is used, -wait is passed in order allow the thread to
# be fully finalized, which avoids valgrind "still reachable" reports.
package require tcltests
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
# Some tests require the testthread command
testConstraint testthread [expr {[info commands testthread] != {}}]
testConstraint testthread [expr {[info commands testthread] ne {}}]
# Some tests require the Thread package
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# Some tests may not work under valgrind
testConstraint notValgrind [expr {![testConstraint valgrind]}]
set threadSuperKillScript {
rename catch ""
@@ -72,6 +66,17 @@ proc ThreadError {id info} {
set threadSawError($id) true; # signal main thread to exit [vwait].
}
proc threadSuperKill id {
variable threadSuperKillScript
try {
thread::send $id $::threadSuperKillScript
} on error {tres topts} {
if {$tres ne {target thread died}} {
return -options $topts $tres
}
}
}
if {[testConstraint thread]} {
thread::errorproc ThreadError
}
@@ -96,22 +101,22 @@ test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
set serverthread [thread::create -preserved]
set numthreads [llength [thread::names]]
thread::release $serverthread
thread::release -wait $serverthread
set numthreads
} {2}
} 2
test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
thread::create {set x 5}
foreach try {0 1 2 4 5 6} {
# Try various ways to yield
update
after 10
set l [llength [thread::names]]
if {$l == 1} {
break
}
# Try various ways to yield
update
after 10
set l [llength [thread::names]]
if {$l == 1} {
break
}
}
set l
} {1}
} 1
test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
thread::create {{*}{}}
update
@@ -121,13 +126,13 @@ test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
set serverthread [thread::create -preserved]
set five [thread::send $serverthread {set x 5}]
thread::release $serverthread
thread::release -wait $serverthread
set five
} 5
test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
set five [thread::send $serverthread {set z}]
thread::release $serverthread
thread::release -wait $serverthread
set five
} 5
@@ -159,7 +164,7 @@ test thread-3.1 {TclThreadList} {thread} {
set l2 [thread::names]
set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
foreach t $l1 {
thread::release $t
thread::release -wait $t
}
list $len $c
} {1 0}
@@ -887,7 +892,7 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainE
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::cancel $serverthread]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
@@ -929,7 +934,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::cancel $serverthread]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1029,7 +1034,7 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {interp cancel}]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1071,7 +1076,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {interp cancel}]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1111,7 +1116,7 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1153,7 +1158,7 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm
# wait for other thread to signal "ready to cancel"
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
thread::send $serverthread $::threadSuperKillScript
threadSuperKill $serverthread
vwait ::threadSawError($serverthread)
thread::join $serverthread; drainEventQueue
list $res [expr {[info exists ::threadIdStarted] ? \
+2 -2
View File
@@ -20,7 +20,7 @@ testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::ddever [package require dde 1.4.0]
set ::ddever [package require dde 1.4.1]
set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
testConstraint dde 1
}
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
set ::ddever
} {1.4.0}
} {1.4.1}
test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
list [dde servername foobar] [dde servername] [dde servername self]
+4 -5
View File
@@ -57,11 +57,10 @@ proc cleanup {args} {
}
if {[testConstraint winOnly]} {
set major [string index $tcl_platform(osVersion) 0]
if {[testConstraint nt] && $major > 4} {
if {$major > 5} {
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
if {$::tcl_platform(osVersion) >= 6.0} {
testConstraint winVista 1
} elseif {$major == 5} {
} else {
testConstraint win2000orXP 1
}
} else {
@@ -1083,7 +1082,7 @@ test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp fo
} -constraints {win} -body {
createfile $::env(TEMP)/td1 {}
string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
[string tolower [file normalize $::env(TEMP)]/td1]]
[string tolower [file normalize $::env(TEMP)]/td1]
} -cleanup {
file delete -force -- $::env(TEMP)/td1
} -result 1
+223 -62
View File
@@ -30,6 +30,7 @@ testConstraint cat32 [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole [expr {![testConstraint AllocConsole]}]
testConstraint testexcept [llength [info commands testexcept]]
testConstraint slowTest 0
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
@@ -41,7 +42,7 @@ append big $big
append big $big
set path(little) [makeFile {} little]
set f [open $path(little) w]
set f [open $path(little) w]
puts -nonewline $f "little"
close $f
@@ -308,9 +309,54 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
lappend x [catch {close $f} msg] $msg
} {writable timeout 0 {}}
set path(echoArgs.tcl) [makeFile {
puts "[list $argv0 $argv]"
} echoArgs.tcl]
proc _testExecArgs {single args} {
variable path
if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} {
set path(echoArgs.tcl) [makeFile {
puts "[list [file tail $argv0] {*}$argv]"
} echoArgs.tcl]
}
if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} {
set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"]
}
set cmds [list [list [interpreter] $path(echoArgs.tcl)]]
if {!($single & 2)} {
lappend cmds [list $path(echoArgs.bat)]
} else {
if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
set path(echoArgs2.bat) [makeFile \
"@[file native [interpreter]] $path(echoArgs.tcl) %*" \
"echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]]
}
lappend cmds [list $path(echoArgs2.bat)]
}
set broken {}
foreach args $args {
if {$single & 1} {
# enclose single test-arg between 1st/3rd to be sure nothing is truncated
# (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
set args [list "1st" $args "3rd"]
}
set args [list {*}$args]; # normalized canonical list
foreach cmd $cmds {
set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
tcltest::DebugPuts 4 " ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n ## $args"
if {[catch {
exec {*}$cmd {*}$args
} r]} {
set r "ERROR: $r"
}
if {$r ne $e} {
append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n -- result:\n$r\n -- expected:\n$e\n"
}
if {$single & 8} {
# if test exe only:
break
}
}
}
return $broken
}
### validate the raw output of BuildCommandLine().
###
@@ -369,65 +415,178 @@ test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
exec $env(COMSPEC) /c echo foo \} bar
} "foo \} bar"
set injectList {
{test"whoami} {test""whoami}
{test"""whoami} {test""""whoami}
"test\"whoami\\" "test\"\"whoami\\"
"test\"\"\"whoami\\" "test\"\"\"\"whoami\\"
{test\\&\\test} {test"\\&\\test}
{"test\\&\\test} {"test"\\&\\"test"}
{test\\"&"\\test} {test"\\"&"\\test}
{"test\\"&"\\test} {"test"\\"&"\\"test"}
{test\"&whoami} {test"\"&whoami}
{test""\"&whoami} {test"""\"&whoami}
{test\"\&whoami} {test"\"\&whoami}
{test""\"\&whoami} {test"""\"\&whoami}
{test&whoami} {test|whoami}
{"test&whoami} {"test|whoami}
{test"&whoami} {test"|whoami}
{"test"&whoami} {"test"|whoami}
{""test"&whoami} {""test"|whoami}
{test&echo "} {test|echo "}
{"test&echo "} {"test|echo "}
{test"&echo "} {test"|echo "}
{"test"&echo "} {"test"|echo "}
{""test"&echo "} {""test"|echo "}
{test&echo ""} {test|echo ""}
{"test&echo ""} {"test|echo ""}
{test"&echo ""} {test"|echo ""}
{"test"&echo ""} {"test"|echo ""}
{""test"&echo ""} {""test"|echo ""}
{test>whoami} {test<whoami}
{"test>whoami} {"test<whoami}
{test">whoami} {test"<whoami}
{"test">whoami} {"test"<whoami}
{""test">whoami} {""test"<whoami}
{test(whoami)} {test(whoami)}
{test"(whoami)} {test"(whoami)}
{test^whoami} {test^^echo ^^^}
{test"^whoami} {test"^^echo ^^^}
{test"^echo ^^^"} {test""^echo" ^^^"}
{test%USERDOMAIN%\%USERNAME%}
{test" %USERDOMAIN%\%USERNAME%}
{test%USERDOMAIN%\\%USERNAME%}
{test" %USERDOMAIN%\\%USERNAME%}
{test%USERDOMAIN%&%USERNAME%}
{test" %USERDOMAIN%&%USERNAME%}
{test%USERDOMAIN%\&\%USERNAME%}
{test" %USERDOMAIN%\&\%USERNAME%}
{test%USERDOMAIN%\&\test}
{test" %USERDOMAIN%\&\test}
{test%USERDOMAIN%\\&\\test}
{test" %USERDOMAIN%\\&\\test}
{test%USERDOMAIN%\&\"test}
{test" %USERDOMAIN%\&\"test}
{test%USERDOMAIN%\\&\\"test}
{test" %USERDOMAIN%\\&\\"test}
}
### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
###
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo "" bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo {} bar
} [list $path(echoArgs.tcl) [list foo {} bar]]
test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
} [list $path(echoArgs.tcl) [list foo "\"" bar]]
test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo {""} bar
} [list $path(echoArgs.tcl) [list foo {""} bar]]
test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo "\" " bar
} [list $path(echoArgs.tcl) [list foo "\" " bar]]
test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
} [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar
} [list $path(echoArgs.tcl) [list foo {a = "b"} bar]]
test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {win exec} {
exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}
} [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]]
test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\ bar
} [list $path(echoArgs.tcl) [list foo \\ bar]]
test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\\ bar]]
test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\ bar]]
test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]]
test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]]
test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]]
test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]]
test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar
} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]]
test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \{ bar
} [list $path(echoArgs.tcl) [list foo \{ bar]]
test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo \} bar
} [list $path(echoArgs.tcl) [list foo \} bar]]
test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \
-constraints {win exec} -body {
_testExecArgs 0 \
[list foo "" bar] \
[list foo {} bar] \
[list foo "\"" bar] \
[list foo {""} bar] \
[list foo "\" " bar] \
[list foo {a="b"} bar] \
[list foo {a = "b"} bar] \
[list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}] \
[list foo \\ bar] \
[list foo \\\\ bar] \
[list foo \\\ \\ bar] \
[list foo \\\ \\\\ bar] \
[list foo \\\ \\\\\\ bar] \
[list foo \\\ \\\" bar] \
[list foo \\\ \\\\\" bar] \
[list foo \\\ \\\\\\\" bar] \
[list foo \{ bar] \
[list foo \} bar] \
[list foo * makefile.?c bar]
} -result {}
test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
_testExecArgs 1 {*}$injectList
} -result {}
test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
-constraints {win exec} -body {
_testExecArgs 0 \
[list START {*}$injectList END] \
[list "START\"" {*}$injectList END] \
[list START {*}$injectList "\"END"] \
[list "START\"" {*}$injectList "\"END"]
} -result {}
test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec} -body {
_testExecArgs 2 \
[list START {*}$injectList END] \
[list "START\"" {*}$injectList END] \
[list START {*}$injectList "\"END"] \
[list "START\"" {*}$injectList "\"END"]
} -result {}
test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec} -body {
set lst {}
set maps {
{\&|^<>!()%}
{\&|^<>!()% }
{"\&|^<>!()%}
{"\&|^<>!()% }
{"""""\\\\\&|^<>!()%}
{"""""\\\\\&|^<>!()% }
}
set i 0
time {
set args {[incr i].}
time {
set map [lindex $maps [expr {int(rand()*[llength $maps])}]]
# be sure arg has some prefix (avoid special handling, like |& etc)
set a {x}
while {[string length $a] < 50} {
append a [string index $map [expr {int(rand()*[string length $map])}]]
}
lappend args $a
} 20
lappend lst $args
} 10
_testExecArgs 0 {*}$lst
} -result {} -cleanup {
unset -nocomplain lst args a map maps
}
set injectList {
"test\"\nwhoami" "test\"\"\nwhoami"
"test\"\"\"\nwhoami" "test\"\"\"\"\nwhoami"
"test;\n&echo \"" "\"test;\n&echo \""
"test\";\n&echo \"" "\"test\";\n&echo \""
"\"\"test\";\n&echo \""
}
test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
-constraints {win exec} -body {
# test exe only, because currently there is no proper way to escape a new-line char resp.
# to supply a new-line to the batch-files within arguments (command line is truncated).
_testExecArgs 8 \
[list START {*}$injectList END] \
[list "START\"" {*}$injectList END] \
[list START {*}$injectList "\"END"] \
[list "START\"" {*}$injectList "\"END"]
} -result {}
test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \
-constraints {win exec knownBug} -body {
# this will fail if executed batch-file, because currently there is no proper way to escape a new-line char.
_testExecArgs 0 $injectList
} -result {}
rename _testExecArgs {}
# restore old values for env(TMP) and env(TEMP)
@@ -445,7 +604,9 @@ removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
removeFile echoArgs.tcl
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
::tcltest::cleanupTests
return
+43 -8
View File
@@ -191,12 +191,28 @@ proc genStubs::declare {args} {
regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
set decl [parseDecl $decl]
foreach platform $platformList {
if {$decl ne ""} {
set stubs($curName,$platform,$index) $decl
if {![info exists stubs($curName,$platform,lastNum)] \
|| ($index > $stubs($curName,$platform,lastNum))} {
set stubs($curName,$platform,lastNum) $index
if {([lindex $platformList 0] eq "deprecated")} {
set stubs($curName,deprecated,$index) [lindex $platformList 1]
set stubs($curName,generic,$index) $decl
if {![info exists stubs($curName,generic,lastNum)] \
|| ($index > $stubs($curName,generic,lastNum))} {
set stubs($curName,generic,lastNum) $index
}
} elseif {([lindex $platformList 0] eq "nostub")} {
set stubs($curName,nostub,$index) [lindex $platformList 1]
set stubs($curName,generic,$index) $decl
if {![info exists stubs($curName,generic,lastNum)] \
|| ($index > $stubs($curName,generic,lastNum))} {
set stubs($curName,generic,lastNum) $index
}
} else {
foreach platform $platformList {
if {$decl ne ""} {
set stubs($curName,$platform,$index) $decl
if {![info exists stubs($curName,$platform,lastNum)] \
|| ($index > $stubs($curName,$platform,lastNum))} {
set stubs($curName,$platform,lastNum) $index
}
}
}
}
@@ -455,10 +471,17 @@ proc genStubs::parseArg {arg} {
proc genStubs::makeDecl {name decl index} {
variable scspec
variable stubs
variable libraryName
lassign $decl rtype fname args
append text "/* $index */\n"
set line "$scspec $rtype"
if {[info exists stubs($name,deprecated,$index)]} {
append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
set line "$rtype"
} else {
set line "$scspec $rtype"
}
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
set pad [expr {24 - [string length $line]}]
@@ -569,11 +592,17 @@ proc genStubs::makeMacro {name decl index} {
proc genStubs::makeSlot {name decl index} {
lassign $decl rtype fname args
variable stubs
set lfname [string tolower [string index $fname 0]]
append lfname [string range $fname 1 end]
set text " "
if {[info exists stubs($name,deprecated,$index)]} {
append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
} elseif {[info exists stubs($name,nostub,$index)]} {
append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") "
}
if {$args eq ""} {
append text $rtype " *" $lfname "; /* $index */\n"
return $text
@@ -682,7 +711,13 @@ proc genStubs::forAllStubs {name slotProc onAll textVar
for {set i 0} {$i <= $lastNum} {incr i} {
set slots [array names stubs $name,*,$i]
set emit 0
if {[info exists stubs($name,generic,$i)]} {
if {[info exists stubs($name,deprecated,$i)]} {
append text [$slotProc $name $stubs($name,generic,$i) $i]
set emit 1
} elseif {[info exists stubs($name,nostub,$i)]} {
append text [$slotProc $name $stubs($name,generic,$i) $i]
set emit 1
} elseif {[info exists stubs($name,generic,$i)]} {
if {[llength $slots] > 1} {
puts stderr "conflicting generic and platform entries:\
$name $i"
+3 -3
View File
@@ -20,7 +20,7 @@ proc emitRange {first last} {
set extranges 1
set numranges 0
set ranges [string trimright $ranges " \n\r\t,"]
append ranges "\n#if TCL_UTF_MAX > 4\n ,"
append ranges "\n#if CHRBITS > 16\n ,"
}
append ranges [format "{0x%x, 0x%x}, " \
$first $last]
@@ -33,7 +33,7 @@ proc emitRange {first last} {
set extchars 1
set numchars 0
set chars [string trimright $chars " \n\r\t,"]
append chars "\n#if TCL_UTF_MAX > 4\n ,"
append chars "\n#if CHRBITS > 16\n ,"
}
append chars [format "0x%x, " $first]
incr numchars
@@ -66,7 +66,7 @@ proc genTable {type} {
for {set i 0} {$i <= 0x10ffff} {incr i} {
if {$i == 0xd800} {
# Skip surrogates
set i 0xdc00
set i 0xe000
}
if {[string is $type [format %c $i]]} {
if {$i == ($last + 1)} {
+8 -3
View File
@@ -272,6 +272,7 @@ static const unsigned char groupMap\[\] = {"
* 100 = subtract delta for title/upper
* 101 = sub delta for upper, sub 1 for title
* 110 = sub delta for upper, add delta for lower
* 111 = subtract delta for upper
*
* Bits 8-31 Case delta: delta for case conversions. This should be the
* highest field so we can easily sign extend.
@@ -309,10 +310,14 @@ static const int groups\[\] = {"
}
}
} elseif {$toupper} {
# subtract delta for upper, add delta for lower
set case 6
set delta $toupper
if {$tolower != $toupper} {
if {$tolower == $toupper} {
# subtract delta for upper, add delta for lower
set case 6
} elseif {!$tolower} {
# subtract delta for upper
set case 7
} else {
error "New case conversion type needed: $toupper $tolower $totitle"
}
} elseif {$tolower} {
+126
View File
@@ -0,0 +1,126 @@
{
TclCreatesocketAddress/getaddrinfo/calloc
Memcheck:Leak
match-leak-kinds: reachable
fun:calloc
...
fun:getaddrinfo
fun:TclCreateSocketAddress
}
{
TclCreatesocketAddress/getaddrinfo/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:getaddrinfo
fun:TclCreateSocketAddress
}
{
TclpDlopen/load
Memcheck:Leak
match-leak-kinds: reachable
fun:calloc
...
fun:dlopen
fun:TclpDlopen
}
{
TclpDlopen/load
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:dlopen
fun:TclpDlopen
}
{
TclpGetGrNam/__nss_next2/calloc
Memcheck:Leak
match-leak-kinds: reachable
fun:calloc
...
fun:__nss_next2
...
fun:TclpGetGrNam
}
{
TclpGetGrNam/__nss_next2/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:__nss_next2
...
fun:TclpGetGrNam
}
{
TclpGetGrNam/__nss_systemd_getfrname_r/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:_nss_systemd_getgrnam_r
...
fun:TclpGetGrNam
}
{
TclpGetPwNam/getpwname_r/__nss_next2/calloc
Memcheck:Leak
match-leak-kinds: reachable
fun:calloc
...
fun:__nss_next2
...
fun:TclpGetPwNam
}
{
TclpGetPwNam/getpwname_r/__nss_next2/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:__nss_next2
...
fun:TclpGetPwNam
}
{
TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:_nss_systemd_getpwnam_r
...
fun:TclpGetPwNam
}
{
TclpThreadExit/pthread_exit/calloc
Memcheck:Leak
match-leak-kinds: reachable
fun:calloc
...
fun:pthread_exit
fun:TclpThreadExit
}
{
TclpThreadExit/pthread_exit/malloc
Memcheck:Leak
match-leak-kinds: reachable
fun:malloc
...
fun:pthread_exit
fun:TclpThreadExit
}
+7 -11
View File
@@ -262,7 +262,9 @@ GDB = gdb
TRACE = strace
TRACE_OPTS =
VALGRIND = valgrind
VALGRINDARGS = --tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v
VALGRINDARGS = --tool=memcheck --num-callers=24 \
--leak-resolution=high --leak-check=yes --show-reachable=yes -v \
--suppressions=$(TOOL_DIR)/valgrind_suppress
#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
@@ -840,8 +842,8 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
@echo "Installing package http 2.8.13 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.13.tm;
@echo "Installing package http 2.9.0 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.9.0.tm;
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
@@ -849,8 +851,8 @@ install-libraries: libraries
done;
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm;
@echo "Installing package tcltest 2.4.1 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm;
@echo "Installing package tcltest 2.5.0 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
@@ -1630,9 +1632,6 @@ tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
# relocatable.
#--------------------------------------------------------------------------
fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c
opendir.o: $(COMPAT_DIR)/opendir.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c
@@ -1648,9 +1647,6 @@ strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
strstr.o: $(COMPAT_DIR)/strstr.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c
strtod.o: $(COMPAT_DIR)/strtod.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c
strtol.o: $(COMPAT_DIR)/strtol.c
$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c
+66 -354
View File
@@ -7511,7 +7511,7 @@ fi
fi
;;
FreeBSD-*)
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
@@ -8719,7 +8719,7 @@ fi
BSD/OS*) ;;
CYGWIN_*|MINGW32_*) ;;
IRIX*) ;;
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
@@ -9517,6 +9517,70 @@ _ACEOF
fi
echo "$as_me:$LINENO: checking for DIR64" >&5
echo $ECHO_N "checking for DIR64... $ECHO_C" >&6
if test "${tcl_cv_DIR64+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <sys/types.h>
#include <dirent.h>
int
main ()
{
struct dirent64 *p; DIR64 d = opendir64(".");
p = readdir64(d); rewinddir64(d); closedir64(d);
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
(eval $ac_compile) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest.$ac_objext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
tcl_cv_DIR64=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
tcl_cv_DIR64=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $tcl_cv_DIR64" >&5
echo "${ECHO_T}$tcl_cv_DIR64" >&6
if test "x${tcl_cv_DIR64}" = "xyes" ; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_DIR64 1
_ACEOF
fi
echo "$as_me:$LINENO: checking for struct stat64" >&5
echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6
if test "${tcl_cv_struct_stat64+set}" = set; then
@@ -14918,358 +14982,6 @@ esac
fi
#--------------------------------------------------------------------
# Check for the strtod function. This is tricky because in some
# versions of Linux strtod mis-parses strings starting with "+".
#--------------------------------------------------------------------
echo "$as_me:$LINENO: checking for strtod" >&5
echo $ECHO_N "checking for strtod... $ECHO_C" >&6
if test "${ac_cv_func_strtod+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define strtod to an innocuous variant, in case <limits.h> declares strtod.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define strtod innocuous_strtod
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef strtod
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char strtod ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_strtod) || defined (__stub___strtod)
choke me
#else
char (*f) () = strtod;
#endif
#ifdef __cplusplus
}
#endif
int
main ()
{
return f != strtod;
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
ac_cv_func_strtod=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_func_strtod=no
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5
echo "${ECHO_T}$ac_cv_func_strtod" >&6
if test $ac_cv_func_strtod = yes; then
tcl_ok=1
else
tcl_ok=0
fi
if test "$tcl_ok" = 1; then
echo "$as_me:$LINENO: checking proper strtod implementation" >&5
echo $ECHO_N "checking proper strtod implementation... $ECHO_C" >&6
if test "${tcl_cv_strtod_unbroken+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test "$cross_compiling" = yes; then
tcl_cv_strtod_unbroken=unknown
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
int main() {
extern double strtod();
char *term, *string = " +69";
exit(strtod(string,&term) != 69 || term != string+4);
}
_ACEOF
rm -f conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
tcl_cv_strtod_unbroken=ok
else
echo "$as_me: program exited with status $ac_status" >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
( exit $ac_status )
tcl_cv_strtod_unbroken=broken
fi
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
fi
echo "$as_me:$LINENO: result: $tcl_cv_strtod_unbroken" >&5
echo "${ECHO_T}$tcl_cv_strtod_unbroken" >&6
if test "$tcl_cv_strtod_unbroken" = "ok"; then
tcl_ok=1
else
tcl_ok=0
fi
fi
if test "$tcl_ok" = 0; then
case $LIBOBJS in
"strtod.$ac_objext" | \
*" strtod.$ac_objext" | \
"strtod.$ac_objext "* | \
*" strtod.$ac_objext "* ) ;;
*) LIBOBJS="$LIBOBJS strtod.$ac_objext" ;;
esac
USE_COMPAT=1
fi
#--------------------------------------------------------------------
# Under Solaris 2.4, strtod returns the wrong value for the
# terminating character under some conditions. Check for this
# and if the problem exists use a substitute procedure
# "fixstrtod" that corrects the error.
#--------------------------------------------------------------------
echo "$as_me:$LINENO: checking for strtod" >&5
echo $ECHO_N "checking for strtod... $ECHO_C" >&6
if test "${ac_cv_func_strtod+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Define strtod to an innocuous variant, in case <limits.h> declares strtod.
For example, HP-UX 11i <limits.h> declares gettimeofday. */
#define strtod innocuous_strtod
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod (); below.
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
<limits.h> exists even on freestanding compilers. */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
#undef strtod
/* Override any gcc2 internal prototype to avoid an error. */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
builtin and then its argument prototype would still apply. */
char strtod ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined (__stub_strtod) || defined (__stub___strtod)
choke me
#else
char (*f) () = strtod;
#endif
#ifdef __cplusplus
}
#endif
int
main ()
{
return f != strtod;
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
ac_cv_func_strtod=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_func_strtod=no
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $ac_cv_func_strtod" >&5
echo "${ECHO_T}$ac_cv_func_strtod" >&6
if test $ac_cv_func_strtod = yes; then
tcl_strtod=1
else
tcl_strtod=0
fi
if test "$tcl_strtod" = 1; then
echo "$as_me:$LINENO: checking for Solaris2.4/Tru64 strtod bugs" >&5
echo $ECHO_N "checking for Solaris2.4/Tru64 strtod bugs... $ECHO_C" >&6
if test "${tcl_cv_strtod_buggy+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
if test "$cross_compiling" = yes; then
tcl_cv_strtod_buggy=buggy
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
extern double strtod();
int main() {
char *infString="Inf", *nanString="NaN", *spaceString=" ";
char *term;
double value;
value = strtod(infString, &term);
if ((term != infString) && (term[-1] == 0)) {
exit(1);
}
value = strtod(nanString, &term);
if ((term != nanString) && (term[-1] == 0)) {
exit(1);
}
value = strtod(spaceString, &term);
if (term == (spaceString+1)) {
exit(1);
}
exit(0);
}
_ACEOF
rm -f conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
tcl_cv_strtod_buggy=ok
else
echo "$as_me: program exited with status $ac_status" >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
( exit $ac_status )
tcl_cv_strtod_buggy=buggy
fi
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
fi
echo "$as_me:$LINENO: result: $tcl_cv_strtod_buggy" >&5
echo "${ECHO_T}$tcl_cv_strtod_buggy" >&6
if test "$tcl_cv_strtod_buggy" = buggy; then
case $LIBOBJS in
"fixstrtod.$ac_objext" | \
*" fixstrtod.$ac_objext" | \
"fixstrtod.$ac_objext "* | \
*" fixstrtod.$ac_objext "* ) ;;
*) LIBOBJS="$LIBOBJS fixstrtod.$ac_objext" ;;
esac
USE_COMPAT=1
cat >>confdefs.h <<\_ACEOF
#define strtod fixstrtod
_ACEOF
fi
fi
#--------------------------------------------------------------------
# Check for various typedefs and provide substitutes if
# they don't exist.

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