Compare commits

...
106 Commits
Author SHA1 Message Date
dkf 200e2e211e Critical fix: make tcltest behave as described 2018-11-07 15:03:51 +00:00
dkf c5bbe85f29 Rebase of travis config 2018-11-07 13:25:45 +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
kjnash 754bb107b4 Bugfix - always cleanup persistent socket. 2018-06-01 18:34:07 +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
70 changed files with 5768 additions and 2642 deletions
+236
View File
@@ -0,0 +1,236 @@
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
### C builds not currently supported on Windows instances
# - os: windows
# env:
# - MATRIX_EVAL="" BUILD_DIR=win
before_install:
- eval "${MATRIX_EVAL}"
- export ERROR_ON_FAILURES=1
- cd ${BUILD_DIR}
install:
- test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
- make
- make test
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
-185
View File
@@ -1,185 +0,0 @@
README: Tcl
This is the Tcl 8.6.8 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
Contents
--------
1. Introduction
2. Documentation
3. Compiling and installing Tcl
4. Development tools
5. Tcl newsgroup
6. The Tcler's Wiki
7. Mailing lists
8. Support and Training
9. Tracking Development
10. Thank You
1. Introduction
---------------
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.
Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at:
http://core.tcl.tk/
Tcl/Tk release and mailing list services are hosted by SourceForge:
http://sourceforge.net/projects/tcl/
with the Tcl Developer Xchange hosted at:
http://www.tcl.tk/
Tcl is a freely available open source package. You can do virtually
anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part. See the file
"license.terms" for complete information.
2. Documentation
----------------
Extensive documentation is available at our website.
The home page for this release, including new features, is
http://www.tcl.tk/software/tcltk/8.6.html
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
http://sourceforge.net/projects/tcl/files/Tcl/
Information about Tcl itself can be found at
http://www.tcl.tk/about/
There have been many Tcl books on the market. Many are mentioned in the Wiki:
http://wiki.tcl.tk/_/ref?N=25206
To view the complete set of reference manual entries for Tcl 8.6 online,
visit the URL:
http://www.tcl.tk/man/tcl8.6/
2a. Unix Documentation
----------------------
The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tcl. Files with extension ".1" are for
programs (for example, tclsh.1); files with extension ".3" are for C
library procedures; and files with extension ".n" describe Tcl
commands. The file "doc/Tcl.n" gives a quick summary of the Tcl
language syntax. To print any of the man pages on Unix, cd to the
"doc" directory and invoke your favorite variant of troff using the
normal -man macros, for example
ditroff -man Tcl.n
to print Tcl.n. If Tcl has been installed correctly and your "man" program
supports it, you should be able to access the Tcl manual entries using the
normal "man" mechanisms, such as
man Tcl
2b. Windows Documentation
-------------------------
The "doc" subdirectory in this release contains a complete set of Windows
help files for Tcl. Once you install this Tcl release, a shortcut to the
Windows help Tcl documentation will appear in the "Start" menu:
Start | Programs | Tcl | Tcl Help
3. Compiling and installing Tcl
-------------------------------
There are brief notes in the unix/README, win/README, and macosx/README about
compiling on these different platforms. There is additional information
about building Tcl from sources at
http://www.tcl.tk/doc/howto/compile.html
4. Development tools
---------------------------
ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more. More information can be found at
http://www.ActiveState.com/Tcl
5. Tcl newsgroup
----------------
There is a USENET news group, "comp.lang.tcl", intended for the exchange of
information about Tcl, Tk, and related applications. The newsgroup is a
great place to ask general information questions. For bug reports, please
see the "Support and bug fixes" section below.
6. Tcl'ers Wiki
---------------
A Wiki-based open community site covering all aspects of Tcl/Tk is at:
http://wiki.tcl.tk/
It is dedicated to the Tcl programming language and its extensions. A
wealth of useful information can be found there. It contains code
snippets, references to papers, books, and FAQs, as well as pointers to
development tools, extensions, and applications. You can also recommend
additional URLs by editing the wiki yourself.
7. Mailing lists
----------------
Several mailing lists are hosted at SourceForge to discuss development or
use issues (like Macintosh and Windows topics). For more information and
to subscribe, visit:
http://sourceforge.net/projects/tcl/
and go to the Mailing Lists page.
8. Support and Training
------------------------
We are very interested in receiving bug reports, patches, and suggestions
for improvements. We prefer that you send this information to us as
tickets entered into our tracker at:
http://core.tcl.tk/tcl/reportlist
We will log and follow-up on each bug, although we cannot promise a
specific turn-around time. Enhancements may take longer and may not happen
at all unless there is widespread support for them (we're trying to
slow the rate at which Tcl/Tk turns into a kitchen sink). It's very
difficult to make incompatible changes to Tcl/Tk at this point, due to
the size of the installed base.
The Tcl community is too large for us to provide much individual support
for users. If you need help we suggest that you post questions to
comp.lang.tcl. We read the newsgroup and will attempt to answer esoteric
questions for which no one else is likely to know the answer. In addition,
see the following Web site for links to other organizations that offer
Tcl/Tk training:
http://wiki.tcl.tk/training
9. Tracking Development
-----------------------
Tcl is developed in public. To keep an eye on how Tcl is changing, see
http://core.tcl.tk/
10. Thank You
-------------
We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.
-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;
}
+3 -3
View File
@@ -224,10 +224,10 @@ 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
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.
(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.
+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
+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;
}
+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)))
+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 -1
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 {
+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,
+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);
+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)
+15 -5
View File
@@ -243,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;
@@ -432,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)));
+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 -17
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]
@@ -1254,10 +1254,6 @@ proc tcltest::DefineConstraintInitializers {} {
ConstraintInitializer interactive \
{expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
# Skip slow tests (to enable slow tests add parameter `-constraints slowTest`)
ConstraintInitializer slowTest {format 0}
# Some tests can only be run if the installation came from a CD
# image instead of a web image. Some tests must be skipped if you
# are running as root on Unix. Other tests can only be run if you
@@ -1845,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
@@ -1886,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
@@ -1896,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)} {
@@ -1905,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)]
@@ -1916,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} {
@@ -1948,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.
@@ -1980,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}]
@@ -2007,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
}
}
@@ -2016,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.
@@ -2059,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}]
@@ -2110,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]} {
@@ -2163,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} {
@@ -2175,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" }
@@ -2190,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)"
}
}
}
@@ -2216,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} {
@@ -2726,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
# shell being tested
#
# Results:
# None.
# Whether there were any failures.
#
# Side effects:
# None.
@@ -2737,6 +2752,7 @@ proc tcltest::runAllTests { {shell ""} } {
variable numTests
variable failFiles
variable DefaultValue
set failFilesAccum {}
FillFilesExisted
if {[llength [info level 0]] == 1} {
@@ -2826,6 +2842,7 @@ proc tcltest::runAllTests { {shell ""} } {
}
if {$Failed > 0} {
lappend failFiles $testFile
lappend failFilesAccum $testFile
}
} elseif {[regexp [join {
{^Number of tests skipped }
@@ -2872,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}
}
+3 -1
View File
@@ -22,5 +22,7 @@ if {[singleProcess]} {
interp debug {} -frame 1
}
runAllTests
set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
unset -nocomplain env(ERROR_ON_FAILURES)
if {[runAllTests] && $ErrorOnFailures} {exit 1}
proc exit args {}
+1 -1
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")
}]
+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
}
+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 {
+1 -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 {
+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
}
+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
+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} {
+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 {
+6 -6
View File
@@ -312,7 +312,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \
-result [lsort {
95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket
nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
}]
@@ -908,7 +908,7 @@ removeFile load.tcl
# [interpreter]
test tcltest-13.1 {interpreter} {
-constraints notValgrind
-constraints notValgrind
-setup {
#to do: Why is $::tcltest::tcltest being saved and restored here?
set old $::tcltest::tcltest
@@ -926,7 +926,7 @@ test tcltest-13.1 {interpreter} {
# 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.
# valgrind to issue numerous "still reachable" reports.
set ::tcltest::tcltest $old
}
}
@@ -1207,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} {
@@ -1300,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
@@ -1320,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} \
+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]
+3 -4
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 {
+10 -9
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
@@ -323,16 +324,16 @@ proc _testExecArgs {single args} {
lappend cmds [list $path(echoArgs.bat)]
} else {
if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
file mkdir [file join [temporaryDirectory] test(Dir)Check]
set path(echoArgs2.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" \
"test(Dir)Check/echo(Cmd)Test Args & Batch.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
# 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"]
}
@@ -569,7 +570,7 @@ set injectList {
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.
# 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] \
@@ -603,9 +604,9 @@ removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
removeFile echoArgs.tcl
removeFile echoArgs.bat
file delete -force [file join [temporaryDirectory] test(Dir)Check]
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"
+4 -10
View File
@@ -842,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 \
@@ -851,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;
@@ -1632,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
@@ -1650,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
+2 -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" ;;
@@ -14982,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.
-20
View File
@@ -358,26 +358,6 @@ SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
exit(strtoul(string,&term,0) != 0 || term != string+1);
])
#--------------------------------------------------------------------
# Check for the strtod function. This is tricky because in some
# versions of Linux strtod mis-parses strings starting with "+".
#--------------------------------------------------------------------
SC_TCL_CHECK_BROKEN_FUNC(strtod, [
extern double strtod();
char *term, *string = " +69";
exit(strtod(string,&term) != 69 || term != string+4);
])
#--------------------------------------------------------------------
# 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.
#--------------------------------------------------------------------
SC_BUGGY_STRTOD
#--------------------------------------------------------------------
# Check for various typedefs and provide substitutes if
# they don't exist.
+2 -55
View File
@@ -1516,7 +1516,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LDFLAGS="$LDFLAGS -pthread"
])
;;
FreeBSD-*)
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
SHLIB_CFLAGS="-fPIC"
SHLIB_LD="${CC} -shared"
@@ -2012,7 +2012,7 @@ dnl # preprocessing tests use only CPPFLAGS.
BSD/OS*) ;;
CYGWIN_*|MINGW32_*) ;;
IRIX*) ;;
NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
SCO_SV-3.2*) ;;
*) SHLIB_CFLAGS="-fPIC" ;;
@@ -2397,59 +2397,6 @@ AC_DEFUN([SC_TIME_HANDLER], [
fi
])
#--------------------------------------------------------------------
# SC_BUGGY_STRTOD
#
# 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" (provided by Tcl) that corrects the error.
# Also, on Compaq's Tru64 Unix 5.0,
# strtod(" ") returns 0.0 instead of a failure to convert.
#
# Arguments:
# none
#
# Results:
#
# Might defines some of the following vars:
# strtod (=fixstrtod)
#
#--------------------------------------------------------------------
AC_DEFUN([SC_BUGGY_STRTOD], [
AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
if test "$tcl_strtod" = 1; then
AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[
AC_TRY_RUN([
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);
}], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy,
tcl_cv_strtod_buggy=buggy)])
if test "$tcl_cv_strtod_buggy" = buggy; then
AC_LIBOBJ([fixstrtod])
USE_COMPAT=1
AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?])
fi
fi
])
#--------------------------------------------------------------------
# SC_TCL_LINK_LIBS
#
+8 -8
View File
@@ -651,8 +651,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
@echo "Installing package http 2.8.13 as a Tcl Module";
@$(COPY) $(ROOT_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";
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
@@ -660,8 +660,8 @@ install-libraries: libraries install-tzdata install-msgs
done;
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
@$(COPY) $(ROOT_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";
@$(COPY) $(ROOT_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";
@$(COPY) $(ROOT_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";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@@ -712,15 +712,15 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
+2 -2
View File
@@ -384,8 +384,8 @@ test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls $(CAT32)
set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
<<
runtest: setup $(TCLTEST) dlls $(CAT32)
+12 -51
View File
@@ -33,10 +33,6 @@ static int platformId; /* Running under NT, or 95/98? */
#define cpuid __asm __emit 0fh __asm __emit 0a2h
#endif
#if TCL_UTF_MAX < 4
static Tcl_Encoding winTCharEncoding = NULL;
#endif
/*
* The following declaration is for the VC++ DLL entry point.
*/
@@ -201,8 +197,6 @@ TclWinInit(
if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
Tcl_Panic("Windows 9x is not a supported platform");
}
TclWinResetInterfaces();
}
/*
@@ -282,10 +276,6 @@ TclWinNoBackslash(
void
TclpSetInterfaces(void)
{
#if TCL_UTF_MAX < 4
TclWinResetInterfaces();
winTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
#endif
}
/*
@@ -313,8 +303,6 @@ TclWinEncodingsCleanup(void)
{
MountPointMap *dlIter, *dlIter2;
TclWinResetInterfaces();
/*
* Clean up the mount point map.
*/
@@ -348,12 +336,6 @@ TclWinEncodingsCleanup(void)
void
TclWinResetInterfaces(void)
{
#if TCL_UTF_MAX < 4
if (winTCharEncoding != NULL) {
Tcl_FreeEncoding(winTCharEncoding);
winTCharEncoding = NULL;
}
#endif
}
/*
@@ -565,22 +547,11 @@ Tcl_WinUtfToTChar(
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
#if TCL_UTF_MAX > 3
TCHAR *wp;
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, 2*size+2);
wp = (TCHAR *)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 wp;
#else
return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding,
string, len, dsPtr);
#endif
if (!string) {
return NULL;
}
return Tcl_UtfToUniCharDString(string, len, dsPtr);
}
char *
@@ -591,26 +562,16 @@ Tcl_WinTCharToUtf(
Tcl_DString *dsPtr) /* Uninitialized or free DString in which the
* converted string is stored. */
{
#if TCL_UTF_MAX > 3
char *p;
int size;
if (len > 0) {
Tcl_DStringInit(dsPtr);
if (!string) {
return NULL;
}
if (len < 0) {
len = wcslen(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
return Tcl_ExternalToUtfDString(winTCharEncoding,
(const char *) string, len, dsPtr);
#endif
return Tcl_UniCharToUtfDString(string, len, dsPtr);
}
/*
+180 -139
View File
@@ -17,15 +17,7 @@
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
#ifndef UNICODE
# undef CP_WINUNICODE
# define CP_WINUNICODE CP_WINANSI
# undef Tcl_WinTCharToUtf
# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
# undef Tcl_WinUtfToTChar
# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
#endif
#include <tchar.h>
#if !defined(NDEBUG)
/* test POKE server Implemented for debug mode only */
@@ -33,16 +25,6 @@
# define CBF_FAIL_POKES 0
#endif
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
* are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE
* EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON.
*/
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
/*
* The following structure is used to keep track of the interpreters
* registered by this process.
@@ -69,7 +51,7 @@ typedef struct Conversation {
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
typedef struct DdeEnumServices {
typedef struct {
Tcl_Interp *interp;
int result;
ATOM service;
@@ -77,7 +59,7 @@ typedef struct DdeEnumServices {
HWND hwnd;
} DdeEnumServices;
typedef struct ThreadSpecificData {
typedef struct {
Conversation *currentConversations;
/* A list of conversations currently being
* processed. */
@@ -97,7 +79,7 @@ static DWORD ddeInstance; /* The application instance handle given to us
* by DdeInitialize. */
static int ddeIsServer = 0;
#define TCL_DDE_VERSION "1.4.0"
#define TCL_DDE_VERSION "1.4.1"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
@@ -114,7 +96,7 @@ TCL_DECLARE_MUTEX(ddeMutex)
static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
WPARAM wParam, LPARAM lParam);
static int DdeCreateClient(struct DdeEnumServices *es);
static int DdeCreateClient(DdeEnumServices *es);
static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
@@ -135,8 +117,27 @@ static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
EXTERN int Dde_Init(Tcl_Interp *interp);
EXTERN int Dde_SafeInit(Tcl_Interp *interp);
static unsigned char *
getByteArrayFromObj(
Tcl_Obj *objPtr,
size_t *lengthPtr
) {
int length;
unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
/* 64-bit and TIP #494 situation: */
*lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
} else
#endif
/* 32-bit or without TIP #494 */
*lengthPtr = (size_t) (unsigned) length;
return result;
}
DLLEXPORT int Dde_Init(Tcl_Interp *interp);
DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -162,13 +163,6 @@ Dde_Init(
return TCL_ERROR;
}
#ifdef UNICODE
if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Win32s and Windows 9x are not supported platforms", -1));
return TCL_ERROR;
}
#endif
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
@@ -399,7 +393,7 @@ DdeSetServerName(
Tcl_DString ds;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
Tcl_DStringFree(&ds);
@@ -414,9 +408,9 @@ DdeSetServerName(
* We have found a unique name. Now add it to the registry.
*/
riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
@@ -517,7 +511,7 @@ DeleteProc(
prevPtr->nextPtr = searchPtr->nextPtr;
}
}
ckfree(riPtr->name);
Tcl_Free((char *) riPtr->name);
if (riPtr->handlerPtr) {
Tcl_DecrRefCount(riPtr->handlerPtr);
}
@@ -555,7 +549,7 @@ ExecuteRemoteObject(
Tcl_Obj *returnPackagePtr;
int result = TCL_OK;
if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
"interp", -1));
@@ -637,7 +631,7 @@ DdeServerProc(
/* Transaction-dependent data. */
{
Tcl_DString dString;
int len;
size_t len;
DWORD dlen;
TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
@@ -687,7 +681,7 @@ DdeServerProc(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
if (_tcsicmp(riPtr->name, utilString) == 0) {
convPtr = ckalloc(sizeof(Conversation));
convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -717,7 +711,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
ckfree(convPtr);
Tcl_Free((char *) convPtr);
break;
}
}
@@ -743,22 +737,24 @@ DdeServerProc(
}
if (convPtr != NULL) {
Tcl_DString dsBuf;
char *returnString;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
Tcl_DStringInit(&dsBuf);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
if (uFmt == CF_TEXT) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
} else {
returnString = (char *)
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
len = sizeof(TCHAR) * len + 1;
returnString =
Tcl_GetString(convPtr->returnPackagePtr);
len = convPtr->returnPackagePtr->length;
if (uFmt != CF_TEXT) {
Tcl_WinUtfToTChar(returnString, len, &dsBuf);
returnString = Tcl_DStringValue(&dsBuf);
len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
(DWORD) len+1, 0, ddeItem, uFmt, 0);
@@ -768,18 +764,18 @@ DdeServerProc(
} else {
Tcl_DString ds;
Tcl_Obj *variableObjPtr;
Tcl_WinTCharToUtf(utilString, -1, &ds);
variableObjPtr = Tcl_GetVar2Ex(
convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
if (uFmt == CF_TEXT) {
returnString = Tcl_GetStringFromObj(
variableObjPtr, &len);
} else {
returnString = (char *) Tcl_GetUnicodeFromObj(
variableObjPtr, &len);
len = sizeof(TCHAR) * len + 1;
returnString = Tcl_GetString(variableObjPtr);
len = variableObjPtr->length;
if (uFmt != CF_TEXT) {
Tcl_WinUtfToTChar(returnString, len, &dsBuf);
returnString = Tcl_DStringValue(&dsBuf);
len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance,
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
@@ -790,6 +786,7 @@ DdeServerProc(
Tcl_DStringFree(&ds);
}
}
Tcl_DStringFree(&dsBuf);
Tcl_DStringFree(&dString);
}
return ddeReturn;
@@ -814,26 +811,30 @@ DdeServerProc(
}
if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
Tcl_DString ds;
Tcl_DString ds, ds2;
Tcl_Obj *variableObjPtr;
DWORD len2;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
Tcl_DStringInit(&ds2);
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
Tcl_WinTCharToUtf(utilString, -1, &ds);
utilString = (TCHAR *) DdeAccessData(hData, &dlen);
if (uFmt == CF_TEXT) {
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
} else {
variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
utilString = (TCHAR *) DdeAccessData(hData, &len2);
len = len2;
if (uFmt != CF_TEXT) {
Tcl_WinTCharToUtf(utilString, -1, &ds2);
utilString = (TCHAR *) Tcl_DStringValue(&ds2);
}
variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
variableObjPtr, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds2);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dString);
ddeReturn = (HDDEDATA) DDE_FACK;
@@ -874,8 +875,12 @@ DdeServerProc(
ddeObjectPtr = Tcl_NewStringObj(string, dlen);
} else {
/* unicode */
dlen >>= 1;
ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
Tcl_DString dsBuf;
Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf);
ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
Tcl_DStringLength(&dsBuf));
Tcl_DStringFree(&dsBuf);
}
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
@@ -1040,7 +1045,7 @@ MakeDdeConnection(
static int
DdeCreateClient(
struct DdeEnumServices *es)
DdeEnumServices *es)
{
WNDCLASSEX wc;
static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
@@ -1050,7 +1055,7 @@ DdeCreateClient(
wc.cbSize = sizeof(wc);
wc.lpfnWndProc = DdeClientWindowProc;
wc.lpszClassName = szDdeClientClassName;
wc.cbWndExtra = sizeof(struct DdeEnumServices *);
wc.cbWndExtra = sizeof(DdeEnumServices *);
/*
* Register and create the callback window.
@@ -1072,8 +1077,8 @@ DdeClientWindowProc(
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
struct DdeEnumServices *es =
(struct DdeEnumServices *) lpcs->lpCreateParams;
DdeEnumServices *es =
(DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
@@ -1098,18 +1103,18 @@ DdeServicesOnAck(
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
DdeEnumServices *es;
TCHAR sz[255];
Tcl_DString dString;
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
if ((es->service == (ATOM)0 || es->service == service)
&& (es->topic == (ATOM)0 || es->topic == topic)) {
if (((es->service == (ATOM)0) || (es->service == service))
&& ((es->topic == (ATOM)0) || (es->topic == topic))) {
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
@@ -1156,7 +1161,7 @@ DdeEnumWindowsCallback(
LPARAM lParam)
{
DWORD_PTR dwResult = 0;
struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
DdeEnumServices *es = (DdeEnumServices *) lParam;
SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
@@ -1170,7 +1175,7 @@ DdeGetServicesList(
const TCHAR *serviceName,
const TCHAR *topicName)
{
struct DdeEnumServices es;
DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
@@ -1291,7 +1296,8 @@ DdeObjCmd(
"-binary", NULL
};
int index, i, length, argIndex;
int index, i, argIndex;
size_t length;
int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
@@ -1300,6 +1306,7 @@ DdeObjCmd(
const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
Tcl_DString serviceBuf, topicBuf, itemBuf;
/*
* Initialize DDE server/client
@@ -1315,6 +1322,9 @@ DdeObjCmd(
return TCL_ERROR;
}
Tcl_DStringInit(&serviceBuf);
Tcl_DStringInit(&topicBuf);
Tcl_DStringInit(&itemBuf);
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
@@ -1364,7 +1374,7 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
} else if (objc >= 6 && objc <= 7) {
} else if ((objc >= 6) && (objc <= 7)) {
firstArg = objc - 3;
for (i = 2; i < firstArg; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
@@ -1449,11 +1459,12 @@ DdeObjCmd(
Initialize();
if (firstArg != 1) {
#ifdef UNICODE
serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
#else
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
#endif
const char *src = Tcl_GetString(objv[firstArg]);
length = objv[firstArg]->length;
Tcl_WinUtfToTChar(src, length, &serviceBuf);
serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf);
length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR);
} else {
length = 0;
}
@@ -1466,11 +1477,11 @@ DdeObjCmd(
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
#ifdef UNICODE
topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
#else
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
#endif
const char *src = Tcl_GetString(objv[firstArg + 1]);
length = objv[firstArg + 1]->length;
topicName = Tcl_WinUtfToTChar(src, length, &topicBuf);
length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR);
if (length == 0) {
topicName = NULL;
} else {
@@ -1484,32 +1495,40 @@ DdeObjCmd(
serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
#ifdef UNICODE
Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
#else
Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
#endif
Tcl_DString dsBuf;
Tcl_WinTCharToUtf(serviceName, -1, &dsBuf);
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
Tcl_DStringLength(&dsBuf)));
Tcl_DStringFree(&dsBuf);
} else {
Tcl_ResetResult(interp);
}
break;
case DDE_EXECUTE: {
int dataLength;
const Tcl_UniChar *dataString;
size_t dataLength;
const void *dataString;
Tcl_DString dsBuf;
Tcl_DStringInit(&dsBuf);
if (flags & DDE_FLAG_BINARY) {
dataString = (const Tcl_UniChar *)
Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
} else {
dataString =
Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
getByteArrayFromObj(objv[firstArg + 2], &dataLength);
} else {
const char *src;
src = Tcl_GetString(objv[firstArg + 2]);
dataLength = objv[firstArg + 2]->length;
dataString = (const TCHAR *)
Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
}
if (dataLength <= 0) {
if (dataLength + 1 < 2) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
Tcl_DStringFree(&dsBuf);
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
@@ -1519,6 +1538,7 @@ DdeObjCmd(
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
Tcl_DStringFree(&dsBuf);
SetDdeError(interp);
result = TCL_ERROR;
break;
@@ -1544,16 +1564,17 @@ DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
}
Tcl_DStringFree(&dsBuf);
break;
}
case DDE_REQUEST: {
#ifdef UNICODE
const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
&length);
#else
const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
#endif
const TCHAR *itemString;
const char *src;
src = Tcl_GetString(objv[firstArg + 2]);
length = objv[firstArg + 2]->length;
itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
if (length == 0) {
Tcl_SetObjResult(interp,
@@ -1581,18 +1602,23 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
DWORD tmp;
const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp);
if (flags & DDE_FLAG_BINARY) {
returnObjPtr =
Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
} else {
tmp >>= 1;
if (tmp && !dataString[(tmp-1)]) {
--tmp;
Tcl_DString dsBuf;
if ((tmp >= sizeof(TCHAR))
&& !dataString[tmp / sizeof(TCHAR) - 1]) {
tmp -= sizeof(TCHAR);
}
returnObjPtr = Tcl_NewUnicodeObj(dataString,
(int) tmp);
Tcl_WinTCharToUtf(dataString, tmp, &dsBuf);
returnObjPtr =
Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
Tcl_DStringLength(&dsBuf));
Tcl_DStringFree(&dsBuf);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1603,19 +1629,18 @@ DdeObjCmd(
result = TCL_ERROR;
}
}
break;
}
case DDE_POKE: {
#ifdef UNICODE
const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
&length);
#else
const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
&length);
#endif
Tcl_DString dsBuf;
const TCHAR *itemString;
BYTE *dataString;
const char *src;
src = Tcl_GetString(objv[firstArg + 2]);
length = objv[firstArg + 2]->length;
itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot have a null item", -1));
@@ -1623,13 +1648,17 @@ DdeObjCmd(
result = TCL_ERROR;
goto cleanup;
}
Tcl_DStringInit(&dsBuf);
if (flags & DDE_FLAG_BINARY) {
dataString = (BYTE *)
Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
getByteArrayFromObj(objv[firstArg + 3], &length);
} else {
const char *data =
Tcl_GetString(objv[firstArg + 3]);
length = objv[firstArg + 3]->length;
dataString = (BYTE *)
Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
length = 2 * length + 1;
Tcl_WinUtfToTChar(data, length, &dsBuf);
length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
@@ -1654,6 +1683,7 @@ DdeObjCmd(
result = TCL_ERROR;
}
}
Tcl_DStringFree(&dsBuf);
break;
}
@@ -1712,7 +1742,7 @@ DdeObjCmd(
* referring to deallocated objects.
*/
if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
"permission denied: a handler procedure must be"
" defined for use in a safe interp", -1));
@@ -1757,8 +1787,7 @@ DdeObjCmd(
objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
if (objPtr) {
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
Tcl_AppendObjToErrorInfo(interp, objPtr);
}
objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
@@ -1772,6 +1801,8 @@ DdeObjCmd(
Tcl_Release(riPtr);
Tcl_Release(sendInterp);
} else {
Tcl_DString dsBuf;
/*
* This is a non-local request. Send the script to the server and
* poll it for a result.
@@ -1787,9 +1818,14 @@ DdeObjCmd(
}
objPtr = Tcl_ConcatObj(objc, objv);
string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance,
(BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
string = Tcl_GetString(objPtr);
length = objPtr->length;
Tcl_WinUtfToTChar(string, length, &dsBuf);
string = Tcl_DStringValue(&dsBuf);
length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
(DWORD) length, 0, 0, CF_UNICODETEXT, 0);
Tcl_DStringFree(&dsBuf);
if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
@@ -1818,7 +1854,7 @@ DdeObjCmd(
if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
Tcl_UniChar *ddeDataString;
TCHAR *ddeDataString;
/*
* The return handle has a two or four element list in it. The
@@ -1829,13 +1865,17 @@ DdeObjCmd(
* variable "errorInfo".
*/
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
ddeDataString = ckalloc(length);
ddeDataString = (TCHAR *) Tcl_Alloc(length);
DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
length = (length >> 1) - 1;
resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
ckfree(ddeDataString);
if (length > sizeof(TCHAR)) {
length -= sizeof(TCHAR);
}
Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf);
resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
Tcl_DStringLength(&dsBuf));
Tcl_DStringFree(&dsBuf);
Tcl_Free((char *) ddeDataString);
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
@@ -1853,9 +1893,7 @@ DdeObjCmd(
Tcl_DecrRefCount(resultPtr);
goto invalidServerResponse;
}
length = -1;
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
Tcl_AppendObjToErrorInfo(interp, objPtr);
Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
Tcl_SetObjErrorCode(interp, objPtr);
@@ -1887,6 +1925,9 @@ DdeObjCmd(
if (hConv != NULL) {
DdeDisconnect(hConv);
}
Tcl_DStringFree(&itemBuf);
Tcl_DStringFree(&topicBuf);
Tcl_DStringFree(&serviceBuf);
return result;
}
+3 -4
View File
@@ -1026,7 +1026,8 @@ DoRemoveJustDirectory(
if (nativePath == NULL || nativePath[0] == '\0') {
Tcl_SetErrno(ENOENT);
goto end;
Tcl_DStringInit(errorPtr);
return TCL_ERROR;
}
attr = GetFileAttributes(nativePath);
@@ -1108,9 +1109,7 @@ DoRemoveJustDirectory(
end:
if (errorPtr != NULL) {
char *p;
Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
p = Tcl_DStringValue(errorPtr);
char *p = Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
for (; *p; ++p) {
if (*p == '\\') *p = '/';
}
Regular → Executable
+9
View File
@@ -531,6 +531,11 @@ TclWinSymLinkDelete(
*--------------------------------------------------------------------
*/
#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Warray-bounds"
#endif
static Tcl_Obj *
WinReadLinkDirectory(
const TCHAR *linkDirPath)
@@ -648,6 +653,10 @@ WinReadLinkDirectory(
Tcl_SetErrno(EINVAL);
return NULL;
}
#if defined (__clang__) || ((__GNUC__) && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic pop
#endif
/*
*--------------------------------------------------------------------
+4 -4
View File
@@ -1495,10 +1495,10 @@ QuoteCmdLinePart(
QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
start = *bspos;
}
/*
* escape all special chars enclosed in quotes like `"..."`, note that here we
/*
* escape all special chars enclosed in quotes like `"..."`, note that here we
* don't must escape `\` (with `\`), because it's outside of the main quotes,
* so `\` remains `\`, but important - not at end of part, because results as
* so `\` remains `\`, but important - not at end of part, because results as
* before the quote, so `%\%\` should be escaped as `"%\%"\\`).
*/
TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
@@ -1653,7 +1653,7 @@ BuildCommandLine(
special++;
}
/* rest of argument (and escape backslashes before closing main quote) */
QuoteCmdLineBackslash(&ds, start, special,
QuoteCmdLineBackslash(&ds, start, special,
(quote & CL_QUOTE) ? bspos : NULL);
}
if (quote & CL_QUOTE) {
+44 -43
View File
@@ -22,13 +22,6 @@
#endif
#include <stdlib.h>
#ifndef UNICODE
# undef Tcl_WinTCharToUtf
# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
# undef Tcl_WinUtfToTChar
# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
#endif /* !UNICODE */
/*
* Ensure that we can say which registry is being accessed.
*/
@@ -131,6 +124,25 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj, REGSAM mode);
static unsigned char *
getByteArrayFromObj(
Tcl_Obj *objPtr,
size_t *lengthPtr
) {
int length;
unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
/* 64-bit and TIP #494 situation: */
*lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
} else
#endif
/* 32-bit or without TIP #494 */
*lengthPtr = (size_t) (unsigned) length;
return result;
}
DLLEXPORT int Registry_Init(Tcl_Interp *interp);
DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
@@ -163,7 +175,7 @@ Registry_Init(
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
return Tcl_PkgProvide(interp, "registry", "1.3.2");
return Tcl_PkgProvide(interp, "registry", "1.3.3");
}
/*
@@ -414,12 +426,12 @@ DeleteKey(
*/
keyName = Tcl_GetString(keyNameObj);
buffer = ckalloc(keyNameObj->length + 1);
buffer = Tcl_Alloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
&keyName) != TCL_OK) {
ckfree(buffer);
Tcl_Free(buffer);
return TCL_ERROR;
}
@@ -427,7 +439,7 @@ DeleteKey(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("bad key: cannot delete root keys", -1));
Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
ckfree(buffer);
Tcl_Free(buffer);
return TCL_ERROR;
}
@@ -442,7 +454,7 @@ DeleteKey(
mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
if (result != ERROR_SUCCESS) {
ckfree(buffer);
Tcl_Free(buffer);
if (result == ERROR_FILE_NOT_FOUND) {
return TCL_OK;
}
@@ -470,7 +482,7 @@ DeleteKey(
}
RegCloseKey(subkey);
ckfree(buffer);
Tcl_Free(buffer);
return result;
}
@@ -499,7 +511,6 @@ DeleteValue(
{
HKEY key;
char *valueName;
size_t length;
DWORD result;
Tcl_DString ds;
@@ -513,8 +524,7 @@ DeleteValue(
}
valueName = Tcl_GetString(valueNameObj);
length = valueNameObj->length;
Tcl_WinUtfToTChar(valueName, length, &ds);
Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
@@ -603,8 +613,7 @@ GetKeyNames(
}
break;
}
Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
name = Tcl_DStringValue(&ds);
name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
continue;
@@ -655,7 +664,6 @@ GetType(
Tcl_DString ds;
const char *valueName;
const TCHAR *nativeValue;
size_t length;
/*
* Attempt to open the key for reading.
@@ -671,8 +679,7 @@ GetType(
*/
valueName = Tcl_GetString(valueNameObj);
length = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
@@ -728,7 +735,6 @@ GetValue(
const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
size_t nameLen;
/*
* Attempt to open the key for reading.
@@ -754,8 +760,7 @@ GetValue(
length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
valueName = Tcl_GetString(valueNameObj);
nameLen = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
@@ -944,13 +949,11 @@ OpenKey(
HKEY *keyPtr) /* Returned HKEY. */
{
char *keyName, *buffer, *hostName;
size_t length;
HKEY rootKey;
DWORD result;
keyName = Tcl_GetString(keyNameObj);
length = keyNameObj->length;
buffer = ckalloc(length + 1);
buffer = Tcl_Alloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -966,7 +969,7 @@ OpenKey(
}
}
ckfree(buffer);
Tcl_Free(buffer);
return result;
}
@@ -1019,7 +1022,9 @@ OpenSubKey(
* this key must be closed by the caller.
*/
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
if (keyName) {
keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
}
if (flags & REG_CREATE) {
DWORD create;
@@ -1037,7 +1042,9 @@ OpenSubKey(
result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
keyPtr);
}
Tcl_DStringFree(&buf);
if (keyName) {
Tcl_DStringFree(&buf);
}
/*
* Be sure to close the root key since we are done with it now.
@@ -1248,7 +1255,6 @@ SetValue(
REGSAM mode) /* Mode flags to pass. */
{
int type;
size_t length;
DWORD result;
HKEY key;
const char *valueName;
@@ -1269,8 +1275,7 @@ SetValue(
}
valueName = Tcl_GetString(valueNameObj);
length = valueNameObj->length;
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
int value;
@@ -1305,8 +1310,7 @@ SetValue(
for (i = 0; i < objc; i++) {
const char *bytes = Tcl_GetString(objv[i]);
length = objv[i]->length;
Tcl_DStringAppend(&data, bytes, length);
Tcl_DStringAppend(&data, bytes, objv[i]->length);
/*
* Add a null character to separate this value from the next.
@@ -1326,28 +1330,26 @@ SetValue(
Tcl_DString buf;
const char *data = Tcl_GetString(dataObj);
length = dataObj->length;
data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf);
/*
* Include the null in the length, padding if needed for WCHAR.
*/
Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
length = Tcl_DStringLength(&buf) + 1;
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, (BYTE *) data, (DWORD) length);
(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
int bytelength;
size_t bytelength;
/*
* Store binary data in the registry.
*/
data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
(DWORD) type, data, (DWORD) bytelength);
}
@@ -1408,8 +1410,7 @@ BroadcastValue(
}
str = Tcl_GetString(objv[0]);
len = objv[0]->length;
wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds);
if (Tcl_DStringLength(&ds) == 0) {
wstr = NULL;
}