Compare commits

...
138 Commits
Author SHA1 Message Date
pspjuth 63802cdd70 Simplify to only accept index arguemnts. No index list.
Added manual page.
2018-10-24 22:15:50 +00:00
pspjuth 36f2cb4d7d Implement TIP 523, New lpop command 2018-10-22 18:43:47 +00:00
jan.nijtmans 86013715f6 Missing ',' in documentation (discovered by MacOSX help processing). Some whitespacing 2018-10-22 18:36:42 +00:00
jan.nijtmans cee756478e Fix error-message on MacOS: the __LINKEDIT segment does not cover the end of the file.
Reason: We appended a zip-file to the end of the library, so during install "strip" doesn't work any more
2018-10-22 18:21:23 +00:00
jan.nijtmans 2517987176 Merge 8.6 2018-10-22 17:54:16 +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 3ecac0e0ab merge fork 2018-10-22 05:14:54 +00:00
dkf e4c108f3d7 Make new notifier code match Engineering Manual guidelines better 2018-10-22 04:30:24 +00:00
jan.nijtmans d2c82fc45a Change PTR2INT and PTR2UINT macros's so they can handle long's and Tcl_WideInt's too, so no longer restricted to the "int" range. 2018-10-21 20:38:02 +00:00
dkf 7c2e55d3fd Squash warnings in the OSX notifier 2018-10-21 10:50:21 +00:00
jan.nijtmans cb061edef8 Merge 8.6 2018-10-19 15:52:42 +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 fca6e38924 merge core-8-6-branch 2018-10-19 10:06:23 +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 e7392a5c22 Update TZ info to tzdata2018f. 2018-10-18 18:24:50 +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 49ebd1264d Add -Wpointer-arith compiler flag to gcc 2018-10-17 22:37:43 +00:00
jan.nijtmans 94d07354ce Merge 8.6 2018-10-17 20:02:36 +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 e154c51512 merge 8.6 2018-10-17 16:24:16 +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
dkf 2482413c83 Minor doc update 2018-10-12 18:45:54 +00:00
dkf de2192ab20 Turn [zipfs tcl_library] into more internal [tcl::zipfs::tcl_library_init]. It wasn't documented and isn't very useful outside of Tcl's startup code. 2018-10-12 18:44:25 +00:00
jan.nijtmans 7fcc213b7a TCL_NUMBER_WIDE is deprecated 2018-10-12 18:24:20 +00:00
jan.nijtmans 5aceb08fb4 Merge 8.6 2018-10-12 18:15:24 +00:00
jan.nijtmans 1d465c4012 TIP #502 implementation: Index value reform. 2018-10-12 18:14:51 +00:00
jan.nijtmans cc945fabb7 Fix test for UNICODE in win/tclAppInit.c. No longer check for "tclsh install", because tclsh is not compiled with that. Fix minizip.c compilation on systems without open64() 2018-10-12 17:54:42 +00:00
dkf 621251ae2e Added docs for [zipfs lmkimg] and [zipfs lmkzip] 2018-10-12 12:07:13 +00:00
dkf 13e35220c2 Better document how to package an executable script in a zipfs 2018-10-12 09:52:56 +00:00
dkf 45e6ca04f5 Document [zipfs canonical] and add examples of how to use passwords. 2018-10-12 07:36:19 +00:00
dkf 5719d6ca30 Put documented [zipfs find] in ensemble. Add examples to docs. 2018-10-11 07:24:40 +00:00
jan.nijtmans 58d332cff9 Use TCL_THREADS in stead of defined(TCL_THREADS) everywhere, otherwise it will give unexpected results with TCL_THREADS=0 2018-10-09 21:13:42 +00:00
jan.nijtmans 1f2c3cb141 isspace -> TclIsSpaceProc in various places.
Re-generate tclDate.c with Bision 3.1
2018-10-09 19:43:38 +00:00
jan.nijtmans 398efeba2d Fix test-case macOSXFCmd-4.1, by assuring the files are sorted alphabetically always. The file-sytem cannot be thrusted doing this. 2018-10-09 19:27:26 +00:00
dkf 0591917a06 Avoid making question marks bold or italic in docs UNLESS EXACTLY MEANINGFUL 2018-10-09 18:52:52 +00:00
dgp bbdb1f12a0 Use the 4 argument form of [makeFile]. 2018-10-09 18:24:57 +00:00
dkf fed4d43bd5 Balance the [makeFile/makeDirectory] and [removeFile/removeDirectory] calls (conditional now, so avoids warnings in filter/constraint cases). 2018-10-09 17:56:34 +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
dkf 77282aad96 Improve documentation of [tcl::process] 2018-10-09 08:21:32 +00:00
jan.nijtmans c9301353fc Tcl_GetStringFromObj -> Tcl_GetString 2018-10-08 22:32:08 +00:00
jan.nijtmans 4b7747b505 Fix MSVC warning: warning C4146: unary minus operator applied to unsigned type, result
still unsigned (hopefully)
2018-10-08 20:47:26 +00:00
jan.nijtmans e7a40e1084 TIP #514 implementation: Platform differences in handling int/wide 2018-10-08 19:08:14 +00:00
jan.nijtmans ee49fa81d9 Merge 8.6
Also fix startup problems on win32, when the encoding path contains invalid UTF-8 (reported by François Vogel)
Various other code cleanup, e.g. remove empty.zip file, as this didn't work quite as expected.
2018-10-08 18:34:09 +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
dkf 3826a26f8a Centralise the de-fanging of standard ensembles in safe interpreters. Doing it right once is easier than repeating hacks... 2018-10-07 19:34:52 +00:00
dkf 045e0f533d Add better error reporting to zipfs. 2018-10-07 12:25:34 +00:00
jan.nijtmans ac711bcf45 protect Tcl_WinUtfToTChar/Tcl_WinTCharToUtf against NULL input values: return empty string in that case.
Add TIP #494-compatible definitions of TCL_IO_FAILURE/TCL_AUTO_LENGTH, and use it in some appropriate places.
2018-10-06 17:12:46 +00:00
dkf b5f75d3392 More regularizing of function names, field names and testing styles 2018-10-06 16:49:40 +00:00
dkf ffc7a9f0b9 More cleaning up. 2018-10-06 13:07:52 +00:00
dkf a557024511 Cleanup work on zipfs(n) 2018-10-06 06:41:28 +00:00
dkf 0efc494b97 More tidying up of zipfs 2018-10-06 06:22:57 +00:00
jan.nijtmans 70fb513ba3 Merge 8.6 2018-10-05 21:22:13 +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
dgp 33d71c61d9 merge 8.6 2018-10-05 19:41:28 +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 d1ec31a73d Merge 8.6 2018-10-04 19:26:18 +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
dkf b45b819dfe Clean up zipfs implementation a bit. 2018-10-04 10:42:11 +00:00
sebres c365555a69 fixed TclGetWideBitsFromObj - minus applied to unsigned type 2018-10-04 08:04:08 +00:00
dkf 9707adf634 Added Emacs metadata to a bunch of nroff source files. 2018-10-04 07:27:32 +00:00
jan.nijtmans 05e0ee4c06 Merge 8.6 2018-10-03 20:02:25 +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
hypnotoad 8f20d609b9 Eliminating whitespace changes introduced by the prior checkin 2018-10-01 18:01:13 +00:00
hypnotoad ef381abdfd Pulling back in changes to fix testing on cross compiled static builds 2018-10-01 17:05:00 +00:00
hypnotoad 3dc49c128c Adjust when tcl consults zipfs until AFTER it has checked that env(TCL_LIBRARY)
has not been set
2018-10-01 16:41:12 +00:00
hypnotoad 38dcdcb300 Fixed the arguments that zipfs mount was sending in auto.tcl.
Standardized on 8 spaces instead of tab characters inside of that file.

(The indent pattern was not consistent and editing the file in a modern
editor was... painful.)

Added logic to check the current path for a zipfile with the name of the 
package being loaded. This allows wish to load tcl_library from a zip file in the same
directory as the executable. And in fact, any package which uses the 
tcl_findLibrary mechanism with get this behavior for free.
2018-09-30 23:12:13 +00:00
hypnotoad d0ac3d107b Adding Zipfile to the list of products produced for builds 2018-09-30 22:21:50 +00:00
hypnotoad f08ec44049 Adding logic for static builds to load a properly named zipfile
in the present working directory if that zipfile was not present in
either the install directory or the source directory.
2018-09-30 10:17:44 +00:00
jan.nijtmans acbdbb87fb Add support for wine. So windows test-cases can now be run on Linux/Mac/whatever. 2018-09-29 20:39:10 +00:00
dkf a9dab78604 More readability improvements to unix makefile 2018-09-29 08:51:42 +00:00
jan.nijtmans 084fba1d17 \Merge 8.7 2018-09-28 19:59:40 +00:00
jan.nijtmans c414b83e0a Merge 8.7 2018-09-28 19:58:43 +00:00
jan.nijtmans 3f2c2080cc Merge 8.6 2018-09-28 18:49:45 +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
jan.nijtmans 6d137e77a5 nmake build fixes for zipfs (ongoing, zip attachments not done yet) 2018-09-28 18:21:10 +00:00
dkf 4ee2aeb33d Small fixes to unix makefile 2018-09-28 13:59:19 +00:00
dkf fd03d49b6f Better phrasing from TIP 509 2018-09-28 09:54:24 +00:00
dkf 29fbee5784 Implement TIP 509: reentrant mutexes on all platforms 2018-09-28 09:50:58 +00:00
dkf eede8c60a1 Clean up code style and add key phrases to documentation. 2018-09-28 09:49:57 +00:00
dkf 9dabbdf40b merge core-8-branch 2018-09-28 09:18:49 +00:00
dkf 2f3fc1cfa2 Fix minor typo 2018-09-28 07:24:59 +00:00
jan.nijtmans 66dc9d1fbf Merge 8.7 2018-09-27 21:46:24 +00:00
jan.nijtmans e170502d63 Merge 8.7 2018-09-27 21:38:11 +00:00
dkf b1e6b58b6a Implementation of TIP 426: Determining the "Type" of Commands 2018-09-27 11:08:14 +00:00
dgp 71e4ddb74f merge 8.7 2018-09-25 13:31:19 +00:00
jan.nijtmans 4603752cef merge tip-515 branch 2018-09-22 13:37:28 +00:00
jan.nijtmans 1795b4118f merge tip-515 (which is pre-requisite for this TIP now) 2018-09-22 12:54:54 +00:00
jan.nijtmans b47bd89d44 TCL_NUMBER_WIDE -> TCL_NUMBER_INT. Two test-cases still failing 2018-09-08 21:49:09 +00:00
jan.nijtmans 33201eb14c Bring back test-cases closer to what they were 2018-09-08 21:34:48 +00:00
jan.nijtmans 079f1e33dc Merge TIP-515 branch, so part of the corrections in the TIP-514 implementation branch now moved to the TIP-515 implementation. 2018-09-08 21:29:40 +00:00
jan.nijtmans cf341f6a19 Merge 8.7 2018-09-05 08:07:25 +00:00
jan.nijtmans ce13b82329 Merge 8.7 2018-09-03 13:45:49 +00:00
jan.nijtmans 2afacbce95 Merge 8.7, and improve TIP implementation (using utility function in more places) 2018-08-30 21:28:51 +00:00
jan.nijtmans c8e7bb7653 Fix compilation on 32-bit platforms, and fix unit-tests in this environment 2018-08-29 19:30:37 +00:00
jan.nijtmans eeebae7172 Now, restore wide(), but make int() the same as entier(). Add new utility function. 2018-08-28 22:28:50 +00:00
jan.nijtmans 80d62f0547 improved reange checking (also for the Tcl 9.0 proposal). Make platform test platform 32/64-bit independant 2018-08-21 21:36:03 +00:00
jan.nijtmans e588745d77 Re-base branch "all-wideint" to core-8-branch. Still WIP 2018-08-19 09:33:34 +00:00
jan.nijtmans b3fc99501e Still WIP. All test-cases pass now in 32-bit 2018-08-19 09:13:16 +00:00
jan.nijtmans c475df7cfb Undo various test-case changes, in order to prove platform compatibility 2018-08-16 18:54:44 +00:00
jan.nijtmans 51ce0579e8 Few more test-cases 2018-08-16 18:13:31 +00:00
jan.nijtmans 57102e40e9 Experiment, resolving platform differences at script level. Don't look ... 2018-08-16 18:03:27 +00:00
jan.nijtmans afc4e512cb Merge 8.7. Also provide a new function for handling ByteArrays 2018-08-14 07:27:38 +00:00
dgp 0d36d5f3d8 merge 8.7 2018-06-12 18:03:09 +00:00
dgp a54459bed6 close fork 2018-06-12 18:02:24 +00:00
fbonnet 7fe9e1b90c Removed thread-specific mutex lock counter and replaced by shared counter + thread ID for systems without PTHREAD_MUTEX_RECURSIVE 2018-06-09 17:20:15 +00:00
dgp 29bbdb74d3 merge 8.7 2018-06-04 13:07:15 +00:00
jan.nijtmans f2ec60553a merge 8.7 2018-05-27 16:32:05 +00:00
fbonnet b91a2765ae TIP #509: Implement reentrant mutexes on all platforms 2018-05-25 19:43:23 +00:00
fbonnet fae1c11488 Create new branch named "tip-509" 2018-05-24 16:26:16 +00:00
dgp 202eeb707c merge 8.7 2018-05-24 12:24:54 +00:00
dgp ae6192f9cb merge 8.7 2018-05-11 11:26:20 +00:00
dgp 351c77bca3 silence compiler warning 2018-04-24 14:02:49 +00:00
dgp c1555b7cfd merge 8.7 2018-04-24 13:59:43 +00:00
dgp 48ed067359 merge 8.7 2018-04-07 17:12:14 +00:00
dgp 3fe69cba13 merge 8.7 2018-03-30 19:51:05 +00:00
dgp a3204f806c Rebase TIP 502 draft implementation. 2018-03-30 12:32:22 +00:00
dgp 3616fc519b merge 8.7 2018-03-06 13:50:45 +00:00
dgp 5fd49d1907 Merge 8.7; avoid checkin converting TclGetNumberFromObj to TclParseNumber. 2018-03-05 16:09:08 +00:00
dgp 7024801722 merge 8.7 2018-03-01 20:20:55 +00:00
dgp 40dfdbd929 Avoid full list conversion when we can cheaply discover a multi-element list
is not possible.
2018-03-01 19:30:15 +00:00
dgp 0cb6effe14 Continue consistent use of LLONG_MIN and LLONG_MAX. 2018-03-01 04:19:37 +00:00
dgp a0c07fcf28 merge 8.7 2018-03-01 04:13:47 +00:00
dgp 221f1bc18e Use mp_isneg() as appropriate. 2018-02-28 13:40:36 +00:00
dgp c0c1cce296 merge 8.7 2018-02-28 13:38:01 +00:00
dgp a628ce605f merge 8.7 2018-02-27 23:17:17 +00:00
dgp 3607c177d9 Don't save indices with values outside the int range in bytecode. 2018-02-27 22:35:24 +00:00
dgp e1efe253d2 Much more progress expanding the vocabulary of index values, and getting
results that make more intuitive sense.  Still a few TODOs and tests to update.
2018-02-27 18:20:44 +00:00
dgp 544d338e0e Work In Progress on index value reform -- not working. 2018-02-27 13:13:11 +00:00
dgp 3b3a5ff07f Better range checking in "string index". Add test-case to prove point.
This opens a large discussion on what the right valid range for index
values should be and what overflow behavior should be. New branch opened
to answer those questions completely.
2018-02-15 17:24:40 +00:00
jan.nijtmans 67e505d2ab First implementation of [http://core.tcl.tk/tips/doc/trunk/tip/481.md|TIP #481]: Extend size range of various Tcl_Get*() functions 2017-10-27 08:45:13 +00:00
135 changed files with 7734 additions and 6115 deletions
-1
View File
@@ -4,7 +4,6 @@ compat/zlib/win64/zdll.lib
compat/zlib/win64/zlib1.dll
compat/zlib/win64/libz.dll.a
compat/zlib/zlib.3.pdf
tools/empty.zip
*.bmp
*.gif
*.png
-19
View File
@@ -1,19 +0,0 @@
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
+1 -1
View File
@@ -1426,7 +1426,7 @@
initialization assumptions of the TIP 280 code in CompileWord().
* generic/tclCompExpr.c: Suppress the attempt to convert to
numeric when pre-compiling a constant expresion indicates an error.
numeric when pre-compiling a constant expression indicates an error.
2007-08-22 Miguel Sofer <msofer@users.sf.net>
+2 -2
View File
@@ -27,7 +27,7 @@
#endif
#endif
#ifdef __APPLE__
#if defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
@@ -359,7 +359,7 @@ void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, i
void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
tinydir_dir dir;
int i;
char *newname[512];
char newname[512];
tinydir_open_sorted(&dir, filenameinzip);
Executable → Regular
View File
+1 -1
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj, Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
+9 -3
View File
@@ -45,7 +45,9 @@ int
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
A mutex lock.
.VS TIP509
A recursive mutex lock.
.VE TIP509
.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait. NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
@@ -140,8 +142,12 @@ of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
The result of locking a mutex twice from the same thread is undefined.
On some platforms it will result in a deadlock.
.VS TIP509
Mutexes are reentrant: they can be locked several times from the same
thread. However there must be exactly one call to
\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
for a thread to release a mutex completely.
.VE TIP509
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
+4
View File
@@ -41,3 +41,7 @@ current one:
filename(n), glob(n), pwd(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+16 -10
View File
@@ -886,40 +886,46 @@ The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR
A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR
or \fBhhmm ?meridian? ?zone?\fR
If no meridian is specified, \fBhh\fR is interpreted on
.
A time of day, which is of the form:
.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
or
.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR
.
A specific month and day with optional year. The
acceptable formats are
.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
.QW "\fBdd monthname yy\fR" ,
.QW "?\fBCC\fR?\fByymmdd\fR" ,
.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
.QW "\fIdd monthname yy\fR" ,
.QW "?\fICC\fR?\fIyymmdd\fR" ,
and
.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
The default year is the current year. If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999. Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
.
An ISO 8601 point-in-time specification, such as
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
or
.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601. Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
.
A specification relative to the current time. The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
+4
View File
@@ -59,3 +59,7 @@ while {1} {
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -49,3 +49,7 @@ if {[catch {main} msg options]} {
exec(n)
.SH KEYWORDS
abort, exit, process
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -65,3 +65,7 @@ vwait forever
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -154,3 +154,7 @@ fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -176,3 +176,7 @@ file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -43,3 +43,7 @@ puts "Hello there, $name!"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -102,3 +102,7 @@ for(n), while(n), break(n), continue(n)
.SH KEYWORDS
foreach, iteration, list, loop
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -56,3 +56,7 @@ proc accum {string} {
namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -100,3 +100,7 @@ the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+2 -2
View File
@@ -13,10 +13,10 @@
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http ?2.8?\fR
\fBpackage require http\fI ?\fB2.8\fR?
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config ?\fI\-option value\fR ...?
\fB::http::config\fR ?\fI\-option value\fR ...?
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
+1 -1
View File
@@ -236,7 +236,7 @@ attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
+4
View File
@@ -42,3 +42,7 @@ set data {1 {2 3} 4 {5 {6 7} 8}}
list(n), lappend(n), split(n)
.SH KEYWORDS
element, join, list, separator
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+1 -1
View File
@@ -13,7 +13,7 @@
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
\fBlindex \fIlist ?index ...?\fR
\fBlindex \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
+4
View File
@@ -53,3 +53,7 @@ list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+96
View File
@@ -0,0 +1,96 @@
'\"
'\" Copyright (c) 2018 by Peter Spjuth. All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
lpop \- Get and remove an element in a list
.SH SYNOPSIS
\fBlpop \fIvarName ?index ...?\fR
.BE
.SH DESCRIPTION
.PP
The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which
it interprets as the name of a variable containing a Tcl list.
It also accepts one or more \fIindices\fR into
the list. If no indices are presented, it defaults to "end".
.PP
When presented with a single index, the \fBlpop\fR command
addresses the \fIindex\fR'th element in it, removes if from the list
and returns the element.
.PP
If \fIindex\fR is negative or greater or equal than the number
of elements in \fI$varName\fR, then an error occurs.
.PP
The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
used in turn to address an element within a sublist designated
by the previous indexing operation,
allowing the script to remove elements in sublists.
The command,
.PP
.CS
\fBlpop\fR a 1 2
.CE
.PP
gets and removes element 2 of sublist 1.
.PP
.SH EXAMPLES
.PP
In each of these examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list a b c] [list d e f] [list g h i]]
\fI\(-> {a b c} {d e f} {g h i}\fR
.CE
.PP
The indicated value becomes the new value of \fIx\fR
(except in the last case, which is an error which leaves the value of
\fIx\fR unchanged.)
.PP
.CS
\fBlpop\fR x 0
\fI\(-> {d e f} {g h i}\fR
\fBlpop\fR x 2
\fI\(-> {a b c} {d e f}\fR
\fBlpop\fR x end
\fI\(-> {a b c} {d e f}\fR
\fBlpop\fR x end-1
\fI\(-> {a b c} {g h i}\fR
\fBlpop\fR x 2 1
\fI\(-> {a b c} {d e f} {g i}\fR
\fBlpop\fR x 2 3 j
\fI\(-> list index out of range\fR
.CE
.PP
In the following examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list [list a b] [list c d]] \e
[list [list e f] [list g h]]]
\fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
.CE
.PP
The indicated value becomes the new value of \fIx\fR.
.PP
.CS
\fBlpop\fR x 1 1 0
\fI\(-> {{a b} {c d}} {{e f} h}\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lsort(n), lrange(n), lreplace(n), lset(n)
string(n)
.SH KEYWORDS
element, index, list, remove, pop, stack, queue
'\"Local Variables:
'\"mode: nroff
'\"End:
+4
View File
@@ -76,3 +76,7 @@ lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4 -1
View File
@@ -33,6 +33,9 @@ is identical to \fBlist element ...\fR.
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)
.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+12 -22
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,36 +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.
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 \fIfirst\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 this command to append elements to the list.
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
For non-empty lists, the element indicated
by \fIfirst\fR must exist, or \fIfirst\fR must indicate before the
start of the list.
.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.
.VS TIP505
If \fIlast\fR is greater than the index of the last item of the list, it is
treated as if it is an index one greater than the last element. This means
that if it is also greater than than \fIfirst\fR, all elements from
\fIfirst\fR to the end of the list will be replaced, and otherwise the
elements will be appended.
.VE TIP505
.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:
@@ -93,7 +83,7 @@ proc lremove {listVariable value} {
.CE
.PP
.VS TIP505
Adding elements to the end of the list; note that \fBend+2\fR will initially
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
+4
View File
@@ -48,3 +48,7 @@ At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
package(n)
.SH KEYWORDS
auto-load, index, package, version
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4 -1
View File
@@ -43,6 +43,9 @@ close $pipeline
.SH "SEE ALSO"
exec(n), open(n)
.SH KEYWORDS
file, pipeline, process identifier
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+1 -1
View File
@@ -12,7 +12,7 @@
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform ?1.0.10?\fR
\fBpackage require platform\fR ?\fB1.0.10\fR?
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
+5 -1
View File
@@ -12,7 +12,7 @@
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform::shell ?1.1.4?\fR
\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
@@ -55,3 +55,7 @@ This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+6 -6
View File
@@ -12,9 +12,9 @@
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix all\fR \fItable string\fR
\fB::tcl::prefix longest\fR \fItable string\fR
\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
.fi
.BE
.SH DESCRIPTION
@@ -22,17 +22,17 @@ tcl::prefix \- facilities for prefix matching
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix all\fR \fItable string\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
\fB::tcl::prefix longest\fR \fItable string\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
+54 -35
View File
@@ -16,11 +16,31 @@ tcl::process \- Subprocess management
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR
and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
.TP
\fB::tcl::process autopurge\fR ?\fIflag\fR?
.
Automatic purge facility. If \fIflag\fR is specified as a boolean value then
it activates or deactivate autopurge. In all cases it returns the current
status as a boolean value. When autopurge is active,
\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
inactive, \fB::tcl::process\fR purge must be called explicitly. By default
autopurge is active.
.TP
\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs.
Returns the list of subprocess PIDs. This includes all currently executing
subprocesses and all terminated subprocesses that have not yet had their
corresponding process table entries purged.
.TP
\fB::tcl::process purge\fR ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If a process listed is
still active, this command does nothing to that process.
.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
@@ -29,62 +49,48 @@ Returns a dictionary mapping subprocess PIDs to their respective status. If
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "{code ?\fImsg errorCode\fR?}" ,
.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
where:
.RS
.TP
\fBcode\fR\0
\fIcode\fR\0
.
is a standard Tcl return code,
is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
for TCL_ERROR,
.TP
\fBmsg\fR\0
\fImsg\fR\0
.
is the human-readable error message,
.TP
\fBerrorCode\fR\0
\fIerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.RE
.PP
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
terminated processes (i.e. those where the \fIcode\fR is nonzero). Under the
hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
.RS
.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fBpids\fR is not specified then it
waits for all known subprocesses.
matching subprocesses are available. If \fIpids\fR was not specified, this
command will wait for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches. The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.TP
\fB::tcl::process purge ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If the process is
still active then it does nothing.
.TP
\fB::tcl::process autopurge ?\fIflag\fR?
.
Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
activates or deactivate autopurge. In all cases it returns the current status as
a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
each time the exec command is executed or a pipe channel created by open is
closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
explicitly. By default autopurge is active.
.RE
.SH "EXAMPLES"
.PP
These show the use of \fB::tcl::process\fR. Some of the results from
\fB::tcl::process status\fR are split over multiple lines for readability.
.PP
.CS
\fB::tcl::process autopurge\fR
\fI\(-> true\fR
@@ -102,7 +108,12 @@ set pid2 [pid $chan]
\fI\(-> 123 456 789 1011\fR
\fB::tcl::process status\fR
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR
\fI\(-> 123 0
456 {1 "child killed: write on pipe with no readers" {
CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
789 {1 "child suspended: background tty read" {
CHILDSUSP 789 SIGTTIN "background tty read"}}
1011 {}\fR
\fB::tcl::process status\fR 123
\fI\(-> 123 0\fR
@@ -111,10 +122,17 @@ set pid2 [pid $chan]
\fI\(-> 1011 {}\fR
\fB::tcl::process status\fR -wait
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
\fI\(-> 123 0
456 {1 "child killed: write on pipe with no readers" {
CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
789 {1 "child suspended: background tty read" {
CHILDSUSP 789 SIGTTIN "background tty read"}}
1011 {1 "child process exited abnormally" {
CHILDSTATUS 1011 -1}}\fR
\fB::tcl::process status\fR 1011
\fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
\fI\(-> 1011 {1 "child process exited abnormally" {
CHILDSTATUS 1011 -1}}\fR
\fB::tcl::process purge\fR
exec command1 1 2 3 &
@@ -123,7 +141,8 @@ exec command1 1 2 3 &
\fI\(-> 1213\fR
.CE
.SH "SEE ALSO"
exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
exec(n), open(n), pid(n),
Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
+4
View File
@@ -96,3 +96,7 @@ close $chan
file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -37,3 +37,7 @@ cd $savedDir
file(n), cd(n), glob(n), filename(n)
.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -43,3 +43,7 @@ proc ::source args {
namespace(n), proc(n)
.SH KEYWORDS
command, delete, namespace, rename
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -73,3 +73,7 @@ practice instead of doing double-dereferencing):
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -69,3 +69,7 @@ foreach scriptFile {foo.tcl bar.tcl} {
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+1 -1
View File
@@ -12,7 +12,7 @@
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...?\fR
\fBstring \fIoption arg \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
+4
View File
@@ -46,3 +46,7 @@ if {[read $chan 6] eq "foobar"} {
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, channel, seeking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+2 -1
View File
@@ -20,7 +20,8 @@ trace \- Monitor variable accesses, command usages and command executions
This command causes Tcl commands to be executed whenever certain operations are
invoked. The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops ?args?\fR
\fBtrace add \fItype name ops\fR ?\fIargs\fR?
.
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
+4
View File
@@ -89,3 +89,7 @@ proc \fBunknown\fR args {
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -63,3 +63,7 @@ while {!$done} {
after(n), interp(n)
.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -63,3 +63,7 @@ set lineCount 0
break(n), continue(n), for(n), foreach(n)
.SH KEYWORDS
boolean, loop, test, while
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+86 -38
View File
@@ -10,61 +10,109 @@
.so man.macros
.BS
.SH NAME
TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount, \- handle ZIP files as VFS
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
int
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR)
\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
.sp
int
\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR)
\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
.sp
int
\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR)
\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
.fi
.SH ARGUMENTS
.AP "int" *argc in
Number of command line arguments from main()
.AP "char" ***argv in
Pointer to an array of strings containing the command
line arguments to main()
.AS Tcl_Interp **termPtr
.AS Tcl_Interp *mountpoint in
.AP "int" *argcPtr in
Pointer to a variable holding the number of command line arguments from
\fBmain\fR().
.AP "char" ***argvPtr in
Pointer to an array of strings containing the command line arguments to
\fBmain\fR().
.AP Tcl_Interp *interp in
Interpreter in which the zip file system is mounted. The interpreter's result is
Interpreter in which the ZIP file system is mounted. The interpreter's result is
modified to hold the result or error message from the script.
.AP "const char" *zipname in
Name of a zipfile.
.AP "const char" *mntpt in
Name of a mount point.
.AP "const char" *passwd in
An (optional) password.
Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
.AP "const char" *mountpoint in
Name of a mount point, which must be a legal Tcl file or directory name. May
be NULL to query current mount points.
.AP "const char" *password in
An (optional) password. Use NULL if no password is wanted to read the file.
.AP "unsigned char" *data in
A data buffer to mount. The data buffer must hold the contents of a ZIP
archive, and must not be NULL.
.AP size_t dataLen in
The number of bytes in the supplied data buffer argument, \fIdata\fR.
.AP int copy in
If non-zero, the ZIP archive in the data buffer will be internally copied
before mounting, allowing the data buffer to be disposed once
\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
buffer will be valid to read from for the duration of the mount.
.BE
.SH DESCRIPTION
\fBTclZipfs_AppHook()\fR is a utility function to perform standard
application initialization procedures. If the current application has
a mountable zip file system, that file system is mounted under \fIZIPROOT\fR\fB/app\fR.
If a file named \fBmain.tcl\fR is located in that file system, it is treated
as the startup script for the process. If the file \fIZIPROOT\fR\fB/app/tcl_library/init.tcl\fR
is present, \fBtcl_library\fR is set to \fIZIPROOT\fR\fB/app/tcl_library.
\fBTclZipfs_AppHook\fR is a utility function to perform standard application
initialization procedures, taking into account available ZIP archives as
follows:
.IP [1]
If the current application has a mountable ZIP archive, that archive is
mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
\fBzipfs:\fR may also be used on Windows (due to differences in the
platform's filename parsing).
.IP [2]
If a file named \fBmain.tcl\fR is located in the root directory of that file
system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
mounted as described above) it is treated as the startup script for the
process.
.IP [3]
If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
\fIZIPROOT\fB/app/tcl_library\fR.
.IP [4]
If the directory \fBtcl_library\fR was not found in the main application
mount, the system will then search for it as either a VFS attached to the
application dynamic library, or as a zip archive named
\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
present working directory or in the standard Tcl install location. (For
example, the Tcl 8.7.2 release would be searched for in a file
\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
.PP
On Windows, \fBTclZipfs_AppHook()\fR has a slightly different signature, it uses
WCHAR in stead of char. As a result, it only works if your application is compiled
using -DUNICODE.
On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
it uses WCHAR in stead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
If the \fBtcl_library\fR was not found in the application, the system will then search for it
as either a VFS attached to the application dynamic library, or as a zip archive named
libtcl_\fIMAJOR\fR_\fIMINOR\fR_\fIpatchLevel\fR.zip either in the present working directory
or in the standard tcl install location.
The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
when the function is successful). The function \fImay\fR modify the variables
pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
current implementation does not do so, but callers \fIshould not\fR assume
that this will be true in the future.
.PP
\fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount
point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR.
Errors during that process are reported in the interpreter \fIinterp\fR.
If \fImountpoint\fR is a NULL pointer, information on all currently mounted
ZIP file systems is written into \fIinterp\fR's result as a sequence of
mount points and ZIP file names.
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
Errors during that process are reported in the interpreter \fIinterp\fR. If
\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
file systems is written into \fIinterp\fR's result as a sequence of mount
points and ZIP file names. The result of this call is a standard Tcl result
code.
.PP
\fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR,
i.e. it unmounts the mounted ZIP file system at \fImountpoint\fR. Errors are
reported in the interpreter \fIinterp\fR.
\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
assumed to be not password protected. Errors during that process are reported
in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
the buffer is internally copied before mounting or not. The result of this
call is a standard Tcl result code.
.PP
\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR. The
result of this call is a standard Tcl result code.
.SH "SEE ALSO"
zipfs(n)
.SH KEYWORDS
compress, filesystem, zip
+194 -64
View File
@@ -16,108 +16,238 @@ zipfs \- Mount and work with ZIP files within Tcl
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdir\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
\fBzipfs mkkey\fR \fIpassword\fR
\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
\fBzipfs mount\fR \fI?mountpoint?\fR \fI?zipfile?\fR \fI?password?\fR
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs root\fR
\fBzipfs unmount\fR \fImountpoint\fR
.fi
'\" The following subcommand is *UNDOCUMENTED*
'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
.BE
.SH DESCRIPTION
.PP
The \fBzipfs\fR package provides tcl with the ability to mount
the contents of a zip file as a virtual file system.
The \fBzipfs\fR command (the sole public command provided by the built-in
package with the same name) provides Tcl with the ability to mount the
contents of a ZIP archive file as a virtual file system. ZIP archives support
simple encryption, sufficient to prevent casual inspection of their contents
but not able to prevent access by even a moderately determined attacker.
.TP
\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
.
This takes the name of a file, \fIfilename\fR, and produces where it would be
mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
within which mount the mapping will be done; if omitted, the main root of the
zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
which controls whether to fully canonicalise the name; it defaults to true.
.TP
\fBzipfs exists\fR \fIfilename\fR
.
Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
.TP
\fBzipfs find\fR \fIdir\fR
\fBzipfs find\fR \fIdirectoryName\fR
.
Recursively lists files including and below the directory \fIdir\fR.
The result list consists of relative path names starting from the
given directory. This command is also used by the \fBzipfs mkzip\fR
and \fBzipfs mkimg\fR commands.
Recursively lists files including and below the directory \fIdirectoryName\fR.
The result list consists of relative path names starting from the given
directory. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs
mkimg\fR commands.
.TP
\fBzipfs info\fR \fIfile\fR
.
Return information about the given file in the mounted zipfs. The information
consists of (1) the name of the ZIP archive file that contains the file,
(2) the size of the file after decompressions, (3) the compressed size of
the file, and (4) the offset of the compressed data in the ZIP archive file.
Return information about the given \fIfile\fR in the mounted zipfs. The
information consists of:
.RS
.IP (1)
the name of the ZIP archive file that contains the file,
.IP (2)
the size of the file after decompressions,
.IP (3)
the compressed size of the file, and
.IP (4)
the offset of the compressed data in the ZIP archive file.
.PP
Note: querying the mount point gives the start of zip data offset in (4),
which can be used to truncate the zip info off an executable.
Note: querying the mount point gives the start of the zip data as the offset
in (4), which can be used to truncate the zip information from an executable.
.RE
.TP
\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
.
Return a list of all files in the mounted zipfs. The order of the names
in the list is arbitrary.
.TP
\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
.
Creates an image (potentially a new executable file) similar to
\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified,
this file is prepended in front of the ZIP archive, otherwise the file
returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of
the running process) is used. If the \fIpassword\fR parameter is not empty,
an obfuscated version of that password is placed between the image and ZIP
chunks of the output file and the contents of the ZIP chunk are protected
with that password.
.RS
.PP
Caution: highly experimental, not usable on Android, only partially tested
on Linux and Windows.
.RE
.TP
\fBzipfs mkkey\fR \fIpassword\fR
.
For the clear text \fIpassword\fR argument an obfuscated string version
is returned with the same format used in the \fBzipfs mkimg\fR command.
.TP
\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
password \fIpassword\fR. While processing the files below \fIindir\fR the
optional file name prefix given in \fIstrip\fR is stripped off the beginning
of the respective file name.
.RS
.PP
Caution: the choice of the \fIindir\fR parameter
(less the optional stripped prefix) determines the later root name of the
archive's content.
.RE
Return a list of all files in the mounted zipfs, or just those matching
\fIpattern\fR (optionally controlled by the option parameters). The order of
the names in the list is arbitrary.
.TP
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
.
The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS.
After this command executes, files contained in \fIzipfile\fR
will appear to Tcl to be regular files at the mount point.
The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
filesystem at \fImountpoint\fR. After this command executes, files contained
in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
.RS
.PP
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.
With no \fImountpoint\fR, return all zipfile/mount pairs.
If \fImountpoint\fR is specified as an empty string, mount on file path.
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR. With
no \fImountpoint\fR, return all zipfile/mount pairs. If \fImountpoint\fR is
specified as an empty string, mount on file path.
.PP
\fBNB:\fR because the current working directory is a concept maintained by the
operating system, using \fBcd\fR into a mounted archive will only work in the
current process, and then not entirely consistently (e.g., if a shared library
uses direct access to the OS rather than through Tcl's filesystem API, it will
not see the current directory as being inside the mount and will not be able
to access the files inside the mount).
.RE
.TP
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .
.RE
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
.TP
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
password \fIpassword\fR. While processing the files below \fIindir\fR the
optional file name prefix given in \fIstrip\fR is stripped off the beginning
of the respective file name. When stripping, it is common to remove either
the whole source directory name or the name of its parent directory.
.RS
.PP
\fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional
stripped prefix) determines the later root name of the archive's content.
.RE
.TP
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
.
Creates an image (potentially a new executable file) similar to \fBzipfs
mkzip\fR; see that command for a description of most parameters to this
command, as they behave identically here.
.RS
.PP
If the \fIinfile\fR parameter is specified, this file is prepended in front of
the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
(i.e., the executable file of the running process) is used. If the
\fIpassword\fR parameter is not empty, an obfuscated version of that password
(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
output file and the contents of the ZIP chunk are protected with that
password.
.PP
If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
archive and the image file that the archive is attached to is a \fBtclsh\fR
(or \fBwish\fR) instance (true by default, but depends on your configuration),
then the resulting image is an executable that will \fBsource\fR the script in
that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
that script has been executed.
.PP
\fBCaution:\fR highly experimental, not usable on Android, only partially
tested on Linux and Windows.
.RE
.TP
\fBzipfs mkkey\fR \fIpassword\fR
.
Given the clear text \fIpassword\fR argument, an obfuscated string version is
returned with the same format used in the \fBzipfs mkimg\fR command.
.TP
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
.
This command is like \fBzipfs mkimg\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive in the image, and the even elements are their
respective names within that archive.
.TP
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
.
This command is like \fBzipfs mkzip\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive, and the even elements are their respective
names within that archive.
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fbzipfs root\fR] myApp]
\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip
source [file join $base app.tcl]
# use the contents, load libraries from it, etc...
\fBzipfs unmount\fR $zip
.CE
.PP
Creating a ZIP archive, given that a directory exists containing the content
to put in the archive. Note that the source directory is given twice, in order
to strip the exterior directory name from each filename in the archive.
.PP
.CS
set sourceDirectory [file normalize myApp]
set targetZip myApp.zip
\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
.CE
.PP
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fbzipfs root\fR] myApp]
# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password
# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE
.PP
When creating an executable image with a password, the password is placed
within the executable in a shrouded form so that the application can read
files inside the embedded ZIP archive yet casual inspection cannot read it.
.PP
.CS
set appDir [file normalize myApp]
set img "myApp.bin"
set password "hunter2"
# Create some simple content to define a basic application
file mkdir $appDir
set f [open $appDir/main.tcl]
puts $f {
puts "Hi. This is [info script]"
}
close $f
# Create the executable
\fBzipfs mkimg\fR $img $appDir $appDir $password
# Launch the executable, printing its output to stdout
exec $img >@stdout
# prints: \fIHi. This is //zipfs:/app/main.tcl\fR
.CE
.SH "SEE ALSO"
tclsh(1), file(n), zlib(n)
tclsh(1), file(n), zipfs(3), zlib(n)
.SH "KEYWORDS"
compress, filesystem, zip
'\" Local Variables:
+5 -12
View File
@@ -2332,25 +2332,18 @@ declare 631 {
# TIP #430
declare 632 {
int TclZipfs_Mount(
Tcl_Interp *interp,
const char *mntpt,
const char *zipname,
const char *passwd)
int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
const char *zipname, const char *passwd)
}
declare 633 {
int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
}
declare 634 {
Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
int TclZipfs_Mount_Buffer(
Tcl_Interp *interp,
const char *mntpt,
unsigned char *data,
size_t datalen,
int copy)
int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
unsigned char *data, size_t datalen, int copy)
}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
+8 -1
View File
@@ -224,7 +224,7 @@ extern "C" {
* to be included in a shared library, then it should have the DLLEXPORT
* storage class. If is being declared for use by a module that is going to
* link against the shared library, then it should have the DLLIMPORT storage
* class. If the symbol is beind declared for a static build or for use from a
* class. If the symbol is being declared for a static build or for use from a
* stub library, then the storage class should be empty.
*
* The convention is that a macro called BUILD_xxxx, where xxxx is the name of
@@ -2333,6 +2333,13 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)
/*
* Constants for special int-typed values, see TIP #494
*/
#define TCL_IO_FAILURE (-1)
#define TCL_AUTO_LENGTH (-1)
/*
*----------------------------------------------------------------------------
* Single public declaration for NRE.
+161 -27
View File
@@ -105,6 +105,7 @@ TCL_DECLARE_MUTEX(commandTypeLock);
* Static functions in this file:
*/
static Tcl_ObjCmdProc BadEnsembleSubcommand;
static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
const char *oldName, const char *newName,
int flags);
@@ -125,7 +126,6 @@ static Tcl_ObjCmdProc ExprBinaryFunc;
static Tcl_ObjCmdProc ExprBoolFunc;
static Tcl_ObjCmdProc ExprCeilFunc;
static Tcl_ObjCmdProc ExprDoubleFunc;
static Tcl_ObjCmdProc ExprEntierFunc;
static Tcl_ObjCmdProc ExprFloorFunc;
static Tcl_ObjCmdProc ExprIntFunc;
static Tcl_ObjCmdProc ExprIsqrtFunc;
@@ -206,6 +206,24 @@ typedef struct {
* expansion for itself rather than needing the generic layer to take care of
* it for it. Defined in tclInt.h. */
/*
* The following struct states that the command it talks about (a subcommand
* of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
* interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
* structs.) Alas, we can't sensibly just store the information directly in
* the commands.
*/
typedef struct {
const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
* the end of the list of commands to hide. */
const char *commandName; /* The name of the command within the
* ensemble. If this is NULL, we want to also
* make the overall command be hidden, an ugly
* hack because it is expected by security
* policies in the wild. */
} UnsafeEnsembleInfo;
/*
* The built-in commands, and the functions that implement them:
*/
@@ -242,6 +260,7 @@ static const CmdInfo builtInCmds[] = {
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
{"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
@@ -306,6 +325,68 @@ static const CmdInfo builtInCmds[] = {
{NULL, NULL, NULL, NULL, 0}
};
/*
* Information about which pieces of ensembles to hide when making an
* interpreter safe:
*/
static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
/* [encoding] has two unsafe commands. Assumed by older security policies
* to be overall unsafe; it isn't but... */
{"encoding", NULL},
{"encoding", "dirs"},
{"encoding", "system"},
/* [file] has MANY unsafe commands! Assumed by older security policies to
* be overall unsafe; it isn't but... */
{"file", NULL},
{"file", "atime"},
{"file", "attributes"},
{"file", "copy"},
{"file", "delete"},
{"file", "dirname"},
{"file", "executable"},
{"file", "exists"},
{"file", "extension"},
{"file", "isdirectory"},
{"file", "isfile"},
{"file", "link"},
{"file", "lstat"},
{"file", "mtime"},
{"file", "mkdir"},
{"file", "nativename"},
{"file", "normalize"},
{"file", "owned"},
{"file", "readable"},
{"file", "readlink"},
{"file", "rename"},
{"file", "rootname"},
{"file", "size"},
{"file", "stat"},
{"file", "tail"},
{"file", "tempfile"},
{"file", "type"},
{"file", "volumes"},
{"file", "writable"},
/* [info] has two unsafe commands */
{"info", "cmdtype"},
{"info", "nameofexecutable"},
/* [tcl::process] has ONLY unsafe commands! */
{"process", "list"},
{"process", "status"},
{"process", "purge"},
{"process", "autopurge"},
/* [zipfs] has MANY unsafe commands! */
{"zipfs", "lmkimg"},
{"zipfs", "lmkzip"},
{"zipfs", "mkimg"},
{"zipfs", "mkkey"},
{"zipfs", "mkzip"},
{"zipfs", "mount"},
{"zipfs", "mount_data"},
{"zipfs", "unmount"},
{NULL, NULL}
};
/*
* Math functions. All are safe.
*/
@@ -327,7 +408,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "cos", ExprUnaryFunc, (ClientData) cos },
{ "cosh", ExprUnaryFunc, (ClientData) cosh },
{ "double", ExprDoubleFunc, NULL },
{ "entier", ExprEntierFunc, NULL },
{ "entier", ExprIntFunc, NULL },
{ "exp", ExprUnaryFunc, (ClientData) exp },
{ "floor", ExprFloorFunc, NULL },
{ "fmod", ExprBinaryFunc, (ClientData) fmod },
@@ -1135,6 +1216,7 @@ TclHideUnsafeCommands(
Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
register const UnsafeEnsembleInfo *unsafePtr;
if (interp == NULL) {
return TCL_ERROR;
@@ -1144,11 +1226,82 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
TclMakeEncodingCommandSafe(interp); /* Ugh! */
TclMakeFileCommandSafe(interp); /* Ugh! */
for (unsafePtr = unsafeEnsembleCommands;
unsafePtr->ensembleNsName; unsafePtr++) {
if (unsafePtr->commandName) {
/*
* Hide an ensemble subcommand.
*/
Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
unsafePtr->ensembleNsName, unsafePtr->commandName);
Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
unsafePtr->ensembleNsName, unsafePtr->commandName);
if (TclRenameCommand(interp, TclGetString(cmdName),
"___tmp") != TCL_OK
|| Tcl_HideCommand(interp, "___tmp",
TclGetString(hideName)) != TCL_OK) {
Tcl_Panic("problem making '%s %s' safe: %s",
unsafePtr->ensembleNsName, unsafePtr->commandName,
Tcl_GetString(Tcl_GetObjResult(interp)));
}
Tcl_CreateObjCommand(interp, TclGetString(cmdName),
BadEnsembleSubcommand, (ClientData) unsafePtr, NULL);
TclDecrRefCount(cmdName);
TclDecrRefCount(hideName);
} else {
/*
* Hide an ensemble main command (for compatibility).
*/
if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
unsafePtr->ensembleNsName) != TCL_OK) {
Tcl_Panic("problem making '%s' safe: %s",
unsafePtr->ensembleNsName,
Tcl_GetString(Tcl_GetObjResult(interp)));
}
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* BadEnsembleSubcommand --
*
* Command used to act as a backstop implementation when subcommands of
* ensembles are unsafe (the real implementations of the subcommands are
* hidden). The clientData is description of what was hidden.
*
* Results:
* A standard Tcl result (always a TCL_ERROR).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
BadEnsembleSubcommand(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
const UnsafeEnsembleInfo *infoPtr = clientData;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"not allowed to invoke subcommand %s of %s",
infoPtr->commandName, infoPtr->ensembleNsName));
Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
@@ -6620,7 +6773,7 @@ Tcl_ExprLongObj(
resultPtr = Tcl_NewBignumObj(&big);
/* FALLTHROUGH */
}
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
case TCL_NUMBER_BIG:
result = TclGetLongFromObj(interp, resultPtr, ptr);
break;
@@ -7596,7 +7749,7 @@ ExprAbsFunc(
return TCL_ERROR;
}
if (type == TCL_NUMBER_WIDE) {
if (type == TCL_NUMBER_INT) {
Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
if (l > (Tcl_WideInt)0) {
@@ -7717,7 +7870,7 @@ ExprDoubleFunc(
}
static int
ExprEntierFunc(
ExprIntFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
@@ -7772,25 +7925,6 @@ ExprEntierFunc(
return TCL_ERROR;
}
static int
ExprIntFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
Tcl_WideInt wResult;
Tcl_Obj *objPtr;
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
objPtr = Tcl_GetObjResult(interp);
TclGetWideBitsFromObj(NULL, objPtr, &wResult);
Tcl_SetObjResult(interp, Tcl_NewLongObj((long)wResult));
return TCL_OK;
}
static int
ExprWideFunc(
ClientData clientData, /* Ignored. */
@@ -7801,7 +7935,7 @@ ExprWideFunc(
{
Tcl_WideInt wResult;
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
+8 -8
View File
@@ -2483,8 +2483,8 @@ BinaryDecodeHex(
}
c = *data++;
if (!isxdigit((int) c)) {
if (strict || !isspace(c)) {
if (!isxdigit(UCHAR(c))) {
if (strict || !TclIsSpaceProc(c)) {
goto badChar;
}
i--;
@@ -2831,7 +2831,7 @@ BinaryDecodeUu(
if (lineLen < 0) {
c = *data++;
if (c < 32 || c > 96) {
if (strict || !isspace(c)) {
if (strict || !TclIsSpaceProc(c)) {
goto badUu;
}
i--;
@@ -2849,7 +2849,7 @@ BinaryDecodeUu(
d[i] = c = *data++;
if (c < 32 || c > 96) {
if (strict) {
if (!isspace(c)) {
if (!TclIsSpaceProc(c)) {
goto badUu;
} else if (c == '\n') {
goto shortUu;
@@ -2893,7 +2893,7 @@ BinaryDecodeUu(
} else if (c >= 32 && c <= 96) {
data--;
break;
} else if (strict || !isspace(c)) {
} else if (strict || !TclIsSpaceProc(c)) {
goto badUu;
}
} while (data < dataend);
@@ -3018,7 +3018,7 @@ BinaryDecode64(
if (c == '=' && i > 1) {
value <<= 6;
cut++;
} else if (!strict && isspace(c)) {
} else if (!strict && TclIsSpaceProc(c)) {
i--;
} else {
goto bad64;
@@ -3036,7 +3036,7 @@ BinaryDecode64(
} else if (c == '=') {
value <<= 6;
cut++;
} else if (strict || !isspace(c)) {
} else if (strict || !TclIsSpaceProc(c)) {
goto bad64;
} else {
i--;
@@ -3057,7 +3057,7 @@ BinaryDecode64(
goto bad64;
}
for (; data < dataend; data++) {
if (!isspace(*data)) {
if (!TclIsSpaceProc(*data)) {
goto bad64;
}
}
+30 -276
View File
@@ -46,9 +46,6 @@ struct ForeachState {
static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int mode);
static int BadEncodingSubcommand(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int EncodingConvertfromObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -84,7 +81,6 @@ static Tcl_NRPostProc ForPostNextCallback;
static Tcl_NRPostProc ForeachLoopStep;
static Tcl_NRPostProc EvalCmdErrMsg;
static Tcl_ObjCmdProc BadFileSubcommand;
static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
@@ -536,122 +532,15 @@ TclInitEncodingCmd(
static const EnsembleImplMap encodingImplMap[] = {
{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"convertto", EncodingConverttoObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}
/*
*-----------------------------------------------------------------------------
*
* TclMakeEncodingCommandSafe --
*
* This function hides the unsafe 'dirs' and 'system' subcommands of
* the "encoding" Tcl command ensemble. It must be called only from
* TclHideUnsafeCommands.
*
* Results:
* A standard Tcl result
*
* Side effects:
* Adds commands to the table of hidden commands.
*
*-----------------------------------------------------------------------------
*/
int
TclMakeEncodingCommandSafe(
Tcl_Interp* interp) /* Tcl interpreter */
{
static const struct {
const char *cmdName;
int unsafe;
} unsafeInfo[] = {
{"convertfrom", 0},
{"convertto", 0},
{"dirs", 1},
{"names", 0},
{"system", 0},
{NULL, 0}
};
int i;
Tcl_DString oldBuf, newBuf;
Tcl_DStringInit(&oldBuf);
TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
Tcl_DStringInit(&newBuf);
TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
if (unsafeInfo[i].unsafe) {
const char *oldName, *newName;
Tcl_DStringSetLength(&oldBuf, 17);
oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
Tcl_DStringSetLength(&newBuf, 13);
newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
|| Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
Tcl_Panic("problem making 'encoding %s' safe: %s",
unsafeInfo[i].cmdName,
Tcl_GetString(Tcl_GetObjResult(interp)));
}
Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
(ClientData) unsafeInfo[i].cmdName, NULL);
}
}
Tcl_DStringFree(&oldBuf);
Tcl_DStringFree(&newBuf);
/*
* Ugh. The [encoding] command is now actually safe, but it is assumed by
* scripts that it is not, which messes up security policies.
*/
if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
Tcl_Panic("problem making 'encoding' safe: %s",
Tcl_GetString(Tcl_GetObjResult(interp)));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* BadEncodingSubcommand --
*
* Command used to act as a backstop implementation when subcommands of
* "encoding" are unsafe (the real implementations of the subcommands are
* hidden). The clientData is always the full official subcommand name.
*
* Results:
* A standard Tcl result (always a TCL_ERROR).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
BadEncodingSubcommand(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
const char *subcommandName = (const char *) clientData;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"not allowed to invoke subcommand %s of encoding", subcommandName));
Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
@@ -1174,180 +1063,45 @@ TclInitFileCmd(
*/
static const EnsembleImplMap initMap[] = {
{"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
{"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
{"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 1},
{"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
{"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"copy", TclFileCopyCmd, NULL, NULL, NULL, 1},
{"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
{"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
{"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
{"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
{"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1},
{"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
{"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
{"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
{"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"rename", TclFileRenameCmd, NULL, NULL, NULL, 1},
{"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1},
{"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
{"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
{"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
{"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "file", initMap);
}
/*
*----------------------------------------------------------------------
*
* TclMakeFileCommandSafe --
*
* This function hides the unsafe subcommands of the "file" Tcl command
* ensemble. It must only be called from TclHideUnsafeCommands.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Adds commands to the table of hidden commands.
*
*----------------------------------------------------------------------
*/
int
TclMakeFileCommandSafe(
Tcl_Interp *interp)
{
static const struct {
const char *cmdName;
int unsafe;
} unsafeInfo[] = {
{"atime", 1},
{"attributes", 1},
{"channels", 0},
{"copy", 1},
{"delete", 1},
{"dirname", 1},
{"executable", 1},
{"exists", 1},
{"extension", 1},
{"isdirectory", 1},
{"isfile", 1},
{"join", 0},
{"link", 1},
{"lstat", 1},
{"mtime", 1},
{"mkdir", 1},
{"nativename", 1},
{"normalize", 1},
{"owned", 1},
{"pathtype", 0},
{"readable", 1},
{"readlink", 1},
{"rename", 1},
{"rootname", 1},
{"separator", 0},
{"size", 1},
{"split", 0},
{"stat", 1},
{"system", 0},
{"tail", 1},
{"tempfile", 1},
{"type", 1},
{"volumes", 1},
{"writable", 1},
{NULL, 0}
};
int i;
Tcl_DString oldBuf, newBuf;
Tcl_DStringInit(&oldBuf);
TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
Tcl_DStringInit(&newBuf);
TclDStringAppendLiteral(&newBuf, "tcl:file:");
for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
if (unsafeInfo[i].unsafe) {
const char *oldName, *newName;
Tcl_DStringSetLength(&oldBuf, 13);
oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
Tcl_DStringSetLength(&newBuf, 9);
newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
|| Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
Tcl_Panic("problem making 'file %s' safe: %s",
unsafeInfo[i].cmdName,
Tcl_GetString(Tcl_GetObjResult(interp)));
}
Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
(ClientData) unsafeInfo[i].cmdName, NULL);
}
}
Tcl_DStringFree(&oldBuf);
Tcl_DStringFree(&newBuf);
/*
* Ugh. The [file] command is now actually safe, but it is assumed by
* scripts that it is not, which messes up security policies. [Bug
* 3211758]
*/
if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
Tcl_Panic("problem making 'file' safe: %s",
Tcl_GetString(Tcl_GetObjResult(interp)));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* BadFileSubcommand --
*
* Command used to act as a backstop implementation when subcommands of
* "file" are unsafe (the real implementations of the subcommands are
* hidden). The clientData is always the full official subcommand name.
*
* Results:
* A standard Tcl result (always a TCL_ERROR).
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
BadFileSubcommand(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
const char *subcommandName = (const char *) clientData;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"not allowed to invoke subcommand %s of file", subcommandName));
Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
+91 -1
View File
@@ -173,7 +173,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
{"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
@@ -2568,6 +2568,96 @@ Tcl_LlengthObjCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LpopObjCmd --
*
* This procedure is invoked to process the "lpop" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_LpopObjCmd(
ClientData notUsed, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
register Tcl_Obj *const objv[])
/* Argument objects. */
{
int listLen, result;
Tcl_Obj *elemPtr;
Tcl_Obj *listPtr, **elemPtrs;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
return TCL_ERROR;
}
listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
/*
* First, extract the element to be returned.
* TclLindexFlat adds a ref count which is handled.
*/
if (objc == 2) {
elemPtr = elemPtrs[listLen - 1];
Tcl_IncrRefCount(elemPtr);
} else {
elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);
if (elemPtr == NULL) {
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, elemPtr);
Tcl_DecrRefCount(elemPtr);
/*
* Second, remove the element.
*/
if (objc == 2) {
if (Tcl_IsShared(listPtr)) {
listPtr = TclListObjCopy(NULL, listPtr);
}
result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
if (result != TCL_OK) {
return result;
}
} else {
listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
if (listPtr == NULL) {
return TCL_ERROR;
}
}
listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+3 -8
View File
@@ -258,7 +258,7 @@ Tcl_RegexpObjCmd(
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
@@ -582,7 +582,7 @@ Tcl_RegsubObjCmd(
if (startIndex) {
int stringLength = Tcl_GetCharLength(objv[1]);
TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
@@ -1623,10 +1623,6 @@ StringIsCmd(
chcomp = Tcl_UniCharIsGraph;
break;
case STR_IS_INT:
if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
break;
}
goto failedIntParse;
case STR_IS_ENTIER:
if ((objPtr->typePtr == &tclIntType) ||
(objPtr->typePtr == &tclBignumType)) {
@@ -1674,7 +1670,6 @@ StringIsCmd(
break;
}
failedIntParse:
string1 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
@@ -1849,7 +1844,7 @@ static int
UniCharIsHexDigit(
int character)
{
return (character >= 0) && (character < 0x80) && isxdigit(character);
return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}
/*
+2 -5
View File
@@ -691,14 +691,11 @@ TclCompileStringIsCmd(
}
switch (t) {
case STR_IS_INT:
PUSH( "1");
OP( EQ);
break;
case STR_IS_WIDE:
PUSH( "2");
OP( LE);
break;
case STR_IS_INT:
case STR_IS_ENTIER:
PUSH( "3");
OP( LE);
@@ -1353,7 +1350,7 @@ static int
UniCharIsHexDigit(
int character)
{
return (character >= 0) && (character < 0x80) && isxdigit(character);
return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}
StringClassDesc const tclStringClassTable[] = {
+1 -1
View File
@@ -1759,7 +1759,7 @@ ConvertTreeToTokens(
/*
* All the Tcl_Tokens allocated and filled belong to
* this subexpresion. The first token is the leading
* this subexpression. The first token is the leading
* TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
* are its components.
*/
+1 -1
View File
@@ -1473,7 +1473,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)))
+953 -953
View File
File diff suppressed because it is too large Load Diff
+11 -10
View File
@@ -1863,16 +1863,17 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp,
Tcl_TcpAcceptProc *acceptProc,
ClientData callbackData);
/* 632 */
EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt,
const char *zipname, const char *passwd);
EXTERN int TclZipfs_Mount(Tcl_Interp *interp,
const char *mountPoint, const char *zipname,
const char *passwd);
/* 633 */
EXTERN int TclZipfs_Unmount(Tcl_Interp *interp,
const char *zipname);
const char *mountPoint);
/* 634 */
EXTERN Tcl_Obj * TclZipfs_TclLibrary(void);
/* 635 */
EXTERN int TclZipfs_Mount_Buffer(Tcl_Interp *interp,
const char *mntpt, unsigned char *data,
EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp,
const char *mountPoint, unsigned char *data,
size_t datalen, int copy);
typedef struct {
@@ -2541,10 +2542,10 @@ typedef struct TclStubs {
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); /* 632 */
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */
int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
int (*tclZipfs_Mount_Buffer) (Tcl_Interp *interp, const char *mntpt, unsigned char *data, size_t datalen, int copy); /* 635 */
int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3845,8 +3846,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_Mount_Buffer \
(tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */
#define TclZipfs_MountBuffer \
(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
#endif /* defined(USE_TCL_STUBS) */
+1 -1
View File
@@ -1610,7 +1610,7 @@ Tcl_DisassembleObjCmd(
"BYTECODE", NULL);
return TCL_ERROR;
}
if (PTR2INT(clientData)) {
if (clientData) {
Tcl_SetObjResult(interp,
DisassembleByteCodeAsDicts(interp, codeObjPtr));
} else {
+1 -1
View File
@@ -2058,7 +2058,7 @@ LoadEscapeEncoding(
dataPtr->numSubTables =
Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
(size_t) Tcl_DStringLength(&escapeData));
Tcl_DStringLength(&escapeData));
Tcl_DStringFree(&escapeData);
memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
+37 -46
View File
@@ -500,7 +500,7 @@ VarHashCreateVar(
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_WIDE, \
? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclDoubleType) \
@@ -3620,7 +3620,7 @@ TEBCresume(
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
if (type == TCL_NUMBER_WIDE) {
if (type == TCL_NUMBER_INT) {
Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
Tcl_WideInt sum = augend + increment;
@@ -3662,7 +3662,7 @@ TEBCresume(
TclSetIntObj(objPtr, w+increment);
}
goto doneIncr;
} /* end if (type == TCL_NUMBER_WIDE) */
} /* end if (type == TCL_NUMBER_INT) */
}
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared */
@@ -4761,7 +4761,7 @@ TEBCresume(
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
&& (value2Ptr->typePtr != &tclListType)
&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
&index) == TCL_OK)) {
TclDecrRefCount(value2Ptr);
tosPtr--;
@@ -5631,22 +5631,13 @@ TEBCresume(
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
} else if (type1 == TCL_NUMBER_WIDE) {
/* value is between WIDE_MIN and WIDE_MAX */
/* [string is integer] is -UINT_MAX to UINT_MAX range */
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
int i;
if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
type1 = TCL_NUMBER_LONG;
}
} else if (type1 == TCL_NUMBER_BIG) {
/* value is an integer outside the WIDE_MIN to WIDE_MAX range */
/* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
/* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
Tcl_WideInt w;
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
type1 = TCL_NUMBER_WIDE;
type1 = TCL_NUMBER_INT;
}
}
TclNewIntObj(objResultPtr, type1);
@@ -5692,7 +5683,7 @@ TEBCresume(
compare = MP_EQ;
goto convertComparison;
}
if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
@@ -5771,7 +5762,7 @@ TEBCresume(
* Check for common, simple case.
*/
if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
@@ -6011,7 +6002,7 @@ TEBCresume(
* an external function.
*/
if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
w1 = *((const Tcl_WideInt *)ptr1);
w2 = *((const Tcl_WideInt *)ptr2);
@@ -6154,7 +6145,7 @@ TEBCresume(
CACHE_STACK_INFO();
goto gotError;
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *) ptr1);
if (Tcl_IsShared(valuePtr)) {
TclNewIntObj(objResultPtr, ~w1);
@@ -6191,7 +6182,7 @@ TEBCresume(
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w1 = *((const Tcl_WideInt *) ptr1);
if (w1 != WIDE_MIN) {
if (Tcl_IsShared(valuePtr)) {
@@ -7870,7 +7861,7 @@ ExecuteExtendedBinaryMathOp(
/* TODO: Attempts to re-use unshared operands on stack */
w2 = 0; /* silence gcc warning */
if (type2 == TCL_NUMBER_WIDE) {
if (type2 == TCL_NUMBER_INT) {
w2 = *((const Tcl_WideInt *)ptr2);
if (w2 == 0) {
return DIVIDED_BY_ZERO;
@@ -7883,7 +7874,7 @@ ExecuteExtendedBinaryMathOp(
return constants[0];
}
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *)ptr1);
if (w1 == 0) {
@@ -7961,7 +7952,7 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type2) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
break;
case TCL_NUMBER_BIG:
@@ -7983,7 +7974,7 @@ ExecuteExtendedBinaryMathOp(
* Zero shifted any number of bits is still zero.
*/
if ((type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
return constants[0];
}
@@ -7996,7 +7987,7 @@ ExecuteExtendedBinaryMathOp(
* counterparts, leading to incorrect results.
*/
if ((type2 != TCL_NUMBER_WIDE)
if ((type2 != TCL_NUMBER_INT)
|| (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1)) in
@@ -8029,7 +8020,7 @@ ExecuteExtendedBinaryMathOp(
* Quickly force large right shifts to 0 or -1.
*/
if ((type2 != TCL_NUMBER_WIDE)
if ((type2 != TCL_NUMBER_INT)
|| (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
/*
* Again, technically, the value to be shifted could be an
@@ -8040,7 +8031,7 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type1) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
case TCL_NUMBER_BIG:
@@ -8063,7 +8054,7 @@ ExecuteExtendedBinaryMathOp(
* Handle shifts within the native wide range.
*/
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
w1 = *(const Tcl_WideInt *)ptr1;
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w1 >= (Tcl_WideInt)0) {
@@ -8240,7 +8231,7 @@ ExecuteExtendedBinaryMathOp(
BIG_RESULT(&bigResult);
}
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
@@ -8294,7 +8285,7 @@ ExecuteExtendedBinaryMathOp(
goto doubleResult;
}
w2 = 0;
if (type2 == TCL_NUMBER_WIDE) {
if (type2 == TCL_NUMBER_INT) {
w2 = *((const Tcl_WideInt *) ptr2);
if (w2 == 0) {
/*
@@ -8312,7 +8303,7 @@ ExecuteExtendedBinaryMathOp(
}
switch (type2) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
negativeExponent = (w2 < 0);
oddExponent = (int) (w2 & (Tcl_WideInt)1);
@@ -8326,11 +8317,11 @@ ExecuteExtendedBinaryMathOp(
break;
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *)ptr1);
}
if (negativeExponent) {
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
switch (w1) {
case 0:
/*
@@ -8360,7 +8351,7 @@ ExecuteExtendedBinaryMathOp(
return constants[0];
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
switch (w1) {
case 0:
/*
@@ -8387,17 +8378,17 @@ ExecuteExtendedBinaryMathOp(
* which means the max exponent value is 2**28-1 = 0x0fffffff =
* 268435455, which fits into a signed 32 bit int which is within the
* range of the long int type. This means any numeric Tcl_Obj value
* not using TCL_NUMBER_WIDE type must hold a value larger than we
* not using TCL_NUMBER_INT type must hold a value larger than we
* accept.
*/
if (type2 != TCL_NUMBER_WIDE) {
if (type2 != TCL_NUMBER_INT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
if (w1 == 2) {
/*
* Reduce small powers of 2 to shifts.
@@ -8421,7 +8412,7 @@ ExecuteExtendedBinaryMathOp(
goto overflowExpon;
}
}
if (type1 == TCL_NUMBER_WIDE) {
if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *) ptr1);
} else {
goto overflowExpon;
@@ -8621,7 +8612,7 @@ ExecuteExtendedBinaryMathOp(
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Check for overflow.
@@ -8635,7 +8626,7 @@ ExecuteExtendedBinaryMathOp(
case INST_SUB:
wResult = w1 - w2;
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Must check for overflow. The macro tests for overflows
@@ -8758,7 +8749,7 @@ ExecuteExtendedUnaryMathOp(
switch (opcode) {
case INST_BITNOT:
if (type == TCL_NUMBER_WIDE) {
if (type == TCL_NUMBER_INT) {
w = *((const Tcl_WideInt *) ptr);
WIDE_RESULT(~w);
}
@@ -8771,7 +8762,7 @@ ExecuteExtendedUnaryMathOp(
switch (type) {
case TCL_NUMBER_DOUBLE:
DOUBLE_RESULT(-(*((const double *) ptr)));
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w = *((const Tcl_WideInt *) ptr);
if (w != WIDE_MIN) {
WIDE_RESULT(-w);
@@ -8825,10 +8816,10 @@ TclCompareTwoNumbers(
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
switch (type1) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w1 = *((const Tcl_WideInt *)ptr1);
switch (type2) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
wideCompare:
return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
@@ -8885,7 +8876,7 @@ TclCompareTwoNumbers(
d2 = *((const double *)ptr2);
doubleCompare:
return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
@@ -8927,7 +8918,7 @@ TclCompareTwoNumbers(
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
case TCL_NUMBER_WIDE:
case TCL_NUMBER_INT:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
+1 -1
View File
@@ -897,7 +897,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
while (isspace(UCHAR(*yyInput))) {
while (TclIsSpaceProc(UCHAR(*yyInput))) {
yyInput++;
}
+1 -1
View File
@@ -991,7 +991,7 @@ Tcl_ExecObjCmd(
resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area
+4 -4
View File
@@ -1807,7 +1807,7 @@ Tcl_FSEvalFileEx(
* be handled especially.
*/
if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1822,7 +1822,7 @@ Tcl_FSEvalFileEx(
*/
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1942,7 +1942,7 @@ TclNREvalFile(
* be handled especially.
*/
if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1958,7 +1958,7 @@ TclNREvalFile(
*/
if (Tcl_ReadChars(chan, objPtr, -1,
memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
+16 -12
View File
@@ -120,19 +120,19 @@ typedef int ptrdiff_t;
#if !defined(INT2PTR) && !defined(PTR2INT)
# if defined(HAVE_INTPTR_T) || defined(intptr_t)
# define INT2PTR(p) ((void *)(intptr_t)(p))
# define PTR2INT(p) ((int)(intptr_t)(p))
# define PTR2INT(p) ((intptr_t)(p))
# else
# define INT2PTR(p) ((void *)(p))
# define PTR2INT(p) ((int)(p))
# define PTR2INT(p) ((long)(p))
# endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
# define UINT2PTR(p) ((void *)(uintptr_t)(p))
# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
# define PTR2UINT(p) ((uintptr_t)(p))
# else
# define UINT2PTR(p) ((void *)(p))
# define PTR2UINT(p) ((unsigned int)(p))
# define PTR2UINT(p) ((unsigned long)(p))
# endif
#endif
@@ -2497,16 +2497,16 @@ typedef struct List {
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
@@ -2709,8 +2709,11 @@ typedef struct ProcessGlobalValue {
*----------------------------------------------------------------------
*/
#define TCL_NUMBER_LONG 1
#define TCL_NUMBER_WIDE 2
#define TCL_NUMBER_INT 2
#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */
# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */
#endif
#define TCL_NUMBER_BIG 3
#define TCL_NUMBER_DOUBLE 4
#define TCL_NUMBER_NAN 5
@@ -3360,7 +3363,6 @@ MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3389,7 +3391,6 @@ MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3451,6 +3452,9 @@ MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+1 -1
View File
@@ -397,7 +397,6 @@ Tcl_Init(
" set scripts {{set tcl_library}}\n"
" } else {\n"
" set scripts {}\n"
" lappend scripts {zipfs tcl_library}\n"
" if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
" lappend scripts {set env(TCL_LIBRARY)}\n"
" lappend scripts {\n"
@@ -410,6 +409,7 @@ Tcl_Init(
" } else {\n"
" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
" }\n"
" lappend scripts {::tcl::zipfs::tcl_library_init}\n"
" lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
+15 -6
View File
@@ -1356,6 +1356,7 @@ TclLindexFlat(
*
* Core of the 'lset' command when objc == 4. Objv[2] may be either a
* scalar index or a list of indices.
* It also handles 'lpop' when given a NULL value.
*
* Results:
* Returns the new value of the list variable, or NULL if there was an
@@ -1380,7 +1381,7 @@ TclLsetList(
Tcl_Interp *interp, /* Tcl interpreter. */
Tcl_Obj *listPtr, /* Pointer to the list being modified. */
Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */
Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int indexCount = 0; /* Number of indices in the index list. */
Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */
@@ -1431,6 +1432,7 @@ TclLsetList(
* TclLsetFlat --
*
* Core engine of the 'lset' command.
* It also handles 'lpop' when given a NULL value.
*
* Results:
* Returns the new value of the list variable, or NULL if an error
@@ -1475,7 +1477,7 @@ TclLsetFlat(
int indexCount, /* Number of index args. */
Tcl_Obj *const indexArray[],
/* Index args. */
Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
@@ -1483,10 +1485,13 @@ TclLsetFlat(
/*
* If there are no indices, simply return the new value. (Without
* indices, [lset] is a synonym for [set].
* [lpop] does not use this but protect for NULL valuePtr just in case.
*/
if (indexCount == 0) {
Tcl_IncrRefCount(valuePtr);
if (valuePtr != NULL) {
Tcl_IncrRefCount(valuePtr);
}
return valuePtr;
}
@@ -1546,12 +1551,14 @@ TclLsetFlat(
}
indexArray++;
if (index < 0 || index > elemCount) {
if (index < 0 || index > elemCount
|| (valuePtr == NULL && index >= elemCount)) {
/* ...the index points outside the sublist. */
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
Tcl_SetErrorCode(interp, "TCL", "OPERATION",
valuePtr == NULL ? "LPOP" : "LSET",
"BADINDEX", NULL);
}
result = TCL_ERROR;
@@ -1661,7 +1668,9 @@ TclLsetFlat(
len = -1;
TclListObjLength(NULL, subListPtr, &len);
if (index == len) {
if (valuePtr == NULL) {
Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
} else if (index == len) {
Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
} else {
TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+63 -33
View File
@@ -59,7 +59,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,
@@ -84,8 +83,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 RemoveClass(Class **list, int num, int idx);
static inline void RemoveObject(Object **list, int num, int idx);
static inline void SquelchCachedName(Object *oPtr);
@@ -451,10 +448,10 @@ InitClassSystemRoots(
/* 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);
@@ -470,7 +467,7 @@ InitClassSystemRoots(
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);
@@ -839,15 +836,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. */
{
@@ -864,7 +861,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);
}
@@ -883,8 +881,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);
}
@@ -906,7 +906,8 @@ DeleteDescendants(
* 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);
@@ -922,7 +923,7 @@ DeleteDescendants(
/*
* ----------------------------------------------------------------------
*
* ReleaseClassContents --
* TclOOReleaseClassContents --
*
* Tear down the special class data structure, including deleting all
* dependent classes and objects.
@@ -930,8 +931,8 @@ DeleteDescendants(
* ----------------------------------------------------------------------
*/
static void
ReleaseClassContents(
void
TclOOReleaseClassContents(
Tcl_Interp *interp, /* The interpreter containing the class. */
Object *oPtr) /* The object representing the class. */
{
@@ -954,9 +955,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");
}
}
@@ -1059,6 +1057,7 @@ ReleaseClassContents(
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
}
oPtr->classPtr = NULL;
}
/*
@@ -1108,7 +1107,7 @@ ObjectNamespaceDeleted(
/* Let the dominoes fall */
if (oPtr->classPtr) {
DeleteDescendants(interp, oPtr);
TclOODeleteDescendants(interp, oPtr);
}
/*
@@ -1237,8 +1236,8 @@ ObjectNamespaceDeleted(
/*
* 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.
* 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
@@ -1253,7 +1252,7 @@ ObjectNamespaceDeleted(
}
if (oPtr->classPtr != NULL) {
ReleaseClassContents(interp, oPtr);
TclOOReleaseClassContents(interp, oPtr);
}
/*
@@ -1357,6 +1356,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;
}
/*
* ----------------------------------------------------------------------
*
@@ -1489,10 +1519,10 @@ 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.
*
* ----------------------------------------------------------------------
*/
@@ -1516,8 +1546,8 @@ InitClassPath(
}
}
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
@@ -1758,13 +1788,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
@@ -1704,7 +1704,6 @@ AddSimpleClassChainToCallContext(
if (flags & CONSTRUCTOR) {
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
filterDecl, flags);
} else if (flags & DESTRUCTOR) {
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
filterDecl, flags);
+32 -2
View File
@@ -46,7 +46,7 @@ struct DeclaredSlot {
getter, NULL, NULL}, \
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
setter, NULL, NULL}, \
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
resolver, NULL, NULL}}
/*
@@ -1375,6 +1375,8 @@ TclOODefineClassObjCmd(
{
Object *oPtr;
Class *clsPtr;
Foundation *fPtr = TclOOGetFoundation(interp);
int wasClass, willBeClass;
/*
* Parse the context to get the object to operate on.
@@ -1410,12 +1412,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);
@@ -1423,6 +1433,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 {
+11
View File
@@ -242,6 +242,10 @@ typedef struct Object {
/* Object/class has (or had) private methods,
* and so shouldn't be cached so
* aggressively. */
#define DONT_DELETE 0x40000 /* Inhibit deletion of this object. Used
* during fundamental object type mutation to
* make sure that the object actually survives
* to the end of the operation. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -526,6 +530,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,
@@ -540,6 +546,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,
@@ -567,7 +575,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,
+21 -14
View File
@@ -2516,7 +2516,7 @@ Tcl_GetIntFromObj(
if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
return TCL_ERROR;
}
if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
if (interp != NULL) {
const char *s =
"integer value too large to represent as non-long integer";
@@ -2796,7 +2796,7 @@ Tcl_GetLongFromObj(
#else
if (objPtr->typePtr == &tclIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
* We return any integer in the range LONG_MIN to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
* existing semantics for conversion of integers on input, but
* avoids inadvertent demotion of wide integers to 32-bit ones in
@@ -2805,7 +2805,7 @@ Tcl_GetLongFromObj(
Tcl_WideInt w = objPtr->internalRep.wideValue;
if (w >= -(Tcl_WideInt)(ULONG_MAX)
if (w >= (Tcl_WideInt)(LONG_MIN)
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
*longPtr = (long) w;
return TCL_OK;
@@ -2843,11 +2843,16 @@ Tcl_GetLongFromObj(
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
*longPtr = - (long) value;
if (value <= 1 + (unsigned long)LONG_MAX) {
*longPtr = - (long) value;
return TCL_OK;
}
} else {
*longPtr = (long) value;
if (value <= (unsigned long)ULONG_MAX) {
*longPtr = (long) value;
return TCL_OK;
}
}
return TCL_OK;
}
}
#ifndef TCL_WIDE_INT_IS_LONG
@@ -3082,11 +3087,16 @@ Tcl_GetWideIntFromObj(
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
*wideIntPtr = - (Tcl_WideInt) value;
if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
*wideIntPtr = - (Tcl_WideInt) value;
return TCL_OK;
}
} else {
*wideIntPtr = (Tcl_WideInt) value;
if (value <= (Tcl_WideUInt)WIDE_MAX) {
*wideIntPtr = (Tcl_WideInt) value;
return TCL_OK;
}
}
return TCL_OK;
}
}
if (interp != NULL) {
@@ -3158,10 +3168,7 @@ TclGetWideBitsFromObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
value = -value;
}
*wideIntPtr = (Tcl_WideInt) value;
*wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
mp_clear(&big);
return TCL_OK;
}
@@ -3629,7 +3636,7 @@ TclGetNumberFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*typePtr = TCL_NUMBER_WIDE;
*typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
+1 -2
View File
@@ -932,8 +932,7 @@ Tcl_ScanObjCmd(
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
sprintf(buf, "%" TCL_LL_MODIFIER "u",
(Tcl_WideUInt)wideValue);
sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
Tcl_SetStringObj(objPtr, buf, -1);
} else {
TclSetIntObj(objPtr, wideValue);
+18 -49
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"
@@ -225,31 +229,11 @@ Tcl_WinUtfToTChar(
int len,
Tcl_DString *dsPtr)
{
WCHAR *wp, *p;
int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
Tcl_DStringInit(dsPtr);
Tcl_DStringSetLength(dsPtr, 2*size+2);
p = 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 */
/* It turns out that MultiByteToWideChar() cannot handle the 'modified'
* UTF-8 as used by Tcl. Every sequence of 0xC0 followed by 0x80 will
* be translated to two 0xfffd characters. This results in a test-failure
* of the registry-6.20 test-case. The simplest solution is to search for
* those two 0xfffd characters and replace them by a \u0000 character. */
while (p < wp + size - 1) {
if (p[0] == 0xfffd && p[1] == 0xfffd) {
memmove(p+1, p+2, sizeof(WCHAR) * (p - wp + size - 2));
p[0] = '\0';
++p; --size;
}
++p;
if (!string) {
return NULL;
}
Tcl_DStringSetLength(dsPtr, 2*size);
wp[size] = 0;
return (char *) wp;
return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
}
char *
@@ -258,31 +242,16 @@ Tcl_WinTCharToUtf(
int len,
Tcl_DString *dsPtr)
{
char *p;
int size, i = 0;
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+8); /* Add some spare, in case of NULL-bytes */
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 */
while (i < size) {
if (!p[i]) {
/* Output contains '\0'-byte, but Tcl expect two-bytes: C0 80 */
memmove(p+i+2, p+i+1, size-i-1);
memcpy(p + i++, "\xC0\x80", 2);
Tcl_DStringSetLength(dsPtr, ++size + 1);
p = (char *)Tcl_DStringValue(dsPtr);
}
++i;
}
Tcl_DStringSetLength(dsPtr, size);
p[size] = 0;
return p;
return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
}
#if defined(TCL_WIDE_INT_IS_LONG)
@@ -295,7 +264,7 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
long longValue;
int result = Tcl_ExprLong(interp, expr, &longValue);
if (result == TCL_OK) {
if ((longValue >= -(long)(UINT_MAX))
if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -311,7 +280,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
long longValue;
int result = Tcl_ExprLongObj(interp, expr, &longValue);
if (result == TCL_OK) {
if ((longValue >= -(long)(UINT_MAX))
if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -1611,7 +1580,7 @@ const TclStubs tclStubs = {
TclZipfs_Mount, /* 632 */
TclZipfs_Unmount, /* 633 */
TclZipfs_TclLibrary, /* 634 */
TclZipfs_Mount_Buffer, /* 635 */
TclZipfs_MountBuffer, /* 635 */
};
/* !END!: Do not edit above this line. */
+2 -2
View File
@@ -2394,7 +2394,7 @@ ExitProcOdd(
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
sprintf(buf, "odd %d\n", PTR2INT(clientData));
sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
Tcl_Panic("ExitProcOdd: unable to write to stdout");
@@ -2408,7 +2408,7 @@ ExitProcEven(
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
sprintf(buf, "even %d\n", PTR2INT(clientData));
sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
Tcl_Panic("ExitProcEven: unable to write to stdout");
+20 -8
View File
@@ -225,7 +225,7 @@ Tcl_UniCharToUtfDString(
*/
oldLength = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * 4);
Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
string = Tcl_DStringValue(dsPtr) + oldLength;
p = string;
@@ -434,20 +434,32 @@ 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 - 4;
while (p < end) {
p += TclUtfToUniChar(p, &ch);
*w++ = ch;
}
end += 4;
while (p < end) {
if (Tcl_UtfCharComplete(p, end-p)) {
p += TclUtfToUniChar(p, &ch);
} else if ((unsigned)((UCHAR(*p)-0x80)) < (unsigned) 0x20) {
ch = (Tcl_UniChar) cp1252[UCHAR(*p++)-0x80];
} else {
ch = UCHAR(*p++);
}
*w++ = ch;
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
(oldLength + ((char *) w - (char *) wString)));
oldLength + ((char *) w - (char *) wString));
return wString;
}
@@ -771,8 +783,8 @@ Tcl_UniCharAtIndex(
*
* Returns a pointer to the specified character (not byte) position in
* the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as
* 2 positions, but then the pointer should never be placed between
* the two positions.
* 2 positions, but then the pointer should never be placed between
* the two positions.
*
* Results:
* As above.
+255 -92
View File
@@ -15,6 +15,7 @@
#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
#include "tommath.h"
#include <math.h>
/*
@@ -107,9 +108,11 @@ static Tcl_ThreadDataKey precisionKey;
static void ClearHash(Tcl_HashTable *tablePtr);
static void FreeProcessGlobalValue(ClientData clientData);
static void FreeThreadHash(ClientData clientData);
static int GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue,
int *indexPtr);
static int GetEndOffsetFromObj(Tcl_Obj *objPtr,
Tcl_WideInt endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_WideInt endValue, Tcl_WideInt *widePtr);
static int SetEndOffsetFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static int FindElement(Tcl_Interp *interp, const char *string,
@@ -3651,6 +3654,204 @@ TclFormatInt(
return numFormatted;
}
/*
*----------------------------------------------------------------------
*
* GetWideForIndex --
*
* This function produces a wide integer value corresponding to the
* list index held in *objPtr. The parsing supports all values
* recognized as any size of integer, and the syntaxes end[-+]$integer
* and $integer[-+]$integer. The argument endValue is used to give
* the meaning of the literal index value "end".
*
* Results:
* When parsing of *objPtr successfully recognizes an index value,
* TCL_OK is returned, and the wide integer value corresponding to
* the recognized index value is written to *widePtr. When parsing
* fails, TCL_ERROR is returned and error information is written to
* interp, if non-NULL.
*
* Side effects:
* The type of *objPtr may change.
*
*----------------------------------------------------------------------
*/
static int
GetWideForIndex(
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
Tcl_Obj *objPtr, /* Points to the value to be parsed */
Tcl_WideInt endValue, /* The value to be stored at *widePtr if
* objPtr holds "end".
* NOTE: this value may be negative. */
Tcl_WideInt *widePtr) /* Location filled in with a wide integer
* representing an index. */
{
ClientData cd;
const char *opPtr;
int numType, length, t1 = 0, t2 = 0;
int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
if (code == TCL_OK) {
if (numType == TCL_NUMBER_INT) {
/* objPtr holds an integer in the signed wide range */
*widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
return TCL_OK;
}
if (numType == TCL_NUMBER_BIG) {
/* objPtr holds an integer outside the signed wide range */
/* Truncate to the signed wide range. */
if (mp_isneg((mp_int *)cd)) {
*widePtr = LLONG_MIN;
} else {
*widePtr = LLONG_MAX;
}
return TCL_OK;
}
/* Must be a double -> not a valid index */
goto parseError;
}
/* objPtr does not hold a number, check the end+/- format... */
if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
return TCL_OK;
}
/* If we reach here, the string rep of objPtr exists. */
/*
* The valid index syntax does not include any value that is
* a list of more than one element. This is necessary so that
* lists of index values can be reliably distinguished from any
* single index value.
*/
/*
* Quick scan to see if multi-value list is even possible.
* This relies on TclGetString() returning a NUL-terminated string.
*/
if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
/* If it's possible, do the full list parse. */
&& (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
&& (length > 1)) {
goto parseError;
}
/* Passed the list screen, so parse for index arithmetic expression */
if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
TCL_PARSE_INTEGER_ONLY)) {
Tcl_WideInt w1=0, w2=0;
/* value starts with valid integer... */
if ((*opPtr == '-') || (*opPtr == '+')) {
/* ... value continues with [-+] ... */
/* Save first integer as wide if possible */
TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
if (t1 == TCL_NUMBER_INT) {
w1 = (*(Tcl_WideInt *)cd);
}
if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
-1, NULL, TCL_PARSE_INTEGER_ONLY)) {
/* ... value concludes with second valid integer */
/* Save second integer as wide if possible */
TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
if (t2 == TCL_NUMBER_INT) {
w2 = (*(Tcl_WideInt *)cd);
}
}
}
/* Clear invalid intreps left by TclParseNumber */
TclFreeIntRep(objPtr);
if (t1 && t2) {
/* We have both integer values */
if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
/* Both are wide, do wide-integer math */
if (*opPtr == '-') {
if ((w2 == LLONG_MIN) && (interp != NULL)) {
goto extreme;
}
w2 = -w2;
}
if ((w1 ^ w2) < 0) {
/* Different signs, sum cannot overflow */
*widePtr = w1 + w2;
} else if (w1 >= 0) {
if (w1 < LLONG_MAX - w2) {
*widePtr = w1 + w2;
} else {
*widePtr = LLONG_MAX;
}
} else {
if (w1 > LLONG_MIN - w2) {
*widePtr = w1 + w2;
} else {
*widePtr = LLONG_MIN;
}
}
} else if (interp == NULL) {
/*
* We use an interp to do bignum index calculations.
* If we don't get one, call all indices with bignums errors,
* and rely on callers to handle it.
*/
return TCL_ERROR;
} else {
/*
* At least one is big, do bignum math. Little reason to
* value performance here. Re-use code. Parse has verified
* objPtr is an expression. Compute it.
*/
Tcl_Obj *sum;
extreme:
Tcl_ExprObj(interp, objPtr, &sum);
TclGetNumberFromObj(NULL, sum, &cd, &numType);
if (numType == TCL_NUMBER_INT) {
/* sum holds an integer in the signed wide range */
*widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
} else {
/* sum holds an integer outside the signed wide range */
/* Truncate to the signed wide range. */
if (mp_isneg((mp_int *)cd)) {
*widePtr = LLONG_MIN;
} else {
*widePtr = LLONG_MAX;
}
}
Tcl_DecrRefCount(sum);
}
return TCL_OK;
}
}
/* Report a parse error. */
parseError:
if (interp != NULL) {
char * bytes = TclGetString(objPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be integer?[+-]integer? or"
" end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
TclCheckBadOctal(interp, bytes);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
@@ -3687,76 +3888,19 @@ TclGetIntForIndex(
int *indexPtr) /* Location filled in with an integer
* representing an index. */
{
size_t length;
char *opPtr;
const char *bytes;
Tcl_WideInt wide;
if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
return TCL_OK;
if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) {
return TCL_OK;
if (wide < INT_MIN) {
*indexPtr = INT_MIN;
} else if (wide > INT_MAX) {
*indexPtr = INT_MAX;
} else {
*indexPtr = (int) wide;
}
bytes = TclGetString(objPtr);
length = objPtr->length;
/*
* Leading whitespace is acceptable in an index.
*/
while (length && TclIsSpaceProc(*bytes)) {
bytes++;
length--;
}
if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
int code, first, second;
char savedOp = *opPtr;
if ((savedOp != '+') && (savedOp != '-')) {
goto parseError;
}
if (TclIsSpaceProc(opPtr[1])) {
goto parseError;
}
*opPtr = '\0';
code = Tcl_GetInt(interp, bytes, &first);
*opPtr = savedOp;
if (code == TCL_ERROR) {
goto parseError;
}
if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
goto parseError;
}
if (savedOp == '+') {
*indexPtr = first + second;
} else {
*indexPtr = first - second;
}
return TCL_OK;
}
/*
* Report a parse error.
*/
parseError:
if (interp != NULL) {
bytes = TclGetString(objPtr);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad index \"%s\": must be integer?[+-]integer? or"
" end?[+-]integer?", bytes));
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
TclCheckBadOctal(interp, bytes);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
return TCL_OK;
}
/*
@@ -3779,21 +3923,35 @@ TclGetIntForIndex(
static int
GetEndOffsetFromObj(
Tcl_Obj *objPtr, /* Pointer to the object to parse */
int endValue, /* The value to be stored at "indexPtr" if
Tcl_WideInt endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
int *indexPtr) /* Location filled in with an integer
Tcl_WideInt *widePtr) /* Location filled in with an integer
* representing an index. */
{
if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) {
return TCL_ERROR;
if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
Tcl_WideInt offset = objPtr->internalRep.wideValue;
if ((endValue ^ offset) < 0) {
/* Different signs, sum cannot overflow */
*widePtr = endValue + offset;
} else if (endValue >= 0) {
if (endValue < LLONG_MAX - offset) {
*widePtr = endValue + offset;
} else {
*widePtr = LLONG_MAX;
}
} else {
if (endValue > LLONG_MIN - offset) {
*widePtr = endValue + offset;
} else {
*widePtr = LLONG_MIN;
}
}
return TCL_OK;
}
/* TODO: Handle overflow cases sensibly */
*indexPtr = endValue + (int)objPtr->internalRep.wideValue;
return TCL_OK;
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
@@ -3961,43 +4119,48 @@ TclIndexEncode(
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
int idx;
ClientData cd;
Tcl_WideInt wide;
int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) {
/* We parsed a value in the range INT_MIN...INT_MAX */
if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
/* We parsed a value in the range LLONG_MIN...LLONG_MAX */
wide = (*(Tcl_WideInt *)cd);
integerEncode:
if (idx < TCL_INDEX_START) {
if (wide < TCL_INDEX_START) {
/* All negative absolute indices are "before the beginning" */
idx = before;
} else if (idx == INT_MAX) {
} else if (wide >= INT_MAX) {
/* This index value is always "after the end" */
idx = after;
}
} else {
idx = (int) wide;
}
/* usual case, the absolute index value encodes itself */
} else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
} else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
/*
* We parsed an end+offset index value.
* idx holds the offset value in the range INT_MIN...INT_MAX.
* wide holds the offset value in the range LLONG_MIN...LLONG_MAX.
*/
if (idx > 0) {
if (wide > 0) {
/*
* All end+postive or end-negative expressions
* always indicate "after the end".
*/
idx = after;
} else if (idx < INT_MIN - TCL_INDEX_END) {
} else if (wide < INT_MIN - TCL_INDEX_END) {
/* These indices always indicate "before the beginning */
idx = before;
} else {
/* Encoded end-positive (or end+negative) are offset */
idx += TCL_INDEX_END;
idx = (int)wide + TCL_INDEX_END;
}
/* TODO: Consider flag to suppress repeated end-offset parse. */
} else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) {
} else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
/*
* Only reach this case when the index value is a
* constant index arithmetic expression, and idx
* constant index arithmetic expression, and wide
* holds the result. Treat it the same as if it were
* parsed as an absolute integer value.
*/
@@ -4316,7 +4479,7 @@ TclGetProcessGlobalValue(
ckfree(pgvPtr->value);
pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
(size_t) Tcl_DStringLength(&newValue) + 1);
Tcl_DStringLength(&newValue) + 1);
Tcl_DStringFree(&newValue);
Tcl_FreeEncoding(pgvPtr->encoding);
pgvPtr->encoding = current;
+3301 -2815
View File
File diff suppressed because it is too large Load Diff
+6 -6
View File
@@ -117,7 +117,7 @@ typedef struct {
z_stream outStream; /* Structure used by zlib for compression of
* output. */
char *inBuffer, *outBuffer; /* Working buffers. */
int inAllocated, outAllocated;
size_t inAllocated, outAllocated;
/* Sizes of working buffers. */
GzipHeader inHeader; /* Header read from input stream, when
* decompressing a gzip stream. */
@@ -1515,7 +1515,7 @@ Tcl_ZlibStreamGet(
Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
if (itemLen-zshPtr->outPos >= count-dataPos) {
unsigned len = count - dataPos;
size_t len = count - dataPos;
memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
zshPtr->outPos += len;
@@ -1524,7 +1524,7 @@ Tcl_ZlibStreamGet(
zshPtr->outPos = 0;
}
} else {
unsigned len = itemLen - zshPtr->outPos;
size_t len = itemLen - zshPtr->outPos;
memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
dataPos += len;
@@ -2931,7 +2931,7 @@ ZlibTransformClose(
result = TCL_ERROR;
break;
}
if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {
if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) {
/* TODO: is this the right way to do errors on close?
* Note: when close is called from FinalizeIOSubsystem then
* interp may be NULL */
@@ -3130,7 +3130,7 @@ ZlibTransformOutput(
break;
}
if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) {
*errorCodePtr = Tcl_GetErrno();
return -1;
}
@@ -3186,7 +3186,7 @@ ZlibTransformFlush(
* Write the bytes we've received to the next layer.
*/
if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"problem flushing channel: %s",
Tcl_PosixError(interp)));
+7 -4
View File
@@ -81,7 +81,8 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
lappend dirs [file join $root app ${basename}_library]
lappend dirs [file join $root lib $mountpoint ${basename}_library]
lappend dirs [file join $root lib $mountpoint]
if {![zipfs exists [file join $root app ${basename}_library]] && ![zipfs exists $mountpoint]} {
if {![zipfs exists [file join $root app ${basename}_library]] \
&& ![zipfs exists $mountpoint]} {
set found 0
foreach pkgdat [info loaded] {
lassign $pkgdat dllfile dllpkg
@@ -91,7 +92,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
break
}
set found 1
zipfs mount $dllfile $mountpoint
zipfs mount $mountpoint $dllfile
break
}
if {!$found} {
@@ -100,12 +101,14 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
lappend paths [::${basename}::pkgconfig get libdir,runtime]
lappend paths [::${basename}::pkgconfig get bindir,runtime]
if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
set zipfile [string tolower "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
set zipfile [string tolower \
"lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
}
lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
foreach path $paths {
set archive [file join $path $zipfile]
if {![file exists $archive]} continue
zipfs mount $archive $mountpoint
zipfs mount $mountpoint $archive
if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
lappend dirs [file join $mountpoint ${basename}_library]
set found 1
+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]
}
+21 -26
View File
@@ -455,37 +455,35 @@ proc ::safe::InterpInit {
foreach {command alias} {
source AliasSource
load AliasLoad
encoding AliasEncoding
exit interpDelete
glob AliasGlob
} {
::interp alias $slave $command {} [namespace current]::$alias $slave
}
# UGLY POINT! These commands are safe (they're ensembles with unsafe
# subcommands), but is assumed to not be by existing policies so it is
# hidden by default. Hack it...
foreach command {encoding file} {
::interp alias $slave $command {} interp invokehidden $slave $command
}
# This alias lets the slave have access to a subset of the 'file'
# command functionality.
::interp expose $slave file
foreach subcommand {dirname extension rootname tail} {
::interp alias $slave ::tcl::file::$subcommand {} \
::safe::AliasFileSubcommand $slave $subcommand
}
foreach subcommand {
atime attributes copy delete executable exists isdirectory isfile
link lstat mtime mkdir nativename normalize owned readable readlink
rename size stat tempfile type volumes writable
} {
::interp alias $slave ::tcl::file::$subcommand {} \
::safe::BadSubcommand $slave file $subcommand
}
# Subcommand of 'encoding' that has special handling; [encoding system] is
# OK provided it has no other arguments passed to it.
::interp alias $slave ::tcl::encoding::system {} \
::safe::AliasEncodingSystem $slave
# Subcommands of info
foreach {subcommand alias} {
nameofexecutable AliasExeName
} {
::interp alias $slave ::tcl::info::$subcommand \
{} [namespace current]::$alias $slave
}
::interp alias $slave ::tcl::info::nameofexecutable {} \
::safe::AliasExeName $slave
# The allowed slave variables already have been set by Tcl_MakeSafe(3)
@@ -1027,16 +1025,13 @@ proc ::safe::BadSubcommand {slave command subcommand args} {
return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}
# AliasEncoding is the target of the "encoding" alias in safe interpreters.
proc ::safe::AliasEncoding {slave option args} {
# Note that [encoding dirs] is not supported in safe slaves at all
set subcommands {convertfrom convertto names system}
# AliasEncodingSystem is the target of the "encoding system" alias in safe
# interpreters.
proc ::safe::AliasEncodingSystem {slave args} {
try {
set option [tcl::prefix match -error [list -level 1 -errorcode \
[list TCL LOOKUP INDEX option $option]] $subcommands $option]
# Special case: [encoding system] ok, but [encoding system foo] not
if {$option eq "system" && [llength $args]} {
# Must not pass extra arguments; safe slaves may not set the system
# encoding but they may read it.
if {[llength $args]} {
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be \"encoding system\""
}
@@ -1044,7 +1039,7 @@ proc ::safe::AliasEncoding {slave option args} {
Log $slave $msg
return -options $options $msg
}
tailcall ::interp invokehidden $slave encoding $option {*}$args
tailcall ::interp invokehidden $slave tcl:encoding:system
}
# Various minor hiding of platform features. [Bug 2913625]
-4
View File
@@ -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
+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}
+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}
+87 -14
View File
@@ -31,6 +31,9 @@
*/
#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#pragma GCC diagnostic ignored "-Wunused-function"
/*
* Use OSSpinLock API where available (Tiger or later).
*/
@@ -42,14 +45,17 @@
* Support for weakly importing spinlock API.
*/
#define WEAK_IMPORT_SPINLOCKLOCK
#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050
#define VOLATILE volatile
#else
#define VOLATILE
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */
#ifndef bool
#define bool int
#endif
extern void OSSpinLockLock(VOLATILE OSSpinLock *lock)
WEAK_IMPORT_ATTRIBUTE;
extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock)
@@ -77,13 +83,54 @@ SpinLockLockInit(void)
Tcl_Panic("SpinLockLockInit: no spinlock API available");
}
}
#define SpinLockLock(p) lockLock(p)
#define SpinLockUnlock(p) lockUnlock(p)
#define SpinLockTry(p) lockTry(p)
#else
#define SpinLockLock(p) OSSpinLockLock(p)
#define SpinLockUnlock(p) OSSpinLockUnlock(p)
#define SpinLockTry(p) OSSpinLockTry(p)
/*
* Wrappers so that we get warnings in just one small part of this file.
*/
static inline void
SpinLockLock(
VOLATILE OSSpinLock *lock)
{
lockLock(lock);
}
static inline void
SpinLockUnlock(
VOLATILE OSSpinLock *lock)
{
lockUnlock(lock);
}
static inline bool
SpinLockTry(
VOLATILE OSSpinLock *lock)
{
return lockTry(lock);
}
#else /* !HAVE_WEAK_IMPORT */
/*
* Wrappers so that we get warnings in just one small part of this file.
*/
static inline void
SpinLockLock(
OSSpinLock *lock)
{
OSSpinLockLock(lock);
}
static inline void
SpinLockUnlock(
OSSpinLock *lock)
{
OSSpinLockUnlock(lock);
}
static inline bool
SpinLockTry(
OSSpinLock *lock)
{
return OSSpinLockTry(lock);
}
#endif /* HAVE_WEAK_IMPORT */
#define SPINLOCK_INIT OS_SPINLOCK_INIT
@@ -93,14 +140,37 @@ SpinLockLockInit(void)
*/
typedef uint32_t OSSpinLock;
extern void _spin_lock(OSSpinLock *lock);
extern void _spin_unlock(OSSpinLock *lock);
extern int _spin_lock_try(OSSpinLock *lock);
#define SpinLockLock(p) _spin_lock(p)
#define SpinLockUnlock(p) _spin_unlock(p)
#define SpinLockTry(p) _spin_lock_try(p)
static inline void
SpinLockLock(
OSSpinLock *lock)
{
extern void _spin_lock(OSSpinLock *lock);
_spin_lock(lock);
}
static inline void
SpinLockUnlock(
OSSpinLock *lock)
{
extern void _spin_unlock(OSSpinLock *lock);
_spin_unlock(lock);
}
static inline int
SpinLockTry(
OSSpinLock *lock)
{
extern int _spin_lock_try(OSSpinLock *lock);
return _spin_lock_try(lock);
}
#define SPINLOCK_INIT 0
#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
/*
@@ -1411,7 +1481,10 @@ UpdateWaitingListAndServiceEvents(
(tsdPtr->runLoopNestingLevel > 1
|| !tsdPtr->runLoopRunning)) {
tsdPtr->runLoopServicingEvents = 1;
/* This call seems to simply force event processing through and prevents hangups that have long been observed with Tk-Cocoa. */
/*
* This call seems to simply force event processing through and
* prevents hangups that have long been observed with Tk-Cocoa.
*/
Tcl_ServiceAll();
tsdPtr->runLoopServicingEvents = 0;
}
+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")
}]
+2 -9
View File
@@ -331,16 +331,9 @@ test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different
test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} {
expr {int(1<<63)}
} -9223372036854775808
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
expr {int(1<<31)}
} -2147483648
} 9223372036854775808
test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
expr x>>3
+7 -7
View File
@@ -805,9 +805,9 @@ test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
set y [expr {$x+1}]
expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} longIs32bit {
set x 0x80000000
expr {int($x) < wide($x)}
test execute-7.8 {Wide int conversions can change sign} {
set x 0x8000000000000000
expr {wide($x) < 0}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
@@ -887,12 +887,12 @@ test execute-7.31 {Wide int handling in abs()} {
set y 0x123456871234568
concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} longIs32bit {
test execute-7.32 {Wide int handling} {
expr {int(1024 * 1024 * 1024 * 1024)}
} 0
test execute-7.33 {Wide int handling} longIs32bit {
} 1099511627776
test execute-7.33 {Wide int handling} {
expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 0
} 1099511627776
test execute-7.34 {Wide int handling} {
expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776
+11 -7
View File
@@ -814,10 +814,10 @@ test expr-old-32.32 {math functions in expressions} {
} {-1}
test expr-old-32.33 {math functions in expressions} {
expr int(1e60)
} 0
} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
expr int(-1e60)
} 0
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
expr round(1.49)
} {1}
@@ -1036,8 +1036,8 @@ test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
testexprlong -0xffffffff
} {This is a result: 1}
testexprlong -0x7fffffff
} {This is a result: -2147483647}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
-constraints {testexprlong longIs32bit} \
-match glob \
@@ -1061,9 +1061,13 @@ test expr-old-37.13 {Tcl_ExprLong handles overflows} \
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
testexprlong -2147483648.
} {This is a result: -2147483648}
test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
testexprlong -4294967295.
} {This is a result: 1}
test expr-old-37.15 {Tcl_ExprLong handles overflows} \
-constraints {testexprlong longIs32bit} \
-match glob \
-body {
list [catch {testexprlong -2147483649.} result] $result
} \
-result {1 {integer value too large to represent*}}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
-constraints {testexprlong longIs32bit} \
-match glob \
+17 -20
View File
@@ -416,12 +416,9 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
expr {int(1<<63)}
} -9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
expr {int(1<<31)}
} -2147483648
} 9223372036854775808
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
expr x>>3
} -returnCodes error -match glob -result *
@@ -1404,8 +1401,8 @@ test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
@@ -5808,7 +5805,7 @@ test expr-32.9 {bignum regression} {
expr {0%-(1+(1<<63))}
} 0
test expr-33.1 {parse largest long value} longIs32bit {
test expr-33.1 {parse largest long value} {
set max_long_str 2147483647
set max_long_hex "0x7FFFFFFF "
@@ -5822,7 +5819,7 @@ test expr-33.1 {parse largest long value} longIs32bit {
[expr {$max_long + 0}] \
[expr {2147483647 + 0}] \
[expr {$max_long == $max_long_hex}] \
[expr {int(2147483647 + 1) < 0}] \
[expr {int(2147483647 + 1) > 0}] \
} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
@@ -5842,7 +5839,7 @@ test expr-33.2 {parse smallest long value} longIs32bit {
[expr {$min_long + 0}] \
[expr {-2147483648 + 0}] \
[expr {$min_long == $min_long_hex}] \
[expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \
[expr {int(-2147483648 - 1) == -0x80000001}] \
} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
@@ -5922,17 +5919,17 @@ test expr-34.11 {expr edge cases} {
test expr-34.12 {expr edge cases} {
expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} longIs32bit {
test expr-34.13 {expr edge cases} {
expr {int($min / -1)}
} {-2147483648}
} {2147483648}
test expr-34.14 {expr edge cases} {
expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} longIs32bit {
expr {int($min * -1)}
test expr-34.15 {expr edge cases} {
expr {-int($min * -1)}
} $min
test expr-34.16 {expr edge cases} longIs32bit {
expr {int(-$min)}
test expr-34.16 {expr edge cases} {
expr {-int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
expr {$min / 1}
@@ -6719,8 +6716,8 @@ test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
testexprlongobj -0xffffffff
} {This is a result: 1}
testexprlongobj -0x7fffffff
} {This is a result: -2147483647}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
-constraints {testexprlongobj longIs32bit} \
-match glob \
@@ -6745,8 +6742,8 @@ test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
testexprlongobj -4294967295.
} {This is a result: 1}
testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
-constraints {testexprlongobj longIs32bit} \
-match glob \
+3 -4
View File
@@ -65,8 +65,7 @@ if {[testConstraint unix]} {
# Also used in winFCmd...
if {[testConstraint win]} {
set major [string index $tcl_platform(osVersion) 0]
if {$major > 5} {
if {$::tcl_platform(osVersion) >= 5.0} {
testConstraint winVista 1
} else {
testConstraint winXP 1
@@ -76,7 +75,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]}]
@@ -2307,7 +2306,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

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