Compare commits

..
Author SHA1 Message Date
jan.nijtmans 656850e9a4 Always use UTF-8 when reading from the console (See also TIP #587) 2022-02-10 14:18:25 +00:00
jan.nijtmans 1f35ddfe62 Use Tcl_NewWideIntObj() for values that might be bigger than 32-bit 2022-02-10 14:16:00 +00:00
jan.nijtmans 110e6cae5e Merge 8.6 2022-02-10 09:37:55 +00:00
jan.nijtmans 8f805cf711 Use TclListObjLength/TclListObjGetElements in stead of Tcl_ListObjLength/Tcl_ListObjGetElements everywhere. This is slightly more efficient if the refered list already has the correct type 2022-02-10 09:26:16 +00:00
jan.nijtmans 805db9224e Merge 8.6 2022-02-09 22:10:44 +00:00
jan.nijtmans f608eb10d4 Put back '@' (lost in previous commit) 2022-02-09 22:09:07 +00:00
jan.nijtmans d60cf573c0 Merge 8.6 2022-02-09 11:58:07 +00:00
jan.nijtmans da0f6cf283 More steps, making it work for ARM64 2022-02-09 11:33:44 +00:00
jan.nijtmans 4e39a8e0b8 Accept aarch64 too (in stead of arm64) 2022-02-08 15:07:28 +00:00
jan.nijtmans d6d9d92060 Correct previous commit (Windows build error) 2022-02-08 14:23:39 +00:00
jan.nijtmans 2b26997c85 More changed for windows-arm (e.g. add zdll.lib for ARM64, although zlib1.dll still missing) 2022-02-08 10:54:45 +00:00
jan.nijtmans 94d7b078fa Merge 8.6 2022-02-08 10:04:08 +00:00
jan.nijtmans 72907faafe Fix [1fe745559a]: Conditional jump or move depends on uninitialised value in Tcl_UniCharToUtf 2022-02-07 22:16:34 +00:00
jan.nijtmans 962d2a8130 Fix [1fe745559a]: 8.7, 9.0: Conditional jump or move depends on uninitialised value in Tcl_UniCharToUtf 2022-02-07 15:35:09 +00:00
jan.nijtmans 387f9a6753 Merge 8.6 2022-02-07 14:55:06 +00:00
jan.nijtmans f48af06d66 Fix [bae42b3d24]: [d86e92fb33] et.al. eliminates cpuid when cross compiling for win32 2022-02-07 14:42:11 +00:00
jan.nijtmans e6b6fcc9d4 Merge 8.6 2022-02-07 08:48:01 +00:00
jan.nijtmans dbae7c51f1 Add support for windows-arm platform 2022-02-07 08:45:06 +00:00
jan.nijtmans 8f8b424c15 another try, rules.vc version 1.10 2022-02-06 12:47:54 +00:00
jan.nijtmans 8be8b50886 See [https://github.com/tcltk/tcl/pull/10] 2022-02-04 16:19:25 +00:00
jan.nijtmans 99678d70f7 Fix Tcl_UtfToWChar() typedef 2022-02-03 12:49:55 +00:00
jan.nijtmans fd9dbdd294 Merge 8.6 2022-02-02 16:46:10 +00:00
jan.nijtmans 7b1d345686 Change DEFAULT_PRIMARY_PROMPT from #define to static const string (saves a strlen() call) 2022-02-02 16:42:18 +00:00
jan.nijtmans 11cc37e818 Merge 8.6 2022-02-01 12:31:47 +00:00
jan.nijtmans 3311ca7d30 Code cleanup in tclMain.c and tclAppInit.c: Make them Tcl-8.7-aware, usable as more generic examples for extensions. 2022-02-01 12:03:54 +00:00
bch 95bcc53807 take advantage of what we know re: argv guarantees [https://www.iso-9899.info/n1570.html#5.1.2.2.1|argv spec] (per @cousteau on #tcl) 2022-01-28 23:52:10 +00:00
bch cc66f3601f rejig argv/argc handling in response to investigation prompted by [https://arstechnica.com/information-technology/2022/01/a-bug-lurking-for-
12-years-gives-attackers-root-on-every-major-linux-distro/|this "polkit issue"] and some experimenting w/ execve() (ab)use. Essentially port of [0e1d2702ab] and its parent; discussed at length on IRC
2022-01-28 23:28:24 +00:00
pooryorick 5c2bc08ea4 Add back a clarification to the documentation for [expr] that an operand is
interpreted as a number wherever possible, and rework text to be more compact.
2022-01-26 17:48:34 +00:00
jan.nijtmans 831e85b8f6 Merge 8.6 2022-01-24 15:40:34 +00:00
jan.nijtmans 5d9db7d9ac intPtr -> lengthPtr in Tcl_ListObjLength() documentation, so the documentation matches the signature in the header file 2022-01-24 15:29:36 +00:00
jan.nijtmans d46657f1f7 Don't document the size_t form of Tcl_GetStringFromObj() (yet), because it's only available if TCL_NO_DEPRECATED is defined 2022-01-24 11:15:39 +00:00
jan.nijtmans bc8c2ad47a Fix another bug in Tcl_GetIntForIndex() (demonstrated by the new testcases from the previous commit) 2022-01-24 11:01:07 +00:00
jan.nijtmans 511e85013a eol-spacing from previous commit 2022-01-23 16:21:42 +00:00
pooryorick 641cba82ec Rewrite of documentation for [chan] 2022-01-22 14:47:29 +00:00
jan.nijtmans 4d0a0d7dc2 Merge 8.6 2022-01-21 15:15:45 +00:00
jan.nijtmans d4e2ae119e Undo part of [26539e78a7]. Although Tcl_GetRange() does it's own parameter check, it's caller doesn't have to do it any more. However, put back these check, better not depend on the improved behavior of Tcl_GetRange (yet). This gives the freedom to bring back Tcl_GetRange() to how it was in Tcl 8.6.10, if desired 2022-01-21 14:44:58 +00:00
jan.nijtmans 65ca3bc25b Fix bug in Tcl_GetIntForIndex() (TIP #544), discovered when investigating [https://core.tcl-lang.org/tk/tktview?name=a9929f112a|a9929f112a] 2022-01-21 08:53:56 +00:00
jan.nijtmans e433c57158 Add test-cases for Tcl_GetIntForIndex(). This reveals a minor bug 2022-01-21 08:43:13 +00:00
jan.nijtmans b97786c85d (partial) fix for [https://core.tcl-lang.org/tk/tktview?name=a9929f112a|a9929f112a]. WIP 2022-01-19 14:21:38 +00:00
jan.nijtmans d0b2869273 Update documentation for Tcl_GetRange() 2022-01-18 23:26:20 +00:00
jan.nijtmans ae78b89233 Merge 8.6 2022-01-18 15:52:13 +00:00
jan.nijtmans f97560a949 Fix [e9a2715d91]: Incompatible Tcl_GetRange(). From now on (unofficially) the last function argument can be set to -1 (or any negative value) meaning 'end'. 2022-01-18 15:39:21 +00:00
jan.nijtmans c3bcd951b8 Possible fix for [e9a2715d91]: Tcl 8.6.11: Incompatible Tcl_GetRange() 2022-01-17 17:26:37 +00:00
jan.nijtmans b563c159d7 Fix merge conflict previous commit 2022-01-17 17:07:14 +00:00
jan.nijtmans b45bc74fab Merge 8.6 2022-01-17 17:02:57 +00:00
jan.nijtmans 01a48e2369 Tcl_NewObj() -> TclNewObj() 2022-01-17 16:44:44 +00:00
jan.nijtmans 92c6a70081 Merge 8.6 2022-01-17 11:21:08 +00:00
jan.nijtmans e5a2ebd71b Follow-up to [767e070d35]: Tcl_GetRange and Tcl_GetUniChar do not validate index inputs.
Now that Tcl_GetRange() checks its arguments, the callers of this function don't have to do that any more.
This also shows a off-by-one error in the Tcl_GetRange() check
2022-01-17 10:35:18 +00:00
jan.nijtmans 2f374ff67e Fix [6474fbd934]: Tcl 8.7a5: why utf-8 is different? 2022-01-15 17:02:29 +00:00
jan.nijtmans 9bcfb6703d Proposed fix for [6474fbd934]: Tcl 8.7a5: why utf-8 is different? 2022-01-14 22:34:06 +00:00
jan.nijtmans c513699e2c Fix [b241e4ccc0]: Error while building with Tcl 8.7a5... 2022-01-14 15:44:02 +00:00
jan.nijtmans f1b74b0757 Merge 8.6 2022-01-14 10:10:30 +00:00
jan.nijtmans a9eaf67651 Fix [816913a65e]: GrowStringBuffer(): signed integer overflow. And a few similar situations in other places 2022-01-14 09:54:48 +00:00
jan.nijtmans 2dd5df343a Fix [bca10e3790]: Undefined behavior in ResultAdd(). Make functions like ResultAdd() equal in tclIOGt.c and tclIOTrans.c 2022-01-14 09:53:14 +00:00
jan.nijtmans 8a90d26eaf Merge 8.6 2022-01-13 13:23:10 +00:00
jan.nijtmans be409f301e Fix [69218ab7b]: TEBCResume(): buffer over-read in INST_STR_MAP 2022-01-13 13:22:07 +00:00
jan.nijtmans 71c8acf7e6 Fix for [26f1328a86]: sizeof(int) < sizeof(void*) -> Crash 2022-01-13 13:20:53 +00:00
jan.nijtmans 1bc44ec32a Fix [816913a65e]: GrowStringBuffer(): signed integer overflow. And a few similar situations in other place 2022-01-13 12:22:51 +00:00
jan.nijtmans d679a49bc0 Fix [6cb3db4965]: pointer arithmetic using NULL in InitArgsAndLocals() 2022-01-13 11:46:50 +00:00
jan.nijtmans e874b759fc Suggested fix for [bca10e3790]: Undefined behavior in ResultAdd(). Make functions like ResultAdd() equal in tclIOGt.c and tclIOTrans.c 2022-01-13 11:12:40 +00:00
jan.nijtmans 99b53ecd55 Merge 8.6 2022-01-12 21:41:26 +00:00
jan.nijtmans 32ab46ae40 Fix [fba9c1fc12]: pointer arithmetic using NULL in PrintParse() 2022-01-12 21:39:40 +00:00
jan.nijtmans 6fb4e398d6 Merge 8.6 2022-01-12 21:09:28 +00:00
jan.nijtmans 05dc6d00c2 Fix [da6f155ca4]: STRING_SIZE() macro: parenthesize numChars usage. Fix more macro's like this. 2022-01-12 16:33:51 +00:00
jan.nijtmans 2171b321cf Fix [69218ab7b]: TEBCResume(): buffer over-read in INST_STR_MAP 2022-01-12 15:50:30 +00:00
jan.nijtmans 2fa8967c62 Proposed fix for [26f1328a86]: sizeof(int) < sizeof(void*) -> Crash 2022-01-12 14:19:04 +00:00
jan.nijtmans 2161463b5b Rename "testConstraint nodep" to "testConstraint deprecated", making it the same as in Tk 2022-01-09 16:54:08 +00:00
jan.nijtmans 9cd875fc6f Merge 8.6 2022-01-07 19:55:48 +00:00
jan.nijtmans 5608e51a46 tcltk-man2html-utils.tcl: Before doing a "string range", check if that makes sense at all 2022-01-07 19:52:34 +00:00
jan.nijtmans c220ae0d43 Fix [0386e9a967]: Bitrot in tclZlib.c 2022-01-07 17:17:09 +00:00
jan.nijtmans e3c67e0881 New macro TclNewIndexObj(). For Tcl 8.7 it's the same as TclNewIntObj(), but in Tcl 9.0 not any more.
Merge 8.6
2021-12-21 16:18:53 +00:00
oehhar fc5ef30f8c binary encode/decode hex: document upper/lower character use. 2021-12-20 14:38:13 +00:00
jan.nijtmans ead6c0d054 Unbreak windows build caused by [066a9b81b8|this] commit 2021-12-20 00:58:30 +00:00
jan.nijtmans b3d12a5e6d Merge 8.6 2021-12-18 19:02:13 +00:00
jan.nijtmans f60e164799 Make it impossible for the indexType object to cache negative index values. And - if it happens - at least don't crash on it. 2021-12-18 18:55:50 +00:00
jan.nijtmans 63b42715a8 Merge 8.6 2021-12-18 15:07:30 +00:00
jan.nijtmans a128b4d651 Fix [5507a9c096]: Small error on https://www.tcl.tk/man/tcl/TclCmd/try.html 2021-12-18 15:03:29 +00:00
jan.nijtmans 310292eedb Merge 8.6 2021-12-18 14:59:58 +00:00
jan.nijtmans c65c7c0a59 Fix [b0f84119c8]: TEBCresume(): undefined behavior for INST_LSHIFT 2021-12-18 14:46:45 +00:00
jan.nijtmans 46eeca1581 Merge 8.6 2021-12-16 21:26:39 +00:00
jan.nijtmans f3edde2f64 Fix [d1434179b5]: avoid signed integer overflow in AppendUtfToUtfRep() 2021-12-16 21:25:52 +00:00
jan.nijtmans 6a3a8ae8ff Suggested fix for [b0f84119c8]: TEBCresume(): undefined behavior for INST_LSHIFT 2021-12-16 21:02:15 +00:00
jan.nijtmans 72000228fc Merge 8.6 2021-12-16 14:01:45 +00:00
jan.nijtmans 22325d1e08 Add 2 new testcases, for Tcl_GetIndexFromObjStruct with TCL_EXACT flag and for Tcl_GetIndexFromObjStruct with NULL argument 2021-12-16 12:09:11 +00:00
jan.nijtmans c47479ba6c Merge 8.6 2021-12-16 09:14:33 +00:00
jan.nijtmans fcc9c57804 Fix [6ef312dcf5]: memcpy() with NULL source in Tcl_CreateMathFunc() 2021-12-16 09:02:59 +00:00
jan.nijtmans 76f73fbad9 Fix [31e302fcf7]: signed integer overflow in generic/tclHash.c 2021-12-16 08:35:37 +00:00
jan.nijtmans e99a84db0a Fix [90612089d8]: signed integer overflow in ExprRandFunc() 2021-12-16 08:20:53 +00:00
jan.nijtmans b95cae5898 Undo prevous commit. See [41b1406f51] for the reason 2021-12-16 08:03:39 +00:00
jan.nijtmans 187de15e2b Fix [90612089d8]: signed integer overflow in ExprRandFunc() 2021-12-15 17:03:03 +00:00
jan.nijtmans cacd6930cf Addendum to [41b1406f51]: change '<=' in range-check to '<' 2021-12-15 16:58:08 +00:00
jan.nijtmans 45a9461fda Merge 8.6 2021-12-13 12:59:46 +00:00
jan.nijtmans f171868256 Fix [41b1406f51]: AppendUtfToUtfRep(): undefined behavior involving pointers 2021-12-13 11:39:15 +00:00
jan.nijtmans adcaff51ac Merge 8.6 2021-12-13 10:57:09 +00:00
jan.nijtmans 4d561210e9 Prevent crash in Tcl_GetIndexFromObj*() when objPtr == NULL. Just let it produce a normal error-message then. Also add some more type-casts 2021-12-13 10:35:19 +00:00
jan.nijtmans f1752f51c9 Merge 8.6 2021-12-12 18:03:37 +00:00
jan.nijtmans 401b464a4d Fix [ac6792195d]: avoid signed integer overflow in BinaryEncodeUu() 2021-12-12 17:59:11 +00:00
jan.nijtmans bc22d501c0 merge-mark 2021-12-08 15:50:50 +00:00
jan.nijtmans 2d2b28f51a Update tcltest package to version 2.5.4 (backported from Tcl 8.7) 2021-12-08 15:49:24 +00:00
jan.nijtmans fec24f8b80 Merge 8.6 2021-12-08 15:28:55 +00:00
jan.nijtmans 5c70ebf5df Add more win/*.in files to "make dist". Generate tclUuid.h (not used yet). With nmake build, install "zlib1.dll" in bin-directory (just as when using make) 2021-12-08 15:07:11 +00:00
jan.nijtmans dc62ebb08b Merge 8.6 2021-12-07 18:15:26 +00:00
jan.nijtmans 3ad14e6b9a Fix [cea2c63928]: Address -fsanitize=shift-exponent complaints in TclParseNumber() 2021-12-07 18:05:04 +00:00
jan.nijtmans 4f1573ed0c merge-mark 2021-12-02 13:47:15 +00:00
jan.nijtmans 5bf0f34014 Fix winFCmd-19.5 testcase on GitHub actions: Tcl 8.5 is known not to be able to handle too long filenames (8.6 can!) 2021-12-01 09:58:10 +00:00
jan.nijtmans 6a5e34f9b7 windows-2016 will no longer be supported by GitHub actions 2021-11-30 21:46:16 +00:00
jan.nijtmans ef0be5183b Fix [97b8e1d54b]: -mdynamic-no-pic not supported on Apple Silicon 2021-11-28 21:53:34 +00:00
jan.nijtmans cdd06df9db Merge 8.6. Add win/*.in to "make dist" 2021-11-26 16:04:48 +00:00
jan.nijtmans 43b8bf6430 Add (missing) win/svnmanifest.in win/tclUuid.h.in (not really used yet) 2021-11-26 15:56:46 +00:00
jan.nijtmans 274e64c463 Unbreak build 2021-11-26 15:54:37 +00:00
jan.nijtmans 99180fcdaa Change TclInitSubsystems() signature, matching Tcl_InitSubsystems() in Tcl 8.7. Add more type-casts (better C++ compatibility) 2021-11-26 15:47:49 +00:00
jan.nijtmans b3e1ffc179 TIP #599 implementation: Extended build information 2021-11-26 11:59:09 +00:00
jan.nijtmans 21b68e66bf Add support for subversion too 2021-11-24 14:51:34 +00:00
jan.nijtmans 3261c033d2 Merge 8.7 2021-11-24 12:32:04 +00:00
jan.nijtmans c65fe541cc Merge 8.6 2021-11-24 12:22:08 +00:00
jan.nijtmans a4251af984 Add rule to generate manifest.uuid and tclUuid.h, if not present already. Not used yet 2021-11-24 12:12:49 +00:00
jan.nijtmans 9e52c62db6 2 minor improvements: Make sure tclUuid.h ends with newline; Fallback "unknown" if neither GIT, neither fossil is detected 2021-11-23 21:33:14 +00:00
jan.nijtmans 693c2744f3 Merge 8.7 2021-11-19 17:28:54 +00:00
jan.nijtmans bb2edf5377 Fix [46291ba24d]: win: install: bashism in Makefile.in 2021-11-17 10:08:35 +00:00
jan.nijtmans 6c20a6ff0d Starting with 8.7, don't bother Cygwin32 any more. Only Cygwin64 will be supported. 2021-11-12 21:29:06 +00:00
jan.nijtmans 52a3eade6b Merge 8.6 2021-11-11 16:13:56 +00:00
jan.nijtmans fdf25d3a1f Fix -fno-lto determination/add --enable-auto-image-base option to windows build (when available) 2021-11-11 16:12:24 +00:00
jan.nijtmans 6d8339e649 Merge 8.7 2021-11-10 08:24:30 +00:00
jan.nijtmans 36e74b9e8d Merge 8.6 2021-11-09 15:50:14 +00:00
jan.nijtmans 4d0be555a4 Use octal permissions in testcases 2021-11-09 11:28:19 +00:00
jan.nijtmans 5ad22cafaf Merge 8.7 2021-11-08 23:11:16 +00:00
jan.nijtmans fa56430c8b Merge 8.6. Some http:// -> https:// 2021-11-08 14:03:43 +00:00
jan.nijtmans fabf9b4e53 mingw-w64 website changed 2021-11-08 14:02:30 +00:00
jan.nijtmans 8bfcb2b80c Make "changes" file chronological (again) 2021-11-08 13:43:07 +00:00
dgp 411fc46d4f [9899c273ab] Rewrite Tcl_InitStringRep to account for all encounters with
the non-allocated empty string rep.
2021-11-08 00:06:27 +00:00
dgp a112105294 Update and clarify usage of the TclInitStringRep macro. 2021-11-07 22:39:40 +00:00
jan.nijtmans 3f060e9d6c Merge 8.6 2021-11-07 21:42:09 +00:00
jan.nijtmans 5eb33c5c7e Fix [15845d9fd8]: unix/tcl.m4: implicit declaration of exit() in timezone variable checks 2021-11-07 21:34:08 +00:00
dgp 6eceb08de2 Document the freedom to provide space of either type int or size_t. 2021-11-07 20:39:32 +00:00
dgp 84ac71183d More accurately describe the string rep invalidation performed
by Tcl_SetByteArrayLength()
2021-11-07 03:20:54 +00:00
dgp 370e151c69 typo 2021-11-06 22:45:26 +00:00
dgp c6b69a1fa5 merge 8.6 2021-11-06 20:33:36 +00:00
dgp 36909daded Doc fix. There is no endianness in the encoding of a single byte. 2021-11-06 20:33:09 +00:00
dgp dc9c511e43 merge 8.6 2021-11-06 15:41:54 +00:00
dgp c9f5f714b7 Missing static. 2021-11-06 15:37:14 +00:00
dgp 038dfd11b3 Make more use of the Tcl_ObjCmdProc typedef for tidier branch merging. 2021-11-06 15:35:39 +00:00
jan.nijtmans f096016a8e Eliminate unused variables/function-arguments 2021-11-06 08:02:01 +00:00
dgp 5bff482dcc Implement parts of TIP 568 in Tcl 8.7. 2021-11-05 22:39:45 +00:00
dgp 3ec9f64eb9 merge 8.6 2021-11-05 21:30:52 +00:00
dgp 28fb151fd7 merge release 2021-11-05 21:23:44 +00:00
dgp cf9ec4f29a Adapt documentation of the *ByteArray* routines to better match Tcl
library functioning post-TIP 568.
2021-11-05 19:47:03 +00:00
dgp 1a396e5b24 merge 8.7 2021-11-05 12:39:14 +00:00
griffin 0652bd43d5 Fix for bug [fc65ff1b66] - zipfs mkimg 2021-11-04 17:18:00 +00:00
dgp e648450fcd merge 8.7 2021-11-02 16:48:18 +00:00
dgp 88129d2c87 Revise the interface routines for byte arrays to use "numBytes" rather than
"length" as argument names.
2021-11-02 16:40:29 +00:00
dgp eea5dbac26 merge 8.6 2021-11-02 15:06:30 +00:00
jan.nijtmans 069ffa837b Merge 8.6 2021-11-01 13:38:39 +00:00
jan.nijtmans d9aca41432 Update DragonFly/FreeBSD configuration (requested by Pietro Cerutti) 2021-11-01 13:21:12 +00:00
dgp 4c9ef53c21 update changes 2021-10-30 19:49:33 +00:00
jan.nijtmans 8e166381ae Bump to 8.6.12 for release 2021-10-27 08:12:26 +00:00
jan.nijtmans fbe1e767e5 Merge 8.6 2021-10-27 07:05:32 +00:00
jan.nijtmans 570c870e93 Update platform version (1.0.17 -> 1.0.18) for MacOS Monterey support 2021-10-27 07:03:53 +00:00
jan.nijtmans dcb9d4c330 Update platform version (1.0.17 -> 1.0.18) for MacOS Monterey support 2021-10-27 07:00:53 +00:00
jan.nijtmans be69e67b9a Merge 8.6 2021-10-27 06:50:48 +00:00
jan.nijtmans b9c2728c64 Update TZ info to tzdata2021e 2021-10-27 06:49:45 +00:00
jan.nijtmans daf00857b8 Update TZ info to tzdata2021e 2021-10-27 06:48:14 +00:00
jan.nijtmans 3fd1eadede Merge 8.6 2021-10-25 21:35:22 +00:00
jan.nijtmans f1076e8f35 Merge 8.5 2021-10-25 21:32:24 +00:00
jan.nijtmans 4eaf0af8f2 Update platform extension for MaxOS Monterey 2021-10-25 21:27:04 +00:00
dgp e58d1a560f Revise outdated comments. 2021-10-25 15:34:06 +00:00
dgp a3fc5612c1 merge 8.7 2021-10-25 14:14:25 +00:00
griffin 13223fbc3f These record locations are not relative offsets, but rather absolute locations. 2021-10-24 18:19:16 +00:00
jan.nijtmans 7f8b256581 Code cleanup (comments, bracing) 2021-10-20 20:27:45 +00:00
jan.nijtmans 49260f096b Merge 8.6 2021-10-19 14:44:19 +00:00
jan.nijtmans 58583ac83f IntRep -> InternalRep. Internal changes only. 2021-10-19 14:42:56 +00:00
jan.nijtmans f3ce97fe14 Fix "nodep" constraint. Merge 8.7 2021-10-19 12:43:42 +00:00
jan.nijtmans 7fa6ef0e9c Merge-mark 2021-10-18 18:56:10 +00:00
jan.nijtmans 71c68757ce Update TZ info to tzdata2021d 2021-10-18 18:53:54 +00:00
José Ignacio Marín d75194b6b8 Update TZ info to tzdata2021d (via merge). 2021-10-18 18:24:55 +00:00
José Ignacio Marín 8ddc732425 Update TZ info to tzdata2021d. 2021-10-18 18:23:48 +00:00
dgp ebe3f974d6 merge 8.7 2021-10-18 14:44:29 +00:00
jan.nijtmans 83c50861c2 Merge 8.7 2021-10-18 09:51:05 +00:00
jan.nijtmans 43d72b8d8e separate "testConstraint nodep" in tcltests.tcl 2021-10-18 09:43:03 +00:00
jan.nijtmans d9f0f7a35d separate testConstraint nodep 2021-10-18 08:56:26 +00:00
jan.nijtmans aacc53e29a Merge 8.7 2021-10-18 07:51:23 +00:00
jan.nijtmans 8fbe8df970 RFE [cef426ff2c]: Encoding UTF-32 missing 2021-10-15 14:48:45 +00:00
jan.nijtmans 7e82249b7f Code/Comment cleanup 2021-10-14 14:32:39 +00:00
griffin 2812109f17 Remove unnecessary change 2021-10-13 16:34:46 +00:00
jan.nijtmans 82df0e7cc9 Oops 2021-10-13 13:51:26 +00:00
jan.nijtmans be9f231fda First shot at [cef426ff2c]: Encoding UTF-32 missing 2021-10-13 13:33:43 +00:00
griffin 34e7d9999e Corrected offset calculations 2021-10-13 00:22:20 +00:00
jan.nijtmans 5d1a856f7a Merge 8.6 2021-10-12 14:46:04 +00:00
jan.nijtmans ee2bdcdf6b Missing braces (just to be sure) 2021-10-12 14:27:31 +00:00
jan.nijtmans 473ebe84ef Fix build failure with --enable-symbols build on Windows: Some code makes assumptions on Tcl_Time structure ... 2021-10-12 14:18:18 +00:00
jan.nijtmans 918f0fe1aa Merge 8.7 2021-10-11 13:57:53 +00:00
jan.nijtmans f43dd68346 Better solution, in stead of [https://core.tcl-lang.org/tk/info/6ffcea9b093deb5a|6ffcea9b]: Handle 64-bit (Cygwin64) Tcl_GetTime(), when loading tk86.dll 2021-10-11 13:54:06 +00:00
pooryorick 4744055aa0 Fix for issue [a8579d906a28], "argument with no name". 2021-10-08 19:42:22 +00:00
jan.nijtmans a94a7ca7b7 Merge 8.7 2021-10-08 09:26:26 +00:00
jan.nijtmans 343851002d Change "IntRep" to "InternalRep", as discussed in the Tcl Core mailing list 2021-10-08 07:08:28 +00:00
jan.nijtmans 447dd177c9 Merge 8.6 2021-10-08 07:05:19 +00:00
jan.nijtmans 0ded79bd3a merge-mark 2021-10-08 07:04:20 +00:00
jan.nijtmans 2eb56b3c28 Update TZ info to tzdata2021c. 2021-10-07 14:58:32 +00:00
José Ignacio Marín 1ef5ff37cd Update TZ info to tzdata2021c. 2021-10-02 17:01:48 +00:00
jan.nijtmans 469e69030b Merge 8.7 2021-09-29 12:29:05 +00:00
jan.nijtmans 4571430dc4 Merge 8.7 2021-09-26 20:56:01 +00:00
jan.nijtmans 9dc50cfea3 Merge 8.7 2021-09-24 14:13:14 +00:00
dgp 297d150968 merge 8.7 2021-09-10 18:52:36 +00:00
dgp d762e7fcd2 merge 8.7 2021-09-02 21:27:09 +00:00
griffin bc437743d5 Patch to fix zipfs mkimg bug. 2021-08-31 14:36:33 +00:00
dgp b649d5f2ef Work in progress updating the documentation to modern perspectives. 2021-08-27 18:46:10 +00:00
dgp 477d3c8e0d merge 8.7 2021-08-27 11:51:52 +00:00
dgp e8588ab026 merge 8.7 2021-08-23 17:03:17 +00:00
jan.nijtmans 05631cdda6 Merge 8.7 2021-08-05 11:20:48 +00:00
jan.nijtmans 74d70948ce Fix knownMsvcBug testConstraint 2021-08-04 14:52:32 +00:00
jan.nijtmans 7ac3bf2415 Found the problem with Visual Studio: somehow it doesn't handle empty brackets [] right .... 2021-08-03 10:26:10 +00:00
jan.nijtmans d03c57db7f merge-mark 2021-08-02 14:53:30 +00:00
jan.nijtmans 82ad00811c Bring over more from "build-info" branch 2021-08-02 14:52:39 +00:00
jan.nijtmans 393f3c5b48 Merge build-info-experiment 2021-07-30 12:53:32 +00:00
jan.nijtmans 92e1716af3 make it work for GIT too 2021-07-30 12:50:54 +00:00
jan.nijtmans 35f79cbdbf In "makefile.vc" add building new header-file tclUuid.h. Not used for anything yet. 2021-07-30 12:35:23 +00:00
dgp 915aace29f merge 8.7 2021-07-26 16:43:31 +00:00
jan.nijtmans 439e18d8d9 Merge 8.7. Re-implement testConstraint knownMsvcBug in terms of tcl::build-info 2021-07-23 10:03:15 +00:00
dgp 457a07a761 merge 8.7 2021-07-19 14:06:47 +00:00
jan.nijtmans c39b5671ce Add support for ICC 2021-07-14 08:58:13 +00:00
jan.nijtmans bffdbce72e fullversion -> patchlevel 2021-07-13 16:14:35 +00:00
jan.nijtmans ce04bad35e More advanced tcl::build-info string parsing 2021-07-13 15:56:33 +00:00
jan.nijtmans 83e8931185 Merge-mark 2021-07-13 14:22:56 +00:00
jan.nijtmans 582fceb34d Remove tclPkg.c changes, instead implement new tcl::build-info command 2021-07-13 13:12:40 +00:00
jan.nijtmans 957da2bc57 Eliminate clang warning 2021-07-09 22:11:03 +00:00
jan.nijtmans a545cd5b47 "profiled" -> "profile" 2021-07-02 09:57:51 +00:00
jan.nijtmans 007417b8be "utf16" -> "utf-16" 2021-07-01 10:35:46 +00:00
jan.nijtmans 0c5ef0b57f Merge 8.7 2021-06-29 16:06:01 +00:00
jan.nijtmans eb4a617c51 TCL_THREADS=0 means no threads too .... 2021-06-29 15:59:19 +00:00
jan.nijtmans eb94deaf81 Merge 8.7. Minor signature fix in tcl.decls 2021-06-29 15:48:41 +00:00
jan.nijtmans b37752f775 Merge 8.7 2021-06-28 12:36:06 +00:00
jan.nijtmans ce4804bf2c Merge 8.7 2021-06-25 14:03:55 +00:00
dgp d94c2ac828 merge 8.7 2021-06-18 19:23:25 +00:00
jan.nijtmans 7951ebbd2e Merge 8.7 2021-06-08 12:14:25 +00:00
jan.nijtmans 05e623cbed Merge 8.7 2021-06-04 07:49:34 +00:00
jan.nijtmans 0e90b5c0cf Merge 8.7. Add "ilp32" build flag 2021-05-26 10:28:11 +00:00
dgp cfeffbe151 merge 8.7 2021-05-25 13:16:16 +00:00
dgp db355c6ea7 merge 8.7 2021-05-20 19:17:43 +00:00
dgp 235cbf9e89 merge 8.7 2021-05-19 14:49:47 +00:00
dgp dc8cb018ad merge 8.7 2021-05-07 13:58:43 +00:00
dgp a40403b0ea merge 8.7 2021-05-03 20:44:07 +00:00
dgp c59734a3cb merge 8.7 2021-04-30 15:34:43 +00:00
jan.nijtmans 15ba6741cf doc update 2021-04-29 11:28:50 +00:00
jan.nijtmans be928297ad Remove "testpurify" and "testdebug" test commands 2021-04-29 11:13:42 +00:00
jan.nijtmans dcd421e97b Merge 8.7 2021-04-29 10:04:25 +00:00
dgp 61a96cbf27 merge 8.7 2021-04-28 22:46:10 +00:00
jan.nijtmans d04f26fbb1 Merge 8.7 Signature change for Tcl_SetPanicProc() and Tcl_FindExecutable() 2021-04-28 15:53:59 +00:00
dgp 4f23433b6f merge 8.7 2021-04-26 14:08:04 +00:00
dgp 5e92a219dd merge 8.7 2021-04-23 19:24:39 +00:00
dgp 4b225827c3 merge 8.7 2021-04-15 18:13:59 +00:00
dgp a72038b28b merge 8.7 2021-04-14 17:12:23 +00:00
jan.nijtmans 7f42387e71 Merge 8.7 2021-04-14 08:47:53 +00:00
dgp b7eb7f182f merge 8.7 2021-04-08 19:46:28 +00:00
dgp e7b7016312 merge 8.7 2021-04-05 15:42:01 +00:00
dgp 3acc6f036a merge 8.7 2021-04-03 20:31:20 +00:00
dgp e938ad82aa merge 8.7 2021-03-22 22:22:24 +00:00
dgp db2b6f6d62 merge 8.7 2021-03-15 13:47:24 +00:00
dgp 878d021fa0 merge 8.7 2021-03-15 13:32:50 +00:00
dgp 0786d600be merge 8.7 2021-03-15 11:53:35 +00:00
dgp 13da4f394b merge 8.7 2021-03-11 14:36:14 +00:00
dgp 2f9047786e merge 8.7 2021-03-09 15:37:42 +00:00
dgp 04e43741b0 merge 8.7 2021-03-08 17:15:51 +00:00
dgp c432456516 merge 8.7 2021-03-04 15:51:14 +00:00
jan.nijtmans 9ffcf83c49 Merge 8.7. Undo 2 unnecessary signature changes 2021-02-28 17:29:16 +00:00
jan.nijtmans 41d412e023 Merge 8.7 2021-02-26 15:58:15 +00:00
jan.nijtmans d044132580 Fix build with -DTCL_NO_DEPRECATED cflag 2021-02-25 11:54:10 +00:00
dgp a3914d29e0 merge 8.7 2021-02-24 15:22:24 +00:00
jan.nijtmans a8c5eb74e5 Merge 8.7 2021-02-24 13:09:44 +00:00
jan.nijtmans 5183eb3389 Merge 8.7. Change more functions signatures to return the Tcl full version number. 2021-02-24 08:43:28 +00:00
dgp f3da65e7a2 merge 8.7 2021-02-16 16:26:21 +00:00
jan.nijtmans 2dee9266c1 Merge 8.7 2021-02-10 11:42:14 +00:00
dgp 18de724391 merge 8.7 2021-02-05 18:20:54 +00:00
jan.nijtmans a7eae9c060 Add build tags for objective-c/cplusplus 2021-02-01 15:38:20 +00:00
jan.nijtmans eb3968cb61 Merge 8.7. Make "git rev-parse" work from any directory 2021-02-01 09:17:57 +00:00
jan.nijtmans fa3fc41362 Merge 8.7 2021-01-28 16:47:10 +00:00
jan.nijtmans 408e1c14d0 Merge 8.7 2021-01-28 15:31:11 +00:00
jan.nijtmans b373f35cc2 Make Tcl_GetBytesFromObj usable without TCL_NO_DEPRECATED too. Fix "testbytestring" test command, prevent stack smash (seen in github action build) 2021-01-26 11:13:11 +00:00
dgp 8a88828033 merge 8.7 2021-01-25 18:51:12 +00:00
dgp 656d39948f merge 8.7 2021-01-22 21:47:51 +00:00
jan.nijtmans 56938ac247 Make Tcl_GetBytesFromObj work with size_t length parameter (just as Tcl_GetByteArrayFromObj in TIP #481.
Add documentation for the new function
2021-01-18 15:59:11 +00:00
dgp 120e206269 merge 8.7 2021-01-15 22:01:20 +00:00
dgp 3d5d443c72 Merge TIP 481 (resolve conflicts) 2021-01-15 21:46:54 +00:00
dgp d56c554577 Merge pre-TIP 481 commits of 8.7 branch 2021-01-15 18:22:19 +00:00
dgp c36c170615 merge 8.7 2021-01-03 00:32:10 +00:00
dgp 47d47a0924 merge 8.7 2020-12-21 13:46:16 +00:00
jan.nijtmans 115a32cd6f Merge 8.7 2020-12-13 16:57:25 +00:00
dgp 573b4f4d3f merge 8.7 2020-12-10 18:58:29 +00:00
dgp 57a08cebbf merge 8.7 2020-12-07 16:31:22 +00:00
dgp fb566c5e57 merge 8.7 2020-11-10 16:44:48 +00:00
jan.nijtmans 9d07732ca0 Fix build/testcases on UNIX/Mac 2020-11-03 14:24:32 +00:00
jan.nijtmans e6def0aaaf Make everything work on Windows, using loaded tcl::test package 2020-11-03 12:14:25 +00:00
jan.nijtmans 9f5653ac08 Fix clang++ build 2020-11-03 11:25:57 +00:00
dgp 79bcff327b merge 8.7 2020-10-30 20:23:17 +00:00
jan.nijtmans 5495a08fcd Merge 8.7 2020-10-30 15:31:03 +00:00
dgp 368b8b8f1a merge 8.7 2020-10-29 21:08:22 +00:00
dgp 28c73f41f9 merge 8.7 2020-10-27 21:39:50 +00:00
jan.nijtmans 2367af6c1c Merge 8.7.
Enhance "load", being able to handle '::' in package names
2020-10-27 14:30:18 +00:00
jan.nijtmans ec73c61c78 Merge 8.7. Rename more "Tcltest" package-names into "tcl::test". Not sufficient to make the win32 travis build work. 2020-10-24 14:34:41 +00:00
dgp bb49902ff0 merge 8.7 2020-10-23 14:55:26 +00:00
jan.nijtmans 7471f961af Merge 8.7. More lowercase package names in test-suite 2020-10-22 07:35:24 +00:00
dgp 32e96f3ee3 merge 8.7 2020-10-19 14:50:23 +00:00
jan.nijtmans e0c00410d7 Merge 8.7 2020-10-19 13:10:16 +00:00
jan.nijtmans aeec23e585 Merge 8.7 2020-10-18 20:27:55 +00:00
jan.nijtmans 9503c006cc Merge 8.7 2020-10-16 16:34:29 +00:00
jan.nijtmans b4b10c1471 Merge 8.7 2020-10-14 09:41:35 +00:00
jan.nijtmans 741a599b04 Merge 8.7 2020-10-14 06:28:53 +00:00
dgp 55adac3d9d merge 8.7 2020-10-13 16:44:54 +00:00
dgp 7f61e687b0 merge 8.7 2020-10-13 16:42:51 +00:00
jan.nijtmans 63b5fd2631 Merge 8.7 2020-10-12 10:45:30 +00:00
dgp 2f9f72e1e9 merge 8.7 2020-10-09 14:13:27 +00:00
dgp 7d2e339b74 merge 8.7 2020-10-07 15:48:41 +00:00
jan.nijtmans 764371ff33 Merge 8.7 2020-10-05 08:50:29 +00:00
dgp c4f2bab01d merge 8.7 2020-10-03 19:52:31 +00:00
jan.nijtmans 6b8eaaf322 Merge 8.7. Fix 2 failing test-cases 2020-10-02 15:49:47 +00:00
jan.nijtmans 70c1d3d8c1 Merge 8.7. Internal package renaming 2020-10-01 08:17:48 +00:00
dgp c9bc1b9fe8 merge 8.7 2020-09-30 16:01:20 +00:00
dgp 5993d3c28c merge 8.7 2020-09-30 14:45:25 +00:00
jan.nijtmans 9e49093832 Fix testcase 2020-09-29 13:11:08 +00:00
jan.nijtmans 05301b57c5 Merge 8.7 2020-09-29 12:51:24 +00:00
dgp 0a7fbe0b21 merge 8.7 2020-09-28 14:04:52 +00:00
jan.nijtmans 2ea6a13c20 Merge 8.7 2020-09-27 16:24:20 +00:00
dgp 3167360c90 merge 8.7 2020-09-21 14:11:24 +00:00
dgp 23fe5a2694 merge 8.7 2020-09-20 16:00:16 +00:00
dgp 45d8b68e73 merge 8.7 2020-09-19 17:19:51 +00:00
dgp eaa9bca383 merge 8.7 2020-09-17 17:54:54 +00:00
jan.nijtmans 24bf495502 Merge 8.7 2020-09-17 09:34:26 +00:00
dgp 42d6d980e6 merge 8.7 2020-09-16 15:29:11 +00:00
dgp 163d31e623 merge 8.7 2020-09-15 18:04:02 +00:00
jan.nijtmans 8bfbf94fa1 Merge 8.7 2020-09-15 15:12:43 +00:00
jan.nijtmans 7a2fe89a7e Merge 8.7 2020-07-07 14:46:19 +00:00
jan.nijtmans 698d338b0f Merge 8.7. Provide both major and minor version number for gcc/clang/msvc 2020-07-06 12:00:35 +00:00
jan.nijtmans 11f905cd0a Add compiler information (gcc|clang|msvc) information 2020-06-30 16:36:27 +00:00
jan.nijtmans ef76e3161e Add buildinfo functionality to makefile.vc too 2020-06-30 14:36:48 +00:00
jan.nijtmans 288a283617 WIP: Store build info in package 2020-06-29 20:20:10 +00:00
dgp e36bada6ec merge 8.7 2020-04-27 14:27:01 +00:00
dgp e4c15393cc merge 8.7 2020-04-14 16:30:11 +00:00
jan.nijtmans 605adef3f6 Merge 8.7 2020-04-08 19:15:11 +00:00
dgp 15c9b22d18 merge 8.7 2020-04-02 23:19:55 +00:00
dgp fc04583c23 merge 8.7 2020-04-01 20:28:14 +00:00
jan.nijtmans f0082ebb73 Remove variable "properByteArrayType" from tclTest.c, because it isn't used any more. 2020-04-01 13:40:27 +00:00
dgp 4c38de4663 merge 8.7 2020-04-01 12:06:40 +00:00
dgp 7d00b9576c merge 8.7 2020-03-31 16:05:15 +00:00
dgp 11db05f8dc merge 8.7 2020-03-28 19:44:20 +00:00
dgp 5162052bef merge 8.7 2020-03-28 16:38:07 +00:00
dgp dc086d03e3 merge 8.7 2020-03-27 16:33:10 +00:00
jan.nijtmans 2c800cb378 Merge 8.7 2020-03-22 21:41:28 +00:00
dgp a8e3213d43 TIP 568 proposes new public routine Tcl_GetBytesFromObj. 2020-03-18 21:03:06 +00:00
128 changed files with 2904 additions and 2203 deletions
-2
View File
@@ -42,8 +42,6 @@ jobs:
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
env:
CI_BUILD_WITH_MSVC: 1
gcc:
runs-on: windows-latest
defaults:
+176 -131
View File
@@ -8990,137 +8990,11 @@ in this changeset (new minor version) rather than bug fixes:
2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres)
2019-11-18 (bug)[13657a] application/json us text, not binary (noe,nijtmans)
=> http 2.9.1
- Released 8.6.10, Nov 21, 2019 - details at https://core.tcl-lang.org/tcl/ -
2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans)
2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres)
=> tcltest 2.5.2
2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans)
2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans)
2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk)
2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter)
2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedlička)
2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc)
2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres)
2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans)
2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres)
2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)
2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
=> registry 1.3.5
=> dde 1.4.3
2020-03-05 (new) Update to Unicode-13 (nijtmans)
2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans)
2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans)
2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp)
2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp)
See RFC 2045
*** POTENTIAL INCOMPATIBILITY ***
2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres)
2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp)
2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-13 (bug)[a7f685] test util-5.52 (dgp)
2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp)
2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres)
2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp)
2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp)
2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni)
2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner)
2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-06-02 (bug) prevent segfault in parser (sebres)
2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash)
=> http 2.9.2
2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash)
2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres)
2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres)
2020-07-16 (bug)[5bbd04] Fix index underflow (schwab)
2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash)
=> http 2.9.3
2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres)
2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans)
2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans)
=> opt 0.4.8
2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans)
2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans)
=> tcltest 2.5.3
2020-09-25 (new) force -eofchar \032 when evaluating library scripts (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans)
2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans)
2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans)
2020-10-26 (new)[48898a] improve error message consistency (stu)
*** POTENTIAL INCOMPATIBILITY ***
2020-11-06 (new) revised case of module names (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann)
2020-12-11 (new) support for msys2, Big Sur (nijtmans)
=> platform 1.0.15
2020-12-23 tzdata updated to Olson's tzdata2020e (jima)
- Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ -
Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:
@@ -9251,7 +9125,136 @@ in this changeset (new minor version) rather than bug fixes:
2019-09-14 [TIP 548] wchar_t conversion functions
- Released 8.7a3, Nov 21, 2019 --- http://core.tcl-lang.org/tcl/ for details -
- Released 8.7a3, Nov 21, 2019 --- https://core.tcl-lang.org/tcl/ for details -
2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans)
2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres)
=> tcltest 2.5.2
2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans)
2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans)
2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk)
2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter)
2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedlička)
2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc)
2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres)
2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans)
2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres)
2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)
2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
=> registry 1.3.5
=> dde 1.4.3
2020-03-05 (new) Update to Unicode-13 (nijtmans)
2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans)
2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans)
2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp)
2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp)
See RFC 2045
*** POTENTIAL INCOMPATIBILITY ***
2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres)
2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp)
2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp)
*** POTENTIAL INCOMPATIBILITY ***
2020-04-13 (bug)[a7f685] test util-5.52 (dgp)
2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp)
2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres)
2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp)
2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp)
2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni)
2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner)
2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-06-02 (bug) prevent segfault in parser (sebres)
2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash)
=> http 2.9.2
2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash)
2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres)
2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres)
*** POTENTIAL INCOMPATIBILITY ***
2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres)
2020-07-16 (bug)[5bbd04] Fix index underflow (schwab)
2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash)
=> http 2.9.3
2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres)
2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans)
2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans)
=> opt 0.4.8
2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans)
2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans)
=> tcltest 2.5.3
2020-09-25 (new) force -eofchar \032 when evaluating library scripts (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans)
2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans)
2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans)
2020-10-26 (new)[48898a] improve error message consistency (stu)
*** POTENTIAL INCOMPATIBILITY ***
2020-11-06 (new) revised case of module names (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann)
2020-12-11 (new) support for msys2, Big Sur (nijtmans)
=> platform 1.0.15
2020-12-23 tzdata updated to Olson's tzdata2020e (jima)
- Released 8.6.11, Dec 31, 2020 - details at https://core.tcl-lang.org/tcl/ -
Changes to 8.7a5 include all changes to the 8.6 line through 8.6.11,
plus the following, which focuses on the high-level feature changes
@@ -9329,4 +9332,46 @@ in this changeset (new minor version) rather than bug fixes:
2021-05-18 (bug)[688fcc,28027d] namespace teardown reform (coulter)
- Released 8.7a5, Jun 18, 2021 --- http://core.tcl-lang.org/tcl/ for details -
- Released 8.7a5, Jun 18, 2021 --- https://core.tcl-lang.org/tcl/ for details -
2021-02-02 (new) support for MacOS Big Sur updates (nijtmans)
=> platform 1.0.17
2021-02-15 (bug)[d43f96] [string trim*] broken for Emoji (werner)
2021-02-16 (bug)[22324b] [string reverse] broken for Emoji (werner)
2021-02-19 (bug)[1dab71,7c64aa] BRE broken by uninitialized value use (lane)
2021-03-09 (bug)[8419c5] Unix tty channels tolerate EINTR (nijtmans)
*** POTENTIAL INCOMPATIBILITY ***
2021-03-10 (bug)[4c591f] [string compare] EIAS violation (nijtmans)
2021-04-08 (new) dde package installation compatible with Tcl 9 (nijtmans)
=> dde 1.4.4
2021-04-14 (bug)[266494] [concat foo [list #]] EIAS violation (porter)
2021-05-03 (bug)[24b918] Save IO buffers from modern optimizers (rupprecht)
2021-05-06 (new) support for POSIX error EILSEQ (nijtmans)
2021-05-17 (bug)[688fcc] segfault during traced delete of alias (coulter)
2021-06-22 (bug)[bad6cc] More secure build tool. CVE-2021-35331 (nijtmans)
2021-07-17 (bug)[592a25] Win: segfault in Tcl_PutEnv() (danckaert,nijtmans)
2021-09-02 (bug)[ccc448] segfault in ensemble rewrite machinery (coulter)
2021-09-14 (new) Update to Unicode-14 (nijtmans)
2021-10-08 (bug)[a8579d] failed proc argument spec processing (russell,coulter)
2021-10-27 (new) support for MacOS Monterey (nijtmans)
=> platform 1.0.18
2021-10-27 tzdata updated to Olson's tzdata2021e (nijtmans)
- Released 8.6.12, Nov 5, 2021 - details at https://core.tcl-lang.org/tcl/ -
BIN
View File
Binary file not shown.
+144 -57
View File
@@ -8,83 +8,170 @@
.so man.macros
.BS
.SH NAME
Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes
Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetBytesFromObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate a Tcl value as an array of bytes
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewByteArrayObj\fR(\fIbytes, length\fR)
\fBTcl_NewByteArrayObj\fR(\fIbytes, numBytes\fR)
.sp
void
\fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, length\fR)
\fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, numBytes\fR)
.sp
.VS TIP568
unsigned char *
\fBTcl_GetBytesFromObj\fR(\fIinterp, objPtr, numBytesPtr\fR)
.VE TIP568
.sp
unsigned char *
\fBTcl_GetByteArrayFromObj\fR(\fIobjPtr, lengthPtr\fR)
\fBTcl_GetByteArrayFromObj\fR(\fIobjPtr, numBytesPtr\fR)
.sp
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR)
.SH ARGUMENTS
.AS "const unsigned char" *lengthPtr in/out
.AS "const unsigned char" *numBytesPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
even if \fIlength\fR is non-zero.
.AP int length in
The length of the array of bytes. It must be >= 0.
even if \fInumBytes\fR is non-zero.
.AP int numBytes in
The number of bytes in the array. It must be >= 0.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
byte-array type. For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value from which to get
the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
value, it will be converted to one.
.AP size_t | int *lengthPtr out
Filled with the length of the array of bytes in the value.
May be (int *)NULL when not used.
For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be
overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR,
\fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points
to the value from which to extract an array of bytes.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP "size_t | int" *numBytesPtr out
Points to space where the number of bytes in the array may be written.
Caller may pass NULL when it does not need this information.
.BE
.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl byte-array values
from C code. Byte-array values are typically used to hold the
results of binary IO operations or data structures created with the
\fBbinary\fR command. In Tcl, an array of bytes is not equivalent to a
string. Conceptually, a string is an array of Unicode characters, while a
byte-array is an array of 8-bit quantities with no implicit meaning.
Accessor functions are provided to get the string representation of a
byte-array or to convert an arbitrary value to a byte-array. Obtaining the
These routines are used to create, modify, store, transfer, and retrieve
arbitrary binary data in Tcl values. Specifically, data that can be
represented as a sequence of arbitrary byte values is supported.
This includes data read from binary channels, values created by the
\fBbinary\fR command, encrypted data, or other information representable as
a finite byte sequence.
.PP
A byte is an 8-bit quantity with no inherent meaning. When the 8 bits are
interpreted as an integer value, the range of possible values is (0-255).
The C type best suited to store a byte is the \fBunsigned char\fR.
An \fBunsigned char\fR array of size \fIN\fR stores an aribtrary binary
value of size \fIN\fR bytes. We call this representation a byte-array.
Here we document the routines that allow us to operate on Tcl values as
byte-arrays.
.PP
All Tcl values must correspond to a string representation.
When a byte-array value must be processed as a string, the sequence
of \fIN\fR bytes is transformed into the corresponding sequence
of \fIN\fR characters, where each byte value transforms to the same
character codepoint value in the range (U+0000 - U+00FF). Obtaining the
string representation of a byte-array value (by calling
\fBTcl_GetStringFromObj\fR) produces a properly formed UTF-8 sequence with a
one-to-one mapping between the bytes in the internal representation and the
UTF-8 characters in the string representation.
\fBTcl_GetStringFromObj\fR) produces this string in Tcl's usual
Modified UTF-8 encoding.
.PP
\fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR will
create a new value of byte-array type or modify an existing value to have a
byte-array type. Both of these procedures set the value's type to be
byte-array and set the value's internal representation to a copy of the
array of bytes given by \fIbytes\fR. \fBTcl_NewByteArrayObj\fR returns a
pointer to a newly allocated value with a reference count of zero.
\fBTcl_SetByteArrayObj\fR invalidates any old string representation and, if
the value is not already a byte-array value, frees any old internal
representation. If \fIbytes\fR is NULL then the new byte array contains
arbitrary values.
\fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR
create a new value or overwrite an existing unshared value, respectively,
to hold a byte-array value of \fInumBytes\fR bytes. When a caller
passes a non-NULL value of \fIbytes\fR, it must point to memory from
which \fInumBytes\fR bytes can be read. These routines
allocate \fInumBytes\fR bytes of memory, copy \fInumBytes\fR
bytes from \fIbytes\fR into it, and keep the result in the internal
representation of the new or overwritten value.
When the caller passes a NULL value of \fIbytes\fR, the data copying
step is skipped, and the bytes stored in the value are undefined.
A \fIbytes\fR value of NULL is useful only when the caller will arrange
to write known contents into the byte-array through a pointer retrieved
by a call to one of the routines explained below. \fBTcl_NewByteArrayObj\fR
returns a pointer to the created value with a reference count of zero.
\fBTcl_SetByteArrayObj\fR overwrites and invalidates any old contents
of the unshared \fIobjPtr\fR as appropriate, and keeps its reference
count (0 or 1) unchanged. The value produced by these routines has no
string representation. Any memory allocation failure may cause a panic.
Note that the type of the \fInumBytes\fR argument is \fBint\fR; consequently
the largest byte-array value that can be produced by these routines is one
holding \fBINT_MAX\fR bytes. Note also that the string representation of
any Tcl value is limited to \fBINT_MAX\fR bytes, so caution should be
taken with any byte-array of more than \fBINT_MAX / 2\fR bytes.
.PP
\fBTcl_GetByteArrayFromObj\fR converts a Tcl value to byte-array type and
returns a pointer to the value's new internal representation as an array of
bytes. The length of this array is stored in \fIlengthPtr\fR if
\fIlengthPtr\fR is non-NULL. The storage for the array of bytes is owned by
the value and should not be freed. The contents of the array may be
modified by the caller only if the value is not shared and the caller
invalidates the string representation.
\fBTcl_GetBytesFromObj\fR performs the opposite function of
\fBTcl_SetByteArrayObj\fR, providing access to read a byte-array from
a Tcl value that was previously written into it. When \fIobjPtr\fR
is a value previously produced by \fBTcl_NewByteArrayObj\fR or
\fBTcl_SetByteArrayObj\fR, then \fBTcl_GetBytesFromObj\fR returns
a pointer to the byte-array kept in the value's internal representation.
If the caller provides a non-NULL value for \fInumBytesPtr\fR, it must
point to memory where \fBTcl_GetBytesFromObj\fR can write the number
of bytes in the value's internal byte-array. With both pieces of
information, the caller is able to retrieve any information about the
contents of that byte-array that it seeks. When \fIobjPtr\fR does
not already contain an internal byte-array, \fBTcl_GetBytesFromObj\fR
will try to create one from the value's string representation. Any
string value that does not include any character codepoints outside
the range (U+0000 - U+00FF) will successfully translate to a unique
byte-array value. With the created byte-array, the routine returns
as before. For any string representation which does contain
a forbidden character codepoint, the conversion fails, and
\fBTcl_GetBytesFromObj\fR returns NULL to signal that failure. On
failure, nothing will be written to \fInumBytesPtr\fR, and if
the \fIinterp\fR argument is non-NULL, then error messages and
codes are left in it recording the error.
.PP
\fBTcl_SetByteArrayLength\fR converts the Tcl value to byte-array type
and changes the length of the value's internal representation as an
array of bytes. If \fIlength\fR is greater than the space currently
allocated for the array, the array is reallocated to the new length; the
newly allocated bytes at the end of the array have arbitrary values. If
\fIlength\fR is less than the space currently allocated for the array,
the length of array is reduced to the new length. The return value is a
pointer to the value's new array of bytes.
\fBTcl_GetByteArrayFromObj\fR performs nearly the same function as
\fBTcl_GetBytesFromObj\fR. They differ only in the circumstance when
a byte-array internal value must be created by transformation of
a string representation, and that string representation contains a
character with codepoint greater than U+00FF. Instead of failing
the conversion, \fBTcl_GetByteArrayFromObj\fR will use the 8 least
significant bits of each codepoint to produce a valid byte value
from any character codepoint value. In any other circumstance,
\fBTcl_GetByteArrayFromObj\fR performs just as \fBTcl_GetBytesFromObj\fR
does. Since the conversion cannot fail, \fBTcl_GetByteArrayFromObj\fR
has no need for an \fIinterp\fR argument to record any errors and
the caller can assume \fBTcl_GetByteArrayFromObj\fR does not return NULL.
.PP
\fBTcl_GetByteArrayFromObj\fR must be used with caution. Because of the
truncation on conversion, the byte-array made available to the caller
cannot reliably complete a round-trip back to the original string
representation. This creates opportunities for bugs due to blindness
to differences in values. This routine exists in this form primarily
for compatibility with codebases written for earlier releases of Tcl.
It is expected this routine will incompatibly change in Tcl 9 so that
it also signals failed conversions with a NULL return.
.PP
On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR
return a pointer into the internal representation of a \fBTcl_Obj\fR.
That pointer must not be freed by the caller, and should not be retained
for use beyond the known time the internal representation of the value
has not been disturbed. The pointer may be used to overwrite the byte
contents of the internal representation, so long as the value is unshared
and any string representation is invalidated.
.PP
On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR
write the number of bytes in the byte-array value of \fIobjPtr\fR
to the space pointed to by \fInumBytesPtr\fR. This space may be of type
\fBsize_t\fR or of type \fBint\fR. In Tcl 8, the largest number of
bytes possible is \fBINT_MAX\fR, so either type can receive the value.
In codebases meant to migrate to Tcl 9, the option to write to a space
of type \fBsize_t\fR may aid in the migration.
.PP
\fBTcl_SetByteArrayLength\fR enables a caller to change the size of a
byte-array in the internal representation of an unshared \fIobjPtr\fR to
become \fInumBytes\fR bytes. This is most often useful after the
bytes of the internal byte-array have been directly overwritten and it
has been discovered that the required size differs from the first
estimate used in the allocation. \fBTcl_SetByteArrayLength\fR returns
a pointer to the resized byte-array. Because resizing the byte-array
changes the internal representation, \fBTcl_SetByteArrayLength\fR
also invalidates any string representation in \fIobjPtr\fR. If resizing
grows the byte-array, the new byte values are undefined. If \fIobjPtr\fR
does not already possess an internal byte-array, one is produced in the
same way that \fBTcl_GetByteArrayFromObj\fR does, with all the cautions
that go along with that.
.SH "REFERENCE COUNT MANAGEMENT"
.PP
\fBTcl_NewByteArrayObj\fR always returns a zero-reference object, much
@@ -94,11 +181,11 @@ like \fBTcl_NewObj\fR.
reference count of their \fIobjPtr\fR arguments, but do require that the
object be unshared.
.PP
\fBTcl_GetByteArrayFromObj\fR does not modify the reference count of its
\fIobjPtr\fR argument; it only reads.
\fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR do not modify
the reference count of \fIobjPtr\fR; they only read.
.SH "SEE ALSO"
Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount
.SH KEYWORDS
value, binary data, byte array, utf, unicode, internationalization
value, binary data, byte array, utf, unicode
+4 -1
View File
@@ -13,7 +13,7 @@ Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of th
.nf
\fB#include <tcl.h>\fR
.sp
void
const char *
\fBTcl_FindExecutable\fR(\fIargv0\fR)
.sp
const char *
@@ -35,6 +35,9 @@ Tcl. For example, it is needed on some platforms in the
implementation of the \fBload\fR command.
It is also returned by the \fBinfo nameofexecutable\fR command.
.PP
The result of \fBTcl_FindExecutable\fR is the full Tcl version (e.g.,
\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
.PP
On UNIX platforms this procedure is typically invoked as the very
first thing in the application's main program; it must be passed
\fIargv[0]\fR as its argument. It is important not to change the
+5 -2
View File
@@ -13,7 +13,7 @@ Tcl_InitSubsystems \- initialize the Tcl library.
.nf
\fB#include <tcl.h>\fR
.sp
void
const char *
\fBTcl_InitSubsystems\fR(\fIvoid\fR)
.SH DESCRIPTION
.PP
@@ -21,10 +21,13 @@ The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
library. This procedure is typically invoked as the very
first thing in the application's main program.
.PP
The result of \fBTcl_InitSubsystems\fR is the full Tcl version (e.g.,
\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
.PP
\fBTcl_InitSubsystems\fR is very similar in use to
\fBTcl_FindExecutable\fR. It can be used when Tcl is
used as utility library, no other encodings than utf8,
iso8859-1 or unicode are used, and no interest exists in the
iso8859-1 or utf-16 are used, and no interest exists in the
value of \fBinfo nameofexecutable\fR. The system encoding will not
be extracted from the environment, but falls back to iso8859-1.
.SH KEYWORDS
+3 -3
View File
@@ -28,7 +28,7 @@ int
\fBTcl_ListObjGetElements\fR(\fIinterp, listPtr, objcPtr, objvPtr\fR)
.sp
int
\fBTcl_ListObjLength\fR(\fIinterp, listPtr, intPtr\fR)
\fBTcl_ListObjLength\fR(\fIinterp, listPtr, lengthPtr\fR)
.sp
int
\fBTcl_ListObjIndex\fR(\fIinterp, listPtr, index, objPtrPtr\fR)
@@ -76,7 +76,7 @@ An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
Each value will become a separate list element.
.AP int *intPtr out
.AP int *lengthPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
.AP int index in
@@ -162,7 +162,7 @@ Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer.
.PP
\fBTcl_ListObjLength\fR returns the number of elements in the list value
referenced by \fIlistPtr\fR.
It returns this count by storing an integer in the address \fIintPtr\fR.
It returns this count by storing an integer in the address \fIlengthPtr\fR.
If the value is not already a list value,
\fBTcl_ListObjLength\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
+4 -1
View File
@@ -18,7 +18,7 @@ void
void
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
const char *
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
@@ -82,6 +82,9 @@ making calls into the Tcl library, or into other libraries that may
call the Tcl library, since the original call to \fBTcl_Panic\fR
indicates the Tcl library is not in a state of reliable operation.
.PP
The result of \fBTcl_SetPanicProc\fR is the full Tcl version (e.g.,
\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
application or the platform.
+5 -3
View File
@@ -111,15 +111,17 @@ If negative, all characters up to the first null character are used.
The index of the Unicode character to return.
.AP int first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
returned as a new value. If negative, behave the same as if the
value was 0.
.AP int last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
returned as a new value. If negative, take all characters up to
the last one available.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP size_t | int *lengthPtr out
.AP int *lengthPtr out
The location where \fBTcl_GetStringFromObj\fR will store the length
of a value's string representation. May be (int *)NULL when not used.
.AP "const char" *string in
+3 -1
View File
@@ -81,7 +81,9 @@ RFC 2045 calls for base64 decoders to be non-strict.
\fBhex\fR
.
The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal
digits in big-endian form.
digits that represent the byte value as a hexadecimal integer.
When encoding, lower characters are used.
When decoding, upper and lower characters are accepted.
.RS
.PP
No options are supported during encoding. During decoding, the following
+420 -594
View File
File diff suppressed because it is too large Load Diff
+71 -70
View File
@@ -17,7 +17,7 @@ expr \- Evaluate an expression
.BE
.SH DESCRIPTION
.PP
The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions. For those operators
@@ -37,45 +37,88 @@ operands are specified. Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
When the result of expression is an integer, it is in decimal form, and when
the result is a floating-point number, it is in the form produced by the
\fB%g\fR format specifier of \fBformat\fR.
.PP
.VS "TIP 582"
You can use \fB#\fR at any point in the expression (except inside double
quotes or braces) to start a comment. Comments last to the end of the line or
At any point in the expression except within double quotes or braces, \fB#\fR
is the beginning of a comment, which lasts to the end of the line or
the end of the expression, whichever comes first.
.VE "TIP 582"
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
ignored. Each operand is intepreted as a numeric value if at all possible.
.PP
An operand may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
Each operand has one of the following forms:
.RS
.PP
.TP
A \fBnumeric value\fR
.PP
.RS
.
Either integer or floating-point. The first two characters of an integer may
also be \fB0d\fR for decimal, \fB0b\fR for binary, \fB0o\fR for octal or
\fB0x\fR for hexadicimal. For compatibility with older Tcl releases, an
operand that begins with \fB0\fR is interpreted as an octal integer even if the
second character is not \fBo\fR.
.PP
A floating-point number may be take any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR. The
following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values. An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
Digits in any numeric value may be separated with one or more underscore
characters, "\fB_\fR". A separator may only
appear between digits, not appear at the start of a
numeric value, between the leading 0 and radix specifier, or at the
end of a numeric value. Here are some examples:
.PP
.CS
.ta 9c
\fBexpr\fR 100_000_000 \fI100000000\fR
\fBexpr\fR 0xffff_ffff \fI4294967295\fR
\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR
.CE
.RE
.TP
A \fBboolean value\fR
.
Using any form understood by \fBstring is\fR
\fBboolean\fR.
.IP [3]
As a variable, using standard \fB$\fR notation.
The value of the variable is then the value of the operand.
.IP [4]
As a string enclosed in double-quotes.
Backslash, variable, and command substitution are performed as described in
.TP
A \fBvariable\fR
.
Using standard \fB$\fR notation.
The value of the variable is the value of the operand.
.TP
A string enclosed in \fBdouble-quotes\fR
.
Backslash, variable, and command substitution are performed according to the
rules for \fBTcl\fR.
.TP
A string enclosed in \fBbraces\fR.
The operand is treated as a braced value according to the rule for braces in
\fBTcl\fR.
.IP [5]
As a string enclosed in braces.
The operand is treated as a braced value as described in \fBTcl\fR.
.IP [6]
As a Tcl command enclosed in brackets.
Command substitution is performed as described in \fBTcl\fR.
.IP [7]
As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
.TP
A Tcl command enclosed in \fBbrackets\fR
.
Command substitution is performed as according to the command substitution rule
for \fBTcl\fR.
.TP
A mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
forms for operands. See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.RE
.PP
Because \fBexpr\fR parses and performs substitutions on values that have
already been parsed and substituted by \fBTcl\fR, it is usually best to enclose
@@ -90,52 +133,10 @@ produces the value on the right side.
.ta 9c
\fBexpr\fR {3.1 + $a} \fI6.1\fR
\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR
\fBexpr\fR {4*[llength "6 2"]} \fI8\fR
\fBexpr\fR {4*[llength {6 2}]} \fI8\fR
\fBexpr\fR {{word one} < "word $a"} \fI0\fR
.CE
.PP
\fBInteger value\fR
.PP
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form. For
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
.PP
\fBFloating-point value\fR
.PP
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR. The
following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values. An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
\fBBoolean value\fR
.PP
A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR,
or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR.
.PP
\fBDigit Separator\fR
.PP
Digits in any numeric value may be separated with one or more underscore
characters, "\fB_\fR", to improve readability. These separators may only
appear between digits. The separator may not appear at the start of a
numeric value, between the leading 0 and radix specifier, or at the
end of a numeric value. Here are some examples:
.PP
.CS
.ta 9c
\fBexpr\fR 100_000_000 \fI100000000\fR
\fBexpr\fR 0xffff_ffff \fI4294967295\fR
\fBformat\fR 0x%x 0b1111_1110_1101_1011 \fI0xfedb\fR
.CE
.PP
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
+1 -1
View File
@@ -87,7 +87,7 @@ Handle different reasons for a file to not be openable for reading:
.PP
.CS
\fBtry\fR {
set f [open /some/file/name w]
set f [open /some/file/name r]
} \fBtrap\fR {POSIX EISDIR} {} {
puts "failed to open /some/file/name: it's a directory"
} \fBtrap\fR {POSIX ENOENT} {} {
+6 -6
View File
@@ -13,7 +13,7 @@
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
int
const char *
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
@@ -87,11 +87,11 @@ it uses WCHAR instead 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
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.
The result of \fBTclZipfs_AppHook\fR is the full Tcl version (e.g.,
\fB8.7.0+abcdef...abcdef.gcc-1002.utf16\fR).
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 mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
+22 -12
View File
@@ -108,7 +108,7 @@ declare 22 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
declare 23 {
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int numBytes,
const char *file, int line)
}
declare 24 {
@@ -143,7 +143,7 @@ declare 32 {
int *boolPtr)
}
declare 33 {
unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
}
declare 34 {
int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
@@ -202,7 +202,7 @@ declare 49 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 {
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int numBytes)
}
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
@@ -226,11 +226,11 @@ declare 57 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 {
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes)
}
declare 59 {
void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
int length)
int numBytes)
}
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
@@ -514,7 +514,7 @@ declare 143 {
void Tcl_Finalize(void)
}
declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_FindExecutable(const char *argv0)
const char *Tcl_FindExecutable(const char *argv0)
}
declare 145 {
Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
@@ -813,7 +813,7 @@ declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
@@ -2402,6 +2402,16 @@ declare 648 {
int length, Tcl_DString *dsPtr)
}
# TIP #568
declare 649 {
unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *numBytesPtr)
}
declare 650 {
unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
size_t *numBytesPtr)
}
# TIP #481
declare 651 {
char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
@@ -2410,7 +2420,7 @@ declare 652 {
Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
}
# TIP #575
@@ -2493,13 +2503,13 @@ export {
Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
}
export {
void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
const char *Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
void Tcl_FindExecutable(const char *argv0)
const char *Tcl_FindExecutable(const char *argv0)
}
export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
@@ -2517,10 +2527,10 @@ export {
void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
}
export {
void Tcl_InitSubsystems(void)
const char *Tcl_InitSubsystems(void)
}
export {
int TclZipfs_AppHook(int *argc, char ***argv)
const char *TclZipfs_AppHook(int *argc, char ***argv)
}
# Local Variables:
+3 -3
View File
@@ -2383,16 +2383,16 @@ EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
EXTERN void Tcl_InitSubsystems(void);
EXTERN const char * Tcl_InitSubsystems(void);
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN const char * Tcl_SetPreInitScript(const char *string);
#ifndef TCL_NO_DEPRECATED
# define Tcl_StaticPackage Tcl_StaticLibrary
#endif
#ifdef _WIN32
EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv);
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
/*
+1 -1
View File
@@ -1985,7 +1985,7 @@ CreateMirrorJumpTable(
* table. */
int i;
if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
return TCL_ERROR;
}
if (objc % 2 != 0) {
+118 -11
View File
@@ -604,6 +604,108 @@ TclFinalizeEvaluation(void)
Tcl_MutexUnlock(&commandTypeLock);
}
/*
*----------------------------------------------------------------------
*
* buildInfoObjCmd --
*
* Implements tcl::build-info command.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
buildInfoObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?option?");
return TCL_ERROR;
}
if (objc == 2) {
int len;
const char *arg = TclGetStringFromObj(objv[1], &len);
if (len == 7 && !strcmp(arg, "version")) {
char buf[80];
const char *p = strchr((char *)clientData, '.');
if (p) {
const char *q = strchr(p+1, '.');
const char *r = strchr(p+1, '+');
p = (q < r) ? q : r;
}
if (p) {
memcpy(buf, (char *)clientData, p - (char *)clientData);
buf[p - (char *)clientData] = '\0';
Tcl_AppendResult(interp, buf, NULL);
}
return TCL_OK;
} else if (len == 10 && !strcmp(arg, "patchlevel")) {
char buf[80];
const char *p = strchr((char *)clientData, '+');
if (p) {
memcpy(buf, (char *)clientData, p - (char *)clientData);
buf[p - (char *)clientData] = '\0';
Tcl_AppendResult(interp, buf, NULL);
}
return TCL_OK;
} else if (len == 6 && !strcmp(arg, "commit")) {
const char *q, *p = strchr((char *)clientData, '+');
if (p) {
if ((q = strchr(p, '.'))) {
char buf[80];
memcpy(buf, p+1, q - p - 1);
buf[q - p - 1] = '\0';
Tcl_AppendResult(interp, buf, NULL);
} else {
Tcl_AppendResult(interp, p+1, NULL);
}
}
return TCL_OK;
} else if (len == 8 && !strcmp(arg, "compiler")) {
const char *p = strchr((char *)clientData, '.');
while (p) {
if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4)
|| !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) {
const char *q = strchr(p+1, '.');
if (q) {
char buf[16];
memcpy(buf, p+1, q - p - 1);
buf[q - p - 1] = '\0';
Tcl_AppendResult(interp, buf, NULL);
} else {
Tcl_AppendResult(interp, p+1, NULL);
}
return TCL_OK;
}
p = strchr(p+1, '.');
}
Tcl_AppendResult(interp, "0", NULL);
return TCL_OK;
}
const char *p = strchr((char *)clientData, '.');
while (p) {
if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) {
Tcl_AppendResult(interp, "1", NULL);
return TCL_OK;
}
p = strchr(p+1, '.');
}
Tcl_AppendResult(interp, "0", NULL);
return TCL_OK;
}
Tcl_AppendResult(interp, (char *)clientData, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -644,8 +746,7 @@ Tcl_CreateInterp(void)
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
CallFrame *framePtr;
Tcl_InitSubsystems();
const char *version = Tcl_InitSubsystems();
/*
* Panic if someone updated the CallFrame structure without also updating
@@ -1162,7 +1263,7 @@ Tcl_CreateInterp(void)
#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
#if TCL_THREADS
#if TCL_THREADS && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
@@ -1176,10 +1277,14 @@ Tcl_CreateInterp(void)
/*
* Register Tcl's version number.
* TIP #268: Full patchlevel instead of just major.minor
* TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
Tcl_CreateObjCommand(interp, "::tcl::build-info",
buildInfoObjCmd, (void *)version, NULL);
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
@@ -3896,7 +4001,9 @@ Tcl_CreateMathFunc(
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
if ((numArgs > 0) && (argTypes != NULL)) {
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
}
data->clientData = clientData;
Tcl_DStringInit(&bigName);
@@ -5072,7 +5179,7 @@ TEOV_NotFound(
* itself.
*/
Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
&handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
@@ -5681,7 +5788,7 @@ TclEvalEx(
int numElements;
Tcl_Obj **elements, *temp = copy[wordIdx];
Tcl_ListObjGetElements(NULL, temp, &numElements,
TclListObjGetElements(NULL, temp, &numElements,
&elements);
objectsUsed += numElements;
while (numElements--) {
@@ -8194,15 +8301,15 @@ ExprRandFunc(
* take into consideration the thread this interp is running in.
*/
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U;
/*
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
*/
iPtr->randSeed &= 0x7FFFFFFF;
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) {
iPtr->randSeed ^= 123459876;
iPtr->randSeed &= 0x7FFFFFFFL;
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFFL)) {
iPtr->randSeed ^= 123459876L;
}
}
@@ -9290,7 +9397,7 @@ TclNRTailcallEval(
int objc;
Tcl_Obj **objv;
Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
TclListObjGetElements(interp, listPtr, &objc, &objv);
nsObjPtr = objv[0];
if (result == TCL_OK) {
+139 -133
View File
@@ -2,7 +2,7 @@
* tclBinary.c --
*
* This file contains the implementation of the "binary" Tcl built-in
* command and the Tcl binary data object.
* command and the Tcl value internal representation for binary data.
*
* Copyright © 1997 Sun Microsystems, Inc.
* Copyright © 1998-1999 Scriptics Corporation.
@@ -73,33 +73,17 @@ static void UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int NeedReversing(int format);
static void CopyNumber(const void *from, void *to,
unsigned length, int type);
unsigned int length, int type);
/* Binary ensemble commands */
static int BinaryFormatCmd(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int BinaryScanCmd(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc BinaryFormatCmd;
static Tcl_ObjCmdProc BinaryScanCmd;
/* Binary encoding sub-ensemble commands */
static int BinaryEncodeHex(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int BinaryDecodeHex(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int BinaryEncode64(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int BinaryDecode64(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int BinaryEncodeUu(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int BinaryDecodeUu(ClientData clientData,
Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc BinaryEncodeHex;
static Tcl_ObjCmdProc BinaryDecodeHex;
static Tcl_ObjCmdProc BinaryEncode64;
static Tcl_ObjCmdProc BinaryDecode64;
static Tcl_ObjCmdProc BinaryEncodeUu;
static Tcl_ObjCmdProc BinaryDecodeUu;
/*
* The following tables are used by the binary encoders
@@ -165,12 +149,11 @@ static const EnsembleImplMap decodeMap[] = {
* images to name just two.
*
* It's strange to have two Tcl_ObjTypes in place for this task when one would
* do, so a bit of detail and history how we got to this point and where we
* might go from here.
* do, so a bit of detail and history will aid understanding.
*
* A bytearray is an ordered sequence of bytes. Each byte is an integer value
* in the range [0-255]. To be a Tcl value type, we need a way to encode each
* value in the value set as a Tcl string. The simplest encoding is to
* value in the value set as a Tcl string. A simple encoding is to
* represent each byte value as the same codepoint value. A bytearray of N
* bytes is encoded into a Tcl string of N characters where the codepoint of
* each character is the value of corresponding byte. This approach creates a
@@ -181,9 +164,7 @@ static const EnsembleImplMap decodeMap[] = {
* question arises what to do with strings outside that subset? That is,
* those Tcl strings containing at least one codepoint greater than 255? The
* obviously correct answer is to raise an error! That string value does not
* represent any valid bytearray value. Full Stop. The setFromAnyProc
* signature has a completion code return value for just this reason, to
* reject invalid inputs.
* represent any valid bytearray value.
*
* Unfortunately this was not the path taken by the authors of the original
* tclByteArrayType. They chose to accept all Tcl string values as acceptable
@@ -191,33 +172,10 @@ static const EnsembleImplMap decodeMap[] = {
* high bits of any codepoint value at all. This meant that every bytearray
* value had multiple accepted string representations.
*
* The implications of this choice are truly ugly. When a Tcl value has a
* string representation, we are required to accept that as the true value.
* Bytearray values that possess a string representation cannot be processed
* as bytearrays because we cannot know which true value that bytearray
* represents. The consequence is that we drag around an internal rep that we
* cannot make any use of. This painful price is extracted at any point after
* a string rep happens to be generated for the value. This happens even when
* the troublesome codepoints outside the byte range never show up. This
* happens rather routinely in normal Tcl operations unless we burden the
* script writer with the cognitive burden of avoiding it. The price is also
* paid by callers of the C interface. The routine
*
* unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
*
* has a guarantee to always return a non-NULL value, but that value points to
* a byte sequence that cannot be used by the caller to process the Tcl value
* absent some sideband testing that objPtr is "pure". Tcl offers no public
* interface to perform this test, so callers either break encapsulation or
* are unavoidably buggy. Tcl has defined a public interface that cannot be
* used correctly. The Tcl source code itself suffers the same problem, and
* has been buggy, but progressively less so as more and more portions of the
* code have been retrofitted with the required "purity testing". The set of
* values able to pass the purity test can be increased via the introduction
* of a "canonical" flag marker, but the only way the broken interface itself
* can be discarded is to start over and define the Tcl_ObjType properly.
* Bytearrays should simply be usable as bytearrays without a kabuki dance of
* testing.
* The implications of this choice are truly ugly, and motivated the proposal
* of TIP 568 to migrate away from it and to the more sensible design where
* each bytearray value has only one string representation. Full details are
* recorded in that TIP for those who seek them.
*
* The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation
* of bytearrays. Any Tcl value with the type properByteArrayType can have
@@ -226,21 +184,24 @@ static const EnsembleImplMap decodeMap[] = {
* implies a side testing burden -- past mistakes will not let us avoid that
* immediately, but it is at least a conventional test of type, and can be
* implemented entirely by examining the objPtr fields, with no need to query
* the internalrep, as a canonical flag would require.
* the internalrep, as a canonical flag would require. This benefit is made
* available to extensions through the public routine Tcl_GetBytesFromObj(),
* first available in Tcl 8.7.
*
* Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised
* to admit the possibility of returning NULL when the true value is not a
* valid bytearray, we need a mechanism to retain compatibility with the
* deployed callers of the broken interface. That's what the retained
* "tclByteArrayType" provides. In those unusual circumstances where we
* convert an invalid bytearray value to a bytearray type, it is to this
* legacy type. Essentially any time this legacy type gets used, it's a
* signal of a bug being ignored. A TIP should be drafted to remove this
* connection to the broken past so that Tcl 9 will no longer have any trace
* of it. Prescribing a migration path will be the key element of that work.
* The internal changes now in place are the limit of what can be done short
* of interface repair. They provide a great expansion of the histories over
* which bytearray values can be useful in the meanwhile.
* The public routines Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength()
* must continue to follow their documented behavior through the 8.* series of
* releases. To support that legacy operation, we need a mechanism to retain
* compatibility with the deployed callers of the broken interface. That's
* what the retained "tclByteArrayType" provides. In those unusual
* circumstances where we convert an invalid bytearray value to a bytearray
* type, it is to this legacy type. Essentially any time this legacy type
* shows up, it's a signal of a bug being ignored.
*
* In Tcl 9, the incompatibility in the behavior of these public routines
* has been approved, and the legacy internal rep is no longer retained.
* The internal changes seen below are the limit of what can be done
* in a Tcl 8.* release. They provide a great expansion of the histories
* over which bytearray values can be useful.
*/
static const Tcl_ObjType properByteArrayType = {
@@ -267,15 +228,16 @@ const Tcl_ObjType tclByteArrayType = {
*/
typedef struct ByteArray {
unsigned int bad; /* Index of the character that is a nonbyte.
* If all characters are bytes, bad = used,
* though then we should never read it. */
unsigned int bad; /* Index of first character that is a nonbyte.
* If all characters are bytes, bad = used. */
unsigned int used; /* The number of bytes used in the byte
* array. */
unsigned int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
* array. Must be <= allocated. The bytes
* used to store the value are indexed from
* 0 to used-1. */
unsigned int allocated; /* The number of bytes of space allocated. */
unsigned char bytes[TCLFLEXARRAY];
/* The array of bytes. The actual size of this
* field is stored in the 'allocated' field
* above. */
} ByteArray;
@@ -301,7 +263,7 @@ TclIsPureByteArray(
* from the given array of bytes.
*
* Results:
* The newly create object is returned. This object will have no initial
* The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
@@ -316,16 +278,16 @@ Tcl_Obj *
Tcl_NewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int length) /* Length of the array of bytes, which must be
* >= 0. */
int numBytes) /* Number of bytes in the array,
* must be >= 0. */
{
#ifdef TCL_MEM_DEBUG
return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetByteArrayObj(objPtr, bytes, length);
Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
#endif /* TCL_MEM_DEBUG */
}
@@ -346,7 +308,7 @@ Tcl_NewByteArrayObj(
* result of calling Tcl_NewByteArrayObj.
*
* Results:
* The newly create object is returned. This object will have no initial
* The newly created object is returned. This object has no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
@@ -360,8 +322,8 @@ Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int length, /* Length of the array of bytes, which must be
* >= 0. */
int numBytes, /* Number of bytes in the array,
* must be >= 0. */
const char *file, /* The name of the source file calling this
* procedure; used for debugging. */
int line) /* Line number in the source file; used for
@@ -370,7 +332,7 @@ Tcl_DbNewByteArrayObj(
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetByteArrayObj(objPtr, bytes, length);
Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
@@ -378,12 +340,12 @@ Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
int length, /* Length of the array of bytes, which must be
* >= 0. */
int numBytes, /* Number of bytes in the array,
* must be >= 0. */
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return Tcl_NewByteArrayObj(bytes, length);
return Tcl_NewByteArrayObj(bytes, numBytes);
}
#endif /* TCL_MEM_DEBUG */
@@ -409,9 +371,9 @@ void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
* May be NULL even if length > 0. */
int length) /* Length of the array of bytes, which must
* be >= 0. */
* May be NULL even if numBytes > 0. */
int numBytes) /* Number of bytes in the array,
* must be >= 0. */
{
ByteArray *byteArrayPtr;
Tcl_ObjInternalRep ir;
@@ -421,16 +383,14 @@ Tcl_SetByteArrayObj(
}
TclInvalidateStringRep(objPtr);
if (length < 0) {
length = 0;
}
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr->bad = length;
byteArrayPtr->used = length;
byteArrayPtr->allocated = length;
assert(numBytes >= 0);
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(numBytes));
byteArrayPtr->bad = numBytes;
byteArrayPtr->used = numBytes;
byteArrayPtr->allocated = numBytes;
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, length);
if ((bytes != NULL) && (numBytes > 0)) {
memcpy(byteArrayPtr->bytes, bytes, numBytes);
}
SET_BYTEARRAY(&ir, byteArrayPtr);
@@ -440,16 +400,16 @@ Tcl_SetByteArrayObj(
/*
*----------------------------------------------------------------------
*
* TclGetBytesFromObj --
* Tcl_GetBytesFromObj/TclGetBytesFromObj --
*
* Attempt to extract the value from objPtr in the representation
* of a byte sequence. On success return the extracted byte sequence.
* On failures, return NULL and record error message and code in
* On failure, return NULL and record error message and code in
* interp (if not NULL).
*
* Results:
* Pointer to array of bytes, or NULL. representing the ByteArray object.
* Writes number of bytes in array to *lengthPtr.
* NULL or pointer to array of bytes representing the ByteArray object.
* Writes number of bytes in array to *numBytesPtr.
*
*----------------------------------------------------------------------
*/
@@ -458,8 +418,8 @@ unsigned char *
TclGetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
Tcl_Obj *objPtr, /* Value to extract from */
int *lengthPtr) /* If non-NULL, filled with length of the
* array of bytes in the ByteArray object. */
int *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
@@ -487,8 +447,47 @@ TclGetBytesFromObj(
}
baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
#undef Tcl_GetBytesFromObj
unsigned char *
Tcl_GetBytesFromObj(
Tcl_Interp *interp, /* For error reporting */
Tcl_Obj *objPtr, /* Value to extract from */
size_t *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
SetByteArrayFromAny(NULL, objPtr);
irPtr = TclFetchInternalRep(objPtr, &properByteArrayType);
if (irPtr == NULL) {
if (interp) {
const char *nonbyte;
int ucs4;
irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
baPtr = GET_BYTEARRAY(irPtr);
nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
TclUtfToUCS4(nonbyte, &ucs4);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected byte sequence but character %d "
"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
}
return NULL;
}
}
baPtr = GET_BYTEARRAY(irPtr);
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return baPtr->bytes;
}
@@ -515,12 +514,12 @@ TclGetBytesFromObj(
unsigned char *
Tcl_GetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
int *lengthPtr) /* If non-NULL, filled with length of the
* array of bytes in the ByteArray object. */
int *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr;
unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr);
unsigned char *result = TclGetBytesFromObj(NULL, objPtr, numBytesPtr);
if (result) {
return result;
@@ -531,8 +530,8 @@ Tcl_GetByteArrayFromObj(
baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
if (numBytesPtr != NULL) {
*numBytesPtr = baPtr->used;
}
return (unsigned char *) baPtr->bytes;
}
@@ -540,12 +539,12 @@ Tcl_GetByteArrayFromObj(
unsigned char *
TclGetByteArrayFromObj(
Tcl_Obj *objPtr, /* The ByteArray object. */
size_t *lengthPtr) /* If non-NULL, filled with length of the
* array of bytes in the ByteArray object. */
size_t *numBytesPtr) /* If non-NULL, write the number of bytes
* in the array here */
{
ByteArray *baPtr;
const Tcl_ObjInternalRep *irPtr;
unsigned char *result = TclGetBytesFromObj(NULL, objPtr, (int *)NULL);
unsigned char *result = Tcl_GetBytesFromObj(NULL, objPtr, numBytesPtr);
if (result) {
return result;
@@ -556,11 +555,12 @@ TclGetByteArrayFromObj(
baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
if (numBytesPtr != NULL) {
#if TCL_MAJOR_VERSION > 8
*lengthPtr = baPtr->used;
*numBytesPtr = baPtr->used;
#else
*lengthPtr = ((size_t)(unsigned)(baPtr->used + 1)) - 1;
/* TODO: What's going on here? Document or eliminate. */
*numBytesPtr = ((size_t)(unsigned int)(baPtr->used + 1)) - 1;
#endif
}
return baPtr->bytes;
@@ -591,14 +591,14 @@ TclGetByteArrayFromObj(
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
int length) /* New length for internal byte array. */
int numBytes) /* Number of bytes in resized array */
{
ByteArray *byteArrayPtr;
unsigned newLength;
Tcl_ObjInternalRep *irPtr;
assert(length >= 0);
newLength = (unsigned int)length;
assert(numBytes >= 0);
newLength = (unsigned int)numBytes;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
@@ -616,6 +616,9 @@ Tcl_SetByteArrayLength(
}
}
/* Note that during truncation, the implementation does not free
* memory that is no longer needed. */
byteArrayPtr = GET_BYTEARRAY(irPtr);
if (newLength > byteArrayPtr->allocated) {
byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
@@ -668,6 +671,9 @@ SetByteArrayFromAny(
length = bad = objPtr->length;
srcEnd = src + length;
/* Note the allocation is over-sized, possibly by a factor of four,
* or even a factor of two with a proper byte array value. */
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += TclUtfToUniChar(src, &ch);
@@ -836,7 +842,6 @@ UpdateStringOfByteArray(
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
(void) Tcl_InitStringRep(objPtr, NULL, size);
}
}
@@ -1503,7 +1508,7 @@ BinaryFormatCmd(
*----------------------------------------------------------------------
*/
int
static int
BinaryScanCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
@@ -1923,7 +1928,7 @@ GetFormatSpec(
(*formatPtr)++;
*countPtr = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
unsigned long int count;
unsigned long count;
errno = 0;
count = strtoul(*formatPtr, (char **) formatPtr, 10);
@@ -2123,7 +2128,7 @@ CopyNumber(
*
* FormatNumber --
*
* This routine is called by Tcl_BinaryObjCmd to format a number into a
* This routine is called by BinaryFormatCmd to format a number into a
* location pointed at by cursor.
*
* Results:
@@ -2292,7 +2297,7 @@ FormatNumber(
*
* ScanNumber --
*
* This routine is called by Tcl_BinaryObjCmd to scan a number out of a
* This routine is called by BinaryScanCmd to scan a number out of a
* buffer.
*
* Results:
@@ -2879,7 +2884,8 @@ BinaryEncodeUu(
{
Tcl_Obj *resultObj;
unsigned char *data, *start, *cursor;
int offset, count, rawLength, n, i, j, bits, index;
int offset, count, rawLength, i, j, bits, index;
unsigned int n;
int lineLength = 61;
const unsigned char SingleNewline[] = { UCHAR('\n') };
const unsigned char *wrapchar = SingleNewline;
+8 -8
View File
@@ -41,7 +41,7 @@ typedef struct MemTag {
* last field in the structure. */
} MemTag;
#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString)
#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1U) + (bytesInString))
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
@@ -131,10 +131,10 @@ static int ckallocInit = 0;
* Prototypes for procedures defined in this file:
*/
static int CheckmemCmd(ClientData clientData,
static int CheckmemCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int MemoryCmd(ClientData clientData,
static int MemoryCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void ValidateMemory(struct mem_header *memHeaderP,
@@ -177,7 +177,7 @@ TclInitDbCkalloc(void)
int
TclDumpMemoryInfo(
ClientData clientData,
void *clientData,
int flags)
{
char buf[1024];
@@ -810,7 +810,7 @@ Tcl_AttemptRealloc(
*/
static int
MemoryCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
@@ -980,13 +980,13 @@ MemoryCmd(
*
*----------------------------------------------------------------------
*/
static int CheckmemCmd(ClientData clientData,
static int CheckmemCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int
CheckmemCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Interpreter for evaluation. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Obj values of arguments. */
@@ -1240,7 +1240,7 @@ Tcl_ValidateAllMemory(
int
TclDumpMemoryInfo(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
TCL_UNUSED(int) /*flags*/)
{
return 1;
+18 -18
View File
@@ -2731,8 +2731,8 @@ Tcl_LremoveObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int i, idxc;
int listLen, *idxv, prevIdx, first, num;
int i, idxc, listLen, prevIdx, first, num;
int *idxv;
Tcl_Obj *listObj;
/*
@@ -2960,7 +2960,8 @@ Tcl_LreplaceObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Obj *listPtr;
int first, last, listLen, numToDelete, result;
int first, last;
int listLen, numToDelete, result;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2991,8 +2992,7 @@ Tcl_LreplaceObjCmd(
if (first == TCL_INDEX_NONE) {
first = 0;
}
if (first > listLen) {
} else if (first > listLen) {
first = listLen;
}
@@ -3140,9 +3140,10 @@ Tcl_LsearchObjCmd(
Tcl_Obj *const objv[]) /* Argument values. */
{
const char *bytes, *patternBytes;
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
int i, match, index, result=TCL_OK, listc, bisect;
int length, elemLen, start, groupSize, groupOffset, lower, upper;
int allocatedIndexVector = 0;
int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
int dataType, isIncreasing;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
@@ -3514,7 +3515,7 @@ Tcl_LsearchObjCmd(
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
TclNewIntObj(itemPtr, TCL_INDEX_NONE);
TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
Tcl_SetObjResult(interp, itemPtr);
}
goto done;
@@ -3645,7 +3646,7 @@ Tcl_LsearchObjCmd(
* our first match might not be the first occurrence.
* Consider: 0 0 0 1 1 1 2 2 2
*
* To maintain consistancy with standard lsearch semantics, we
* To maintain consistency with standard lsearch semantics, we
* must find the leftmost occurrence of the pattern in the
* list. Thus we don't just stop searching here. This
* variation means that a search always makes log n
@@ -3719,8 +3720,7 @@ Tcl_LsearchObjCmd(
if (noCase) {
match = (TclUtfCasecmp(bytes, patternBytes) == 0);
} else {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
match = (memcmp(bytes, patternBytes, length) == 0);
}
}
break;
@@ -3804,10 +3804,10 @@ Tcl_LsearchObjCmd(
} else if (returnSubindices) {
int j;
TclNewIntObj(itemPtr, i+groupOffset);
TclNewIndexObj(itemPtr, i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
@@ -3827,16 +3827,16 @@ Tcl_LsearchObjCmd(
if (returnSubindices) {
int j;
TclNewIntObj(itemPtr, index+groupOffset);
TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_SetObjResult(interp, itemPtr);
} else {
Tcl_Obj *elObj;
TclNewIntObj(elObj, index);
TclNewIndexObj(elObj, index);
Tcl_SetObjResult(interp, elObj);
}
} else if (index < 0) {
@@ -4420,7 +4420,7 @@ Tcl_LsortObjCmd(
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
TclNewIntObj(objPtr, idx + j - groupOffset);
TclNewIndexObj(objPtr, idx + j - groupOffset);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
} else {
@@ -4432,7 +4432,7 @@ Tcl_LsortObjCmd(
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
TclNewIntObj(objPtr, elementPtr->payload.index);
TclNewIndexObj(objPtr, elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
+22 -28
View File
@@ -385,16 +385,16 @@ Tcl_RegexpObjCmd(
end--;
}
} else {
start = -1;
end = -1;
start = TCL_INDEX_NONE;
end = TCL_INDEX_NONE;
}
TclNewIntObj(objs[0], start);
TclNewIntObj(objs[1], end);
TclNewIndexObj(objs[0], start);
TclNewIndexObj(objs[1], end);
newPtr = Tcl_NewListObj(2, objs);
} else {
if (i <= info.nsubs) {
if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
newPtr = Tcl_GetRange(objPtr,
offset + info.matches[i].start,
offset + info.matches[i].end - 1);
@@ -674,7 +674,7 @@ Tcl_RegsubObjCmd(
* object. (If they aren't, that's cheap to do.)
*/
if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) {
if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) {
return TCL_ERROR;
}
if (numParts < 1) {
@@ -776,7 +776,7 @@ Tcl_RegsubObjCmd(
Tcl_Obj **args = NULL, **parts;
int numArgs;
Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
TclListObjGetElements(interp, subPtr, &numParts, &parts);
numArgs = numParts + info.nsubs + 1;
args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
@@ -1910,7 +1910,7 @@ StringIsCmd(
str_is_done:
if ((result == 0) && (failVarObj != NULL)) {
TclNewIntObj(objPtr, failat);
TclNewIndexObj(objPtr, failat);
if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
@@ -2300,13 +2300,7 @@ StringRangeCmd(
return TCL_ERROR;
}
if (first < 0) {
first = 0;
}
if (last >= length) {
last = length;
}
if (last >= first) {
if (last >= 0) {
Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
}
return TCL_OK;
@@ -2543,7 +2537,7 @@ StringStartCmd(
cur += 1;
}
}
TclNewIntObj(obj, cur);
TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
@@ -2604,7 +2598,7 @@ StringEndCmd(
} else {
cur = length;
}
TclNewIntObj(obj, cur);
TclNewIndexObj(obj, cur);
Tcl_SetObjResult(interp, obj);
return TCL_OK;
}
@@ -3778,10 +3772,10 @@ TclNRSwitchObjCmd(
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
TclNewIntObj(rangeObjAry[0], info.matches[j].start);
TclNewIntObj(rangeObjAry[1], info.matches[j].end-1);
TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
} else {
TclNewIntObj(rangeObjAry[1], TCL_INDEX_NONE);
TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
rangeObjAry[0] = rangeObjAry[1];
}
@@ -4001,7 +3995,7 @@ Tcl_ThrowObjCmd(
* The type must be a list of at least length 1.
*/
if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
return TCL_ERROR;
} else if (len < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -4789,7 +4783,7 @@ TclNRTryObjCmd(
return TCL_ERROR;
}
code = 1;
if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad prefix '%s': must be a list",
Tcl_GetString(objv[i+1])));
@@ -4801,7 +4795,7 @@ TclNRTryObjCmd(
info[2] = objv[i+1];
commonHandler:
if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
@@ -4951,12 +4945,12 @@ TryPostBody(
int found = 0;
Tcl_Obj **handlers, **info;
Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
for (i=0 ; i<numHandlers ; i++) {
Tcl_Obj *handlerBodyObj;
int numElems = 0;
Tcl_ListObjGetElements(NULL, handlers[i], &numElems, &info);
TclListObjGetElements(NULL, handlers[i], &numElems, &info);
if (!found) {
Tcl_GetIntFromObj(NULL, info[1], &code);
if (code != result) {
@@ -4977,8 +4971,8 @@ TryPostBody(
TclNewLiteralStringObj(errorCodeName, "-errorcode");
Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
Tcl_DecrRefCount(errorCodeName);
Tcl_ListObjGetElements(NULL, info[2], &len1, &bits1);
if (Tcl_ListObjGetElements(NULL, errcode, &len2,
TclListObjGetElements(NULL, info[2], &len1, &bits1);
if (TclListObjGetElements(NULL, errcode, &len2,
&bits2) != TCL_OK) {
continue;
}
@@ -5018,7 +5012,7 @@ TryPostBody(
Tcl_ResetResult(interp);
result = TCL_ERROR;
Tcl_ListObjLength(NULL, info[3], &numElems);
TclListObjLength(NULL, info[3], &numElems);
if (numElems> 0) {
Tcl_Obj *varName;
+3 -3
View File
@@ -301,7 +301,7 @@ TclCompileArraySetCmd(
TclNewObj(literalObj);
isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
isDataValid = (isDataLiteral
&& Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
&& TclListObjLength(NULL, literalObj, &len) == TCL_OK);
isDataEven = (isDataValid && (len & 1) == 0);
/*
@@ -892,7 +892,7 @@ TclCompileConcatCmd(
const char *bytes;
int len;
Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
TclListObjGetElements(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
bytes = TclGetStringFromObj(objPtr, &len);
@@ -2750,7 +2750,7 @@ CompileEachloopCmd(
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
TCL_OK != TclListObjLength(NULL, varListObj, &numVars) ||
numVars == 0) {
code = TCL_ERROR;
goto done;
+6 -6
View File
@@ -938,7 +938,7 @@ TclCompileStringMapCmd(
if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
} else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
Tcl_DecrRefCount(mapObj);
return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (len != 2) {
@@ -2731,7 +2731,7 @@ TclCompileThrowCmd(
CompileWord(envPtr, msgToken, interp, 2);
codeIsList = codeKnown && (TCL_OK ==
Tcl_ListObjLength(interp, objPtr, &len));
TclListObjLength(interp, objPtr, &len));
codeIsValid = codeIsList && (len != 0);
if (codeIsValid) {
@@ -2864,7 +2864,7 @@ TclCompileTryCmd(
TclNewObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
|| Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK
|| TclListObjLength(NULL, tmpObj, &objc) != TCL_OK
|| (objc == 0)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
@@ -2907,7 +2907,7 @@ TclCompileTryCmd(
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
|| (objc > 2)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
@@ -3118,7 +3118,7 @@ IssueTryClausesInstructions(
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
const char *p;
Tcl_ListObjLength(NULL, matchClauses[i], &len);
TclListObjLength(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
@@ -3329,7 +3329,7 @@ IssueTryClausesFinallyInstructions(
OP( EQ);
JUMP4( JUMP_FALSE, notCodeJumpSource);
if (matchClauses[i]) {
Tcl_ListObjLength(NULL, matchClauses[i], &len);
TclListObjLength(NULL, matchClauses[i], &len);
/*
* Match the errorcode according to try/trap rules.
+3 -3
View File
@@ -731,7 +731,7 @@ const Tcl_ObjType tclByteCodeType = {
/*
* subtCodeType provides the standard type managemnt procedures for the
* substcode type, which represents substiution within a Tcl value.
* substcode type, which represents substiution within a Tcl value.
*/
static const Tcl_ObjType substCodeType = {
@@ -1959,7 +1959,7 @@ CompileCmdCompileProc(
*
* atCmdStart == 2 : Don't use the INST_START_CMD instruction.
* atCmdStart == 1 : INST_START_CMD was the last instruction emitted,
* : so no need to emit another. Instead
* : so no need to emit another. Instead
* : increment the number of cmds started at it, except
* : for the special case at the start of a script.
* atCmdStart == 0 : The last instruction was something else.
@@ -3065,7 +3065,7 @@ TclFindCompiledLocal(
if (create || (name == NULL)) {
localVar = procPtr->numCompiledLocals;
localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1);
localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + 1U + nameBytes);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
+9 -9
View File
@@ -1495,22 +1495,22 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData,
# define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
# define TclGetInt1AtPtr(p) \
(((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0)))
#endif
#define TclGetInt4AtPtr(p) \
(((int) (TclGetUInt1AtPtr(p) << 24)) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3)))
((int) ((TclGetUInt1AtPtr(p) << 24) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3))))
#define TclGetUInt1AtPtr(p) \
((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \
((unsigned int) (*(p) << 24) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3)))
((unsigned int) ((*(p) << 24) | \
(*((p)+1) << 16) | \
(*((p)+2) << 8) | \
(*((p)+3))))
/*
* Macros used to compute the minimum and maximum of two integers. The ANSI C
+2 -2
View File
@@ -185,9 +185,9 @@ typedef struct DateInfo {
#define TM_YEAR_BASE 1900
#define HOUR(x) ((int) (60 * x))
#define HOUR(x) ((int) (60 * (x)))
#define SECSPERDAY (24L * 60L * 60L)
#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))
/*
* An entry in the lexical lookup table.
+64 -28
View File
@@ -124,7 +124,7 @@ Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
int length, const char *file, int line);
int numBytes, const char *file, int line);
/* 24 */
EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
const char *file, int line);
@@ -152,7 +152,7 @@ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *boolPtr);
/* 33 */
EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
int *numBytesPtr);
/* 34 */
EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
double *doublePtr);
@@ -205,7 +205,7 @@ TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
int numBytes);
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
@@ -224,10 +224,10 @@ EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
TCL_DEPRECATED("No longer in use, changed to macro")
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes);
/* 59 */
EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
const unsigned char *bytes, int length);
const unsigned char *bytes, int numBytes);
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
@@ -471,7 +471,7 @@ EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
EXTERN void Tcl_Finalize(void);
/* 144 */
EXTERN void Tcl_FindExecutable(const char *argv0);
EXTERN const char * Tcl_FindExecutable(const char *argv0);
/* 145 */
EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr);
@@ -710,7 +710,7 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
EXTERN void Tcl_SetPanicProc(
EXTERN const char * Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *panicProc);
/* 231 */
EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
@@ -1920,8 +1920,12 @@ EXTERN char * Tcl_UniCharToUtfDString(const int *uniStr,
/* 648 */
EXTERN int * Tcl_UtfToUniCharDString(const char *src, int length,
Tcl_DString *dsPtr);
/* Slot 649 is reserved */
/* Slot 650 is reserved */
/* 649 */
EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *numBytesPtr);
/* 650 */
EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, size_t *numBytesPtr);
/* 651 */
EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
@@ -1930,7 +1934,7 @@ EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
/* 653 */
EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr,
size_t *lengthPtr);
size_t *numBytesPtr);
/* 654 */
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
/* 655 */
@@ -1994,7 +1998,7 @@ typedef struct TclStubs {
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int numBytes, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
@@ -2004,7 +2008,7 @@ typedef struct TclStubs {
void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
@@ -2021,7 +2025,7 @@ typedef struct TclStubs {
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int numBytes); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
@@ -2029,8 +2033,8 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int numBytes); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int numBytes); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
@@ -2115,7 +2119,7 @@ typedef struct TclStubs {
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
void (*tcl_Finalize) (void); /* 143 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_FindExecutable) (const char *argv0); /* 144 */
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
@@ -2209,7 +2213,7 @@ typedef struct TclStubs {
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") const char * (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
@@ -2628,11 +2632,11 @@ typedef struct TclStubs {
int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */
int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */
void (*reserved649)(void);
void (*reserved650)(void);
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */
unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
const char * (*tcl_UtfNext) (const char *src); /* 655 */
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
@@ -3968,8 +3972,10 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */
#define Tcl_UtfToUniCharDString \
(tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */
/* Slot 649 is reserved */
/* Slot 650 is reserved */
#define TclGetBytesFromObj \
(tclStubsPtr->tclGetBytesFromObj) /* 649 */
#define Tcl_GetBytesFromObj \
(tclStubsPtr->tcl_GetBytesFromObj) /* 650 */
#define TclGetStringFromObj \
(tclStubsPtr->tclGetStringFromObj) /* 651 */
#define TclGetUnicodeFromObj \
@@ -4011,10 +4017,18 @@ extern const TclStubs *tclStubsPtr;
#endif
#if defined(_WIN32) && defined(UNICODE)
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
# if defined(TCL_NO_DEPRECATED)
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
# else
# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)((const char *)(arg))))
# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
# endif
# define Tcl_MainEx Tcl_MainExW
EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#elif !defined(TCL_NO_DEPRECATED)
# define Tcl_FindExecutable(arg) ((void)((Tcl_FindExecutable)(arg)))
# define Tcl_SetPanicProc(arg) ((void)((Tcl_SetPanicProc)(arg)))
#endif
#undef TCL_STORAGE_CLASS
@@ -4129,7 +4143,24 @@ extern const TclStubs *tclStubsPtr;
} while(0)
#endif /* TCL_NO_DEPRECATED */
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
#if defined(USE_TCL_STUBS)
# if defined(_WIN32) && defined(_WIN64)
# undef Tcl_GetTime
/* Handle Win64 tk.dll being loaded in Cygwin64. */
# define Tcl_GetTime(t) \
do { \
union { \
Tcl_Time now; \
long long reserved; \
} _t; \
_t.reserved = -1; \
tclStubsPtr->tcl_GetTime((&_t.now)); \
if (_t.reserved != -1) { \
_t.now.usec = _t.reserved; \
} \
*(t) = _t.now; \
} while (0)
# endif
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
* we have to make sure that all stub entries on Cygwin64 follow the
@@ -4177,12 +4208,15 @@ extern const TclStubs *tclStubsPtr;
Tcl_GetStringFromObj(objPtr, (int *)NULL)
#define Tcl_GetUnicode(objPtr) \
Tcl_GetUnicodeFromObj(objPtr, (int *)NULL)
#undef Tcl_GetBytesFromObj
#ifdef TCL_NO_DEPRECATED
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef Tcl_GetByteArrayFromObj
#endif
#if defined(USE_TCL_STUBS)
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr))
#ifdef TCL_NO_DEPRECATED
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr))
@@ -4192,6 +4226,8 @@ extern const TclStubs *tclStubsPtr;
(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr))
#endif
#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr))
#ifdef TCL_NO_DEPRECATED
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr))
@@ -4233,8 +4269,8 @@ extern const TclStubs *tclStubsPtr;
? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
: (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString)
# define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \
: (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar)
? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToUniChar \
: (int (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#else
# define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
? (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_UniCharToUtfDString \
@@ -4243,8 +4279,8 @@ extern const TclStubs *tclStubsPtr;
? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \
: (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToChar16DString)
# define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \
: (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar)
? (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar \
: (int (*)(const char *, wchar_t *))Tcl_UtfToChar16)
#endif
/*
+3 -2
View File
@@ -566,6 +566,7 @@ UpdateStringOfDict(
dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
*dst++ = ' ';
}
/* Last space overwrote the terminating NUL; cal T_ISR again to restore */
(void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (flagPtr != localFlags) {
@@ -3373,7 +3374,7 @@ FinalizeDictUpdate(
* an instruction to remove the key.
*/
Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
TclListObjGetElements(NULL, argsObj, &objc, &objv);
for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
@@ -3497,7 +3498,7 @@ FinalizeDictWith(
state = Tcl_SaveInterpState(interp, result);
if (pathPtr != NULL) {
Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
TclListObjGetElements(NULL, pathPtr, &pathc, &pathv);
} else {
pathc = 0;
pathv = NULL;
+1 -1
View File
@@ -764,7 +764,7 @@ TclGetInnerContext(
* Reset while keeping the list internalrep as much as possible.
*/
Tcl_ListObjLength(interp, result, &len);
TclListObjLength(interp, result, &len);
Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
}
Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+261 -43
View File
@@ -37,7 +37,7 @@ typedef struct {
* end-of-string in this encoding. This number
* is used to determine the source string
* length when the srcLen argument is
* negative. This number can be 1 or 2. */
* negative. This number can be 1, 2, or 4. */
ClientData clientData; /* Arbitrary value associated with encoding
* type. Passed to conversion functions. */
LengthProc *lengthProc; /* Function to compute length of
@@ -45,7 +45,9 @@ typedef struct {
* If nullSize is 1, this is strlen; if
* nullSize is 2, this is a function that
* returns the number of bytes in a 0x0000
* terminated string. */
* terminated string; if nullSize is 4, this
* is a function that returns the number of
* bytes in a 0x00000000 terminated string. */
size_t refCount; /* Number of uses of this structure. */
Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
} Encoding;
@@ -216,7 +218,10 @@ static Tcl_Channel OpenEncodingFileChannel(Tcl_Interp *interp,
static Tcl_EncodingFreeProc TableFreeProc;
static Tcl_EncodingConvertProc TableFromUtfProc;
static Tcl_EncodingConvertProc TableToUtfProc;
static size_t unilen(const char *src);
static size_t unilen(const char *src);
static size_t unilen4(const char *src);
static Tcl_EncodingConvertProc Utf32ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf32Proc;
static Tcl_EncodingConvertProc Utf16ToUtfProc;
static Tcl_EncodingConvertProc UtfToUtf16Proc;
static Tcl_EncodingConvertProc UtfToUcs2Proc;
@@ -365,7 +370,7 @@ Tcl_SetEncodingSearchPath(
{
int dummy;
if (TCL_ERROR == Tcl_ListObjLength(NULL, searchPath, &dummy)) {
if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) {
return TCL_ERROR;
}
TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL);
@@ -412,7 +417,7 @@ TclSetLibraryPath(
{
int dummy;
if (TCL_ERROR == Tcl_ListObjLength(NULL, path, &dummy)) {
if (TCL_ERROR == TclListObjLength(NULL, path, &dummy)) {
return;
}
TclSetProcessGlobalValue(&libraryPath, path, NULL);
@@ -451,7 +456,7 @@ FillEncodingFileMap(void)
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
Tcl_ListObjLength(NULL, searchPath, &numDirs);
TclListObjLength(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
Tcl_IncrRefCount(map);
@@ -475,7 +480,7 @@ FillEncodingFileMap(void)
Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc",
&readableFiles);
Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev);
TclListObjGetElements(NULL, matchFileList, &numFiles, &filev);
for (j=0; j<numFiles; j++) {
Tcl_Obj *encodingName, *fileObj;
@@ -512,7 +517,7 @@ FillEncodingFileMap(void)
/* Those flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
/* Since TCL_ENCODING_MODIFIED is only used for utf-8/cesu-8 and
* TCL_ENCODING_LE is only used for utf-16/ucs-2. re-use the same value */
* TCL_ENCODING_LE is only used for utf-16/utf-32/ucs-2. re-use the same value */
#define TCL_ENCODING_MODIFIED 0x20 /* Converting NULL bytes to 0xC0 0x80 */
#define TCL_ENCODING_LE TCL_ENCODING_MODIFIED /* Little-endian encoding */
#define TCL_ENCODING_UTF 0x200 /* For UTF-8 encoding, allow 4-byte output sequences */
@@ -577,6 +582,20 @@ TclInitEncodingSubsystem(void)
type.clientData = INT2PTR(isLe.c);
Tcl_CreateEncoding(&type);
type.toUtfProc = Utf32ToUtfProc;
type.fromUtfProc = UtfToUtf32Proc;
type.freeProc = NULL;
type.nullSize = 4;
type.encodingName = "utf-32le";
type.clientData = INT2PTR(TCL_ENCODING_LE);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-32be";
type.clientData = INT2PTR(0);
Tcl_CreateEncoding(&type);
type.encodingName = "utf-32";
type.clientData = INT2PTR(isLe.c);
Tcl_CreateEncoding(&type);
type.toUtfProc = Utf16ToUtfProc;
type.fromUtfProc = UtfToUtf16Proc;
type.freeProc = NULL;
@@ -709,7 +728,7 @@ Tcl_GetDefaultEncodingDir(void)
int numDirs;
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(NULL, searchPath, &numDirs);
TclListObjLength(NULL, searchPath, &numDirs);
if (numDirs == 0) {
return NULL;
}
@@ -1057,10 +1076,12 @@ Tcl_CreateEncoding(
encodingPtr->freeProc = typePtr->freeProc;
encodingPtr->nullSize = typePtr->nullSize;
encodingPtr->clientData = typePtr->clientData;
if (typePtr->nullSize == 1) {
encodingPtr->lengthProc = (LengthProc *) strlen;
} else {
if (typePtr->nullSize == 2) {
encodingPtr->lengthProc = (LengthProc *) unilen;
} else if (typePtr->nullSize == 4) {
encodingPtr->lengthProc = (LengthProc *) unilen4;
} else {
encodingPtr->lengthProc = (LengthProc *) strlen;
}
encodingPtr->refCount = 1;
encodingPtr->hPtr = NULL;
@@ -1343,10 +1364,10 @@ Tcl_UtfToExternalDString(
src += srcRead;
if (result != TCL_CONVERT_NOSPACE) {
if (encodingPtr->nullSize == 2) {
Tcl_DStringSetLength(dstPtr, soFar + 1);
int i = soFar + encodingPtr->nullSize - 1;
while (i >= soFar) {
Tcl_DStringSetLength(dstPtr, i--);
}
Tcl_DStringSetLength(dstPtr, soFar);
return Tcl_DStringValue(dstPtr);
}
@@ -1441,10 +1462,7 @@ Tcl_UtfToExternal(
result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
flags, statePtr, dst, dstLen, srcReadPtr,
dstWrotePtr, dstCharsPtr);
if (encodingPtr->nullSize == 2) {
dst[*dstWrotePtr + 1] = '\0';
}
dst[*dstWrotePtr] = '\0';
memset(&dst[*dstWrotePtr], '\0', encodingPtr->nullSize);
return result;
}
@@ -1467,14 +1485,15 @@ Tcl_UtfToExternal(
*---------------------------------------------------------------------------
*/
#undef Tcl_FindExecutable
void
const char *
Tcl_FindExecutable(
const char *argv0) /* The value of the application's argv[0]
* (native). */
{
Tcl_InitSubsystems();
const char *version = Tcl_InitSubsystems();
TclpSetInitialEncodings();
TclpFindExecutable(argv0);
return version;
}
/*
@@ -1510,7 +1529,7 @@ OpenEncodingFileChannel(
Tcl_Channel chan = NULL;
int i, numDirs;
Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir);
TclListObjGetElements(NULL, searchPath, &numDirs, &dir);
Tcl_IncrRefCount(nameObj);
Tcl_AppendToObj(fileNameObj, ".enc", -1);
Tcl_IncrRefCount(fileNameObj);
@@ -2235,15 +2254,15 @@ UtfToUtfProc(
result = TCL_CONVERT_NOSPACE;
break;
}
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && (flags & TCL_ENCODING_MODIFIED))) {
if (UCHAR(*src) < 0x80 && !((UCHAR(*src) == 0) && (flags & TCL_ENCODING_MODIFIED))) {
/*
* Copy 7bit characters, but skip null-bytes when we are in input
* mode, so that they get converted to 0xC080.
*/
*dst++ = *src++;
} else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd)
&& UCHAR(src[1]) == 0x80 && !(flags & TCL_ENCODING_MODIFIED)) {
} else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd)
&& (UCHAR(src[1]) == 0x80) && !(flags & TCL_ENCODING_MODIFIED)) {
/*
* Convert 0xC080 to real nulls when we are in output mode.
*/
@@ -2304,9 +2323,6 @@ UtfToUtfProc(
src = saveSrc;
break;
}
if (!(flags & TCL_ENCODING_MODIFIED)) {
ch = 0xFFFD;
}
cesu8:
*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
@@ -2336,6 +2352,199 @@ UtfToUtfProc(
return result;
}
/*
*-------------------------------------------------------------------------
*
* Utf32ToUtfProc --
*
* Convert from UTF-32 to UTF-8.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
Utf32ToUtfProc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in Unicode. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
int ch;
flags |= PTR2INT(clientData);
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
/*
* Check alignment with utf-32 (4 == sizeof(UTF-32))
*/
if ((srcLen % 4) != 0) {
result = TCL_CONVERT_MULTIBYTE;
srcLen &= -4;
}
srcStart = src;
srcEnd = src + srcLen;
dstStart = dst;
dstEnd = dst + dstLen - TCL_UTF_MAX;
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
if (flags & TCL_ENCODING_LE) {
ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
} else {
ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
}
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
* unsigned short-size data.
*/
if ((ch > 0) && (ch < 0x80)) {
*dst++ = (ch & 0xFF);
} else {
dst += Tcl_UniCharToUtf(ch, dst);
}
src += sizeof(unsigned int);
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
* UtfToUtf32Proc --
*
* Convert from UTF-8 to UTF-32.
*
* Results:
* Returns TCL_OK if conversion was successful.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------------
*/
static int
UtfToUtf32Proc(
ClientData clientData, /* additional flags, e.g. TCL_ENCODING_LE */
const char *src, /* Source string in UTF-8. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
TCL_UNUSED(Tcl_EncodingState *),
char *dst, /* Output buffer in which converted string is
* stored. */
int dstLen, /* The maximum length of output buffer in
* bytes. */
int *srcReadPtr, /* Filled with the number of bytes from the
* source string that were converted. This may
* be less than the original source length if
* there was a problem converting some source
* characters. */
int *dstWrotePtr, /* Filled with the number of bytes that were
* stored in the output buffer as a result of
* the conversion. */
int *dstCharsPtr) /* Filled with the number of characters that
* correspond to the bytes stored in the
* output buffer. */
{
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
int result, numChars;
int ch, len;
srcStart = src;
srcEnd = src + srcLen;
srcClose = srcEnd;
if ((flags & TCL_ENCODING_END) == 0) {
srcClose -= TCL_UTF_MAX;
}
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
flags |= PTR2INT(clientData);
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
/*
* If there is more string to follow, this will ensure that the
* last UTF-8 character in the source buffer hasn't been cut off.
*/
result = TCL_CONVERT_MULTIBYTE;
break;
}
if (dst > dstEnd) {
result = TCL_CONVERT_NOSPACE;
break;
}
len = TclUtfToUCS4(src, &ch);
if (!Tcl_UniCharIsUnicode(ch)) {
if (flags & TCL_ENCODING_STOPONERROR) {
result = TCL_CONVERT_UNKNOWN;
break;
}
ch = 0xFFFD;
}
src += len;
if (flags & TCL_ENCODING_LE) {
*dst++ = (ch & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = ((ch >> 24) & 0xFF);
} else {
*dst++ = ((ch >> 24) & 0xFF);
*dst++ = ((ch >> 16) & 0xFF);
*dst++ = ((ch >> 8) & 0xFF);
*dst++ = (ch & 0xFF);
}
}
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
@@ -2651,7 +2860,7 @@ UtfToUcs2Proc(
*dstCharsPtr = numChars;
return result;
}
/*
*-------------------------------------------------------------------------
*
@@ -2837,11 +3046,7 @@ TableFromUtfProc(
len = TclUtfToUniChar(src, &ch);
#if TCL_UTF_MAX > 3
/*
* This prevents a crash condition. More evaluation is required for
* full support of int Tcl_UniChar. [Bug 1004065]
*/
/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
if (ch & 0xFFFF0000) {
word = 0;
} else
@@ -3093,7 +3298,7 @@ TableFreeProc(
ClientData clientData) /* TableEncodingData that specifies
* encoding. */
{
TableEncodingData *dataPtr = (TableEncodingData *) clientData;
TableEncodingData *dataPtr = (TableEncodingData *)clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
@@ -3151,7 +3356,7 @@ EscapeToUtfProc(
* correspond to the bytes stored in the
* output buffer. */
{
EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData;
EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
const unsigned short *const *tableToUnicode;
const Encoding *encodingPtr;
@@ -3628,7 +3833,7 @@ GetTableEncoding(
/*
*---------------------------------------------------------------------------
*
* unilen --
* unilen, unilen4 --
*
* A helper function for the Tcl_ExternalToUtf functions. This function
* is similar to strlen for double-byte characters: it returns the number
@@ -3655,6 +3860,19 @@ unilen(
}
return (char *) p - src;
}
static size_t
unilen4(
const char *src)
{
unsigned int *p;
p = (unsigned int *) src;
while (*p != 0x00000000) {
p++;
}
return (char *) p - src;
}
/*
*-------------------------------------------------------------------------
@@ -3686,7 +3904,7 @@ InitializeEncodingSearchPath(
Tcl_Encoding *encodingPtr)
{
const char *bytes;
int i, numDirs;
int i, numDirs, numBytes;
Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
TclNewLiteralStringObj(encodingObj, "encoding");
@@ -3695,7 +3913,7 @@ InitializeEncodingSearchPath(
Tcl_IncrRefCount(searchPathObj);
libPathObj = TclGetLibraryPath();
Tcl_IncrRefCount(libPathObj);
Tcl_ListObjLength(NULL, libPathObj, &numDirs);
TclListObjLength(NULL, libPathObj, &numDirs);
for (i = 0; i < numDirs; i++) {
Tcl_Obj *directoryObj, *pathObj;
@@ -3716,11 +3934,11 @@ InitializeEncodingSearchPath(
if (*encodingPtr) {
((Encoding *)(*encodingPtr))->refCount++;
}
bytes = TclGetString(searchPathObj);
bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
*lengthPtr = searchPathObj->length;
*valuePtr = (char *)ckalloc(*lengthPtr + 1);
memcpy(*valuePtr, bytes, *lengthPtr + 1);
*lengthPtr = numBytes;
*valuePtr = (char *)ckalloc(numBytes + 1);
memcpy(*valuePtr, bytes, numBytes + 1);
Tcl_DecrRefCount(searchPathObj);
}
+6 -6
View File
@@ -1890,7 +1890,7 @@ NsEnsembleImplementationCmdNR(
Tcl_Obj **copyObjv;
int copyObjc, prefixObjc;
Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
TclListObjLength(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
@@ -1924,7 +1924,7 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
TclListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
@@ -2605,7 +2605,7 @@ BuildEnsembleConfig(
* Must determine the target for each.
*/
Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
TclListObjGetElements(NULL, subList, &subc, &subv);
if (subList == mapDict) {
/*
* Strange case where explicit list of subcommands is same value
@@ -3006,7 +3006,7 @@ TclCompileEnsemble(
const char *str;
Tcl_Obj *matchObj = NULL;
if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
goto failed;
}
for (i=0 ; i<len ; i++) {
@@ -3126,7 +3126,7 @@ TclCompileEnsemble(
doneMapLookup:
Tcl_ListObjAppendElement(NULL, replaced, replacement);
if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
if (TclListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
goto failed;
} else if (len != 1) {
/*
@@ -3408,7 +3408,7 @@ CompileToInvokedCommand(
* difference. Hence the call to TclContinuationsEnterDerived...
*/
Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
TclListObjGetElements(NULL, replacements, &numWords, &words);
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
i++, tokPtr = TokenAfter(tokPtr)) {
if (i > 0 && i < numWords+1) {
+87 -3
View File
@@ -14,6 +14,7 @@
*/
#include "tclInt.h"
#include "tclUuid.h"
/*
* The data structure below is used to report background errors. One such
@@ -229,7 +230,7 @@ HandleBgErrors(
errPtr = assocPtr->firstBgPtr;
Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
tempObjv[prefixObjc] = errPtr->errorMsg;
@@ -1016,7 +1017,7 @@ Tcl_Exit(
* down another.
*
* Results:
* None.
* The full Tcl version with build information.
*
* Side effects:
* Varied, see the respective initialization routines.
@@ -1024,7 +1025,89 @@ Tcl_Exit(
*-------------------------------------------------------------------------
*/
void
MODULE_SCOPE const TclStubs tclStubs;
#ifndef STRINGIFY
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
#endif
static const struct {
const TclStubs *stubs;
const char version[256];
} stubInfo = {
&tclStubs, {TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
#if defined(__clang__) && defined(__clang_major__)
".clang-" STRINGIFY(__clang_major__)
#if __clang_minor__ < 10
"0"
#endif
STRINGIFY(__clang_minor__)
#endif
#ifdef TCL_COMPILE_DEBUG
".compiledebug"
#endif
#ifdef TCL_COMPILE_STATS
".compilestats"
#endif
#if defined(__cplusplus) && !defined(__OBJC__)
".cplusplus"
#endif
#ifndef NDEBUG
".debug"
#endif
#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
".gcc-" STRINGIFY(__GNUC__)
#if __GNUC_MINOR__ < 10
"0"
#endif
STRINGIFY(__GNUC_MINOR__)
#endif
#ifdef __INTEL_COMPILER
".icc-" STRINGIFY(__INTEL_COMPILER)
#endif
#if (defined(_WIN32) && !defined(_WIN64)) || (ULONG_MAX == 0xffffffffUL)
".ilp32"
#endif
#ifdef TCL_MEM_DEBUG
".memdebug"
#endif
#if defined(_MSC_VER)
".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
".nmake"
#endif
#ifdef TCL_NO_DEPRECATED
".no-deprecate"
#endif
#if !TCL_THREADS
".no-thread"
#endif
#ifndef TCL_CFG_OPTIMIZED
".no-optimize"
#endif
#ifdef __OBJC__
".objective-c"
#if defined(__cplusplus)
"plusplus"
#endif
#endif
#ifdef TCL_CFG_PROFILED
".profile"
#endif
#ifdef PURIFY
".purify"
#endif
#ifdef STATIC_BUILD
".static"
#endif
#if TCL_UTF_MAX < 4
".utf-16"
#endif
}};
const char *
Tcl_InitSubsystems(void)
{
if (inExit != 0) {
@@ -1071,6 +1154,7 @@ Tcl_InitSubsystems(void)
TclpInitUnlock();
}
TclInitNotifier();
return stubInfo.version;
}
/*
+45 -63
View File
@@ -193,10 +193,10 @@ typedef struct TEBCdata {
#define PUSH_TAUX_OBJ(objPtr) \
do { \
if (auxObjList) { \
objPtr->length += auxObjList->length; \
(objPtr)->length += auxObjList->length; \
} \
objPtr->internalRep.twoPtrValue.ptr1 = auxObjList; \
auxObjList = objPtr; \
(objPtr)->internalRep.twoPtrValue.ptr1 = auxObjList; \
auxObjList = (objPtr); \
} while (0)
#define POP_TAUX_OBJ() \
@@ -505,7 +505,7 @@ VarHashCreateVar(
* TclGetNumberFromObj(). The ANSI C "prototype" is:
*
* MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
* ClientData *ptrPtr, int *tPtr);
* void **ptrPtr, int *tPtr);
*/
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -669,7 +669,7 @@ static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
*/
#ifdef TCL_COMPILE_STATS
static int EvalStatsCmd(ClientData clientData,
static int EvalStatsCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#endif /* TCL_COMPILE_STATS */
@@ -1365,7 +1365,7 @@ Tcl_ExprObj(
static int
CopyCallback(
ClientData data[],
void *data[],
TCL_UNUSED(Tcl_Interp *),
int result)
{
@@ -1423,7 +1423,7 @@ Tcl_NRExprObj(
static int
ExprObjCallback(
ClientData data[],
void *data[],
Tcl_Interp *interp,
int result)
{
@@ -1809,7 +1809,7 @@ TclIncrObj(
Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr)
{
ClientData ptr1, ptr2;
void *ptr1, *ptr2;
int type1, type2;
mp_int value, incr;
mp_err err;
@@ -2019,7 +2019,7 @@ TclNRExecuteByteCode(
static int
TEBCresume(
ClientData data[],
void *data[],
Tcl_Interp *interp,
int result)
{
@@ -3024,7 +3024,7 @@ TEBCresume(
TclMarkTailcall(interp);
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
TclListObjGetElements(NULL, objPtr, &objc, &objv);
TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
@@ -3704,7 +3704,7 @@ TEBCresume(
}
if (TclIsVarDirectModifyable(varPtr)) {
ClientData ptr;
void *ptr;
int type;
objPtr = varPtr->value.objPtr;
@@ -5370,16 +5370,10 @@ TEBCresume(
}
CACHE_STACK_INFO();
if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= length) {
toIdx = length;
}
if (toIdx >= fromIdx) {
objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
} else {
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
}
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(1, 3, 1);
@@ -5405,37 +5399,23 @@ TEBCresume(
* Extra safety for legacy bytecodes:
*/
if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
}
toIdx = TclIndexDecode(toIdx, length - 1);
if (toIdx < 0) {
goto emptyRange;
} else if (toIdx >= length) {
toIdx = length - 1;
}
assert ( toIdx >= 0 && toIdx < length );
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, length - 1);
if (fromIdx < 0) {
fromIdx = 0;
}
if (fromIdx <= toIdx) {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
} else {
emptyRange:
TclNewObj(objResultPtr);
} else {
toIdx = TclIndexDecode(toIdx, length - 1);
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, length - 1);
if (toIdx < 0) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
}
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5538,7 +5518,9 @@ TEBCresume(
p = ustring1;
end = ustring1 + length;
for (; ustring1 < end; ustring1++) {
if ((*ustring1 == *ustring2) && (length2==1 ||
if ((*ustring1 == *ustring2) &&
/* Fix bug [69218ab7b]: restrict max compare length. */
(end-ustring1 >= length2) && (length2==1 ||
memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
== 0)) {
if (p != ustring1) {
@@ -5743,7 +5725,7 @@ TEBCresume(
*/
{
ClientData ptr1, ptr2;
void *ptr1, *ptr2;
int type1, type2;
Tcl_WideInt w1, w2, wResult;
@@ -6017,10 +5999,10 @@ TEBCresume(
* Handle shifts within the native long range.
*/
if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
if (((size_t) shift < CHAR_BIT*sizeof(long))
&& !((w1>0 ? w1 : ~w1) &
-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = w1 << shift;
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = (Tcl_WideUInt)w1 << shift;
goto wideResultOfArithmetic;
}
}
@@ -7924,7 +7906,7 @@ TEBCresume(
static int
FinalizeOONext(
ClientData data[],
void *data[],
Tcl_Interp *interp,
int result)
{
@@ -7950,7 +7932,7 @@ FinalizeOONext(
static int
FinalizeOONextFilter(
ClientData data[],
void *data[],
Tcl_Interp *interp,
int result)
{
@@ -8096,14 +8078,14 @@ ExecuteExtendedBinaryMathOp(
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
TclSetIntObj(valuePtr, w); \
TclSetIntObj(valuePtr, (w)); \
return NULL; \
}
#define BIG_RESULT(b) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewBignumObj(b); \
} else { \
Tcl_SetBignumObj(valuePtr, b); \
Tcl_SetBignumObj(valuePtr, (b)); \
return NULL; \
}
#define DOUBLE_RESULT(d) \
@@ -8116,7 +8098,7 @@ ExecuteExtendedBinaryMathOp(
}
int type1, type2;
ClientData ptr1, ptr2;
void *ptr1, *ptr2;
double d1, d2, dResult;
Tcl_WideInt w1, w2, wResult;
mp_int big1, big2, bigResult, bigRemainder;
@@ -8818,7 +8800,7 @@ ExecuteExtendedUnaryMathOp(
int opcode, /* What operation to perform. */
Tcl_Obj *valuePtr) /* The operand on the stack. */
{
ClientData ptr = NULL;
void *ptr = NULL;
int type;
Tcl_WideInt w;
mp_int big;
@@ -8898,7 +8880,7 @@ TclCompareTwoNumbers(
Tcl_Obj *value2Ptr)
{
int type1 = TCL_NUMBER_NAN, type2 = TCL_NUMBER_NAN, compare;
ClientData ptr1, ptr2;
void *ptr1, *ptr2;
mp_int big1, big2;
double d1, d2, tmp;
Tcl_WideInt w1, w2;
@@ -9213,7 +9195,7 @@ IllegalExprOperandType(
Tcl_Obj *opndPtr) /* Points to the operand holding the value
* with the illegal type. */
{
ClientData ptr;
void *ptr;
int type;
const unsigned char opcode = *pc;
const char *description, *op = "unknown";
+1 -1
View File
@@ -1006,7 +1006,7 @@ TclFileAttrsCmd(
* Use objStrings as a list object.
*/
if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
goto end;
}
attributeStringsAllocated = (const char **)
+9 -9
View File
@@ -517,7 +517,7 @@ TclpNativeSplitPath(
*/
if (lenPtr != NULL) {
Tcl_ListObjLength(NULL, resultPtr, lenPtr);
TclListObjLength(NULL, resultPtr, lenPtr);
}
return resultPtr;
}
@@ -1332,7 +1332,7 @@ Tcl_GlobObjCmd(
return TCL_ERROR;
}
typePtr = objv[i+1];
if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
if (TclListObjLength(interp, typePtr, &length) != TCL_OK) {
return TCL_ERROR;
}
i++;
@@ -1454,7 +1454,7 @@ Tcl_GlobObjCmd(
* platform.
*/
Tcl_ListObjLength(interp, typePtr, &length);
TclListObjLength(interp, typePtr, &length);
if (length <= 0) {
goto skipTypes;
}
@@ -1524,7 +1524,7 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
if ((TclListObjLength(NULL, look, &len) == TCL_OK)
&& (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
@@ -1631,7 +1631,7 @@ Tcl_GlobObjCmd(
}
if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
if (TclListObjLength(interp, Tcl_GetObjResult(interp),
&length) != TCL_OK) {
/*
* This should never happen. Maybe we should be more dramatic.
@@ -2014,7 +2014,7 @@ TclGlob(
}
}
Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
TclListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
const char *oldStr = TclGetStringFromObj(objv[i], &len);
@@ -2343,13 +2343,13 @@ DoGlob(
int subdirc, i, repair = -1;
Tcl_Obj **subdirv;
result = Tcl_ListObjGetElements(interp, subdirsPtr,
result = TclListObjGetElements(interp, subdirsPtr,
&subdirc, &subdirv);
for (i=0; result==TCL_OK && i<subdirc; i++) {
Tcl_Obj *copy = NULL;
if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
Tcl_ListObjLength(NULL, matchesObj, &repair);
TclListObjLength(NULL, matchesObj, &repair);
copy = subdirv[i];
subdirv[i] = Tcl_NewStringObj("./", 2);
Tcl_AppendObjToObj(subdirv[i], copy);
@@ -2362,7 +2362,7 @@ DoGlob(
Tcl_DecrRefCount(subdirv[i]);
subdirv[i] = copy;
Tcl_ListObjLength(NULL, matchesObj, &end);
TclListObjLength(NULL, matchesObj, &end);
while (repair < end) {
const char *bytes;
int numBytes;
+2 -2
View File
@@ -136,9 +136,9 @@ typedef struct DateInfo {
#define TM_YEAR_BASE 1900
#define HOUR(x) ((int) (60 * x))
#define HOUR(x) ((int) (60 * (x)))
#define SECSPERDAY (24L * 60L * 60L)
#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0))
#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0))
/*
* An entry in the lexical lookup table.
+1 -1
View File
@@ -35,7 +35,7 @@
*/
#define RANDOM_INDEX(tablePtr, i) \
((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
/*
* Prototypes for the array hash key methods.
+8 -8
View File
@@ -9436,13 +9436,13 @@ MBWrite(
if (bufPtr) {
/* Split the overflowing buffer in two */
int extra = (int) (inBytes - csPtr->toRead);
/* Note that going with int for extra assumes that inBytes is not too
* much over toRead to require a wide itself. If that gets violated
* then the calculations involving extra must be made wide too.
*
* Noted with Win32/MSVC debug build treating the warning (possible of
* data in __int64 to int conversion) as error.
*/
/* Note that going with int for extra assumes that inBytes is not too
* much over toRead to require a wide itself. If that gets violated
* then the calculations involving extra must be made wide too.
*
* Noted with Win32/MSVC debug build treating the warning (possible of
* data in long long to int conversion) as error.
*/
bufPtr = AllocChannelBuffer(extra);
@@ -11068,7 +11068,7 @@ FixLevelCode(
* information. Hence an error means that we've got serious breakage.
*/
res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
res = TclListObjGetElements(NULL, msg, &lc, &lv);
if (res != TCL_OK) {
Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
}
+5 -5
View File
@@ -108,7 +108,7 @@ typedef struct ResultBuffer ResultBuffer;
static inline void ResultClear(ResultBuffer *r);
static inline void ResultInit(ResultBuffer *r);
static inline int ResultEmpty(ResultBuffer *r);
static inline int ResultCopy(ResultBuffer *r, unsigned char *buf,
static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf,
size_t toRead);
static inline void ResultAdd(ResultBuffer *r, unsigned char *buf,
size_t toWrite);
@@ -274,7 +274,7 @@ TclChannelTransform(
return TCL_ERROR;
}
if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) {
if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("-command value is not a list", -1));
return TCL_ERROR;
@@ -1368,13 +1368,13 @@ ResultEmpty(
*----------------------------------------------------------------------
*/
static inline int
static inline size_t
ResultCopy(
ResultBuffer *r, /* The buffer to read from. */
unsigned char *buf, /* The buffer to copy into. */
size_t toRead) /* Number of requested bytes. */
{
if (r->used == 0) {
if (ResultEmpty(r)) {
/*
* Nothing to copy in the case of an empty buffer.
*/
@@ -1431,7 +1431,7 @@ ResultAdd(
unsigned char *buf, /* The buffer to read from. */
size_t toWrite) /* The number of bytes in 'buf'. */
{
if (r->used + toWrite > r->allocated) {
if ((r->used + toWrite + 1) > r->allocated) {
/*
* Extension of the internal buffer is required.
*/
+42 -42
View File
@@ -31,35 +31,35 @@
* Signatures of all functions used in the C layer of the reflection.
*/
static int ReflectClose(ClientData clientData,
static int ReflectClose(void *clientData,
Tcl_Interp *interp, int flags);
static int ReflectInput(ClientData clientData, char *buf,
static int ReflectInput(void *clientData, char *buf,
int toRead, int *errorCodePtr);
static int ReflectOutput(ClientData clientData, const char *buf,
static int ReflectOutput(void *clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
static void ReflectWatch(void *clientData, int mask);
static int ReflectBlock(void *clientData, int mode);
#if TCL_THREADS
static void ReflectThread(ClientData clientData, int action);
static void ReflectThread(void *clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
static int ReflectEventDelete(Tcl_Event *ev, void *cd);
#endif
static long long ReflectSeekWide(ClientData clientData,
static long long ReflectSeekWide(void *clientData,
long long offset, int mode, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int ReflectSeek(ClientData clientData, long offset,
static int ReflectSeek(void *clientData, long offset,
int mode, int *errorCodePtr);
#endif
static int ReflectGetOption(ClientData clientData,
static int ReflectGetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(ClientData clientData,
static int ReflectSetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static int ReflectTruncate(ClientData clientData,
static int ReflectTruncate(void *clientData,
long long length);
static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
static void TimerRunRead(void *clientData);
static void TimerRunWrite(void *clientData);
/*
* The C layer channel type/driver definition used by the reflection.
@@ -220,7 +220,7 @@ typedef enum {
#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
#define HAS(x,f) ((x) & FLAG(f))
#if TCL_THREADS
/*
@@ -408,7 +408,7 @@ TCL_DECLARE_MUTEX(rcForwardMutex)
static void ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
static void SrcExitProc(void *clientData);
#define FreeReceivedError(p) \
if ((p)->base.mustFree) { \
@@ -507,7 +507,7 @@ static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo
int
TclChanCreateObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -616,7 +616,7 @@ TclChanCreateObjCmd(
* Compare open mode against optional r/w.
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
@@ -809,7 +809,7 @@ ReflectEventRun(
static int
ReflectEventDelete(
Tcl_Event *ev,
ClientData cd)
void *cd)
{
/* OWNER thread
*
@@ -829,7 +829,7 @@ ReflectEventDelete(
int
TclChanPostEventObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -1012,7 +1012,7 @@ TclChanPostEventObjCmd(
static void
TimerRunRead(
ClientData clientData)
void *clientData)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
rcPtr->readTimer = NULL;
@@ -1021,7 +1021,7 @@ TimerRunRead(
static void
TimerRunWrite(
ClientData clientData)
void *clientData)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
rcPtr->writeTimer = NULL;
@@ -1072,7 +1072,7 @@ UnmarshallErrorResult(
* information; if we panic here, something has gone badly wrong already.
*/
if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
@@ -1169,7 +1169,7 @@ TclChanCaughtErrorBypass(
static int
ReflectClose(
ClientData clientData,
void *clientData,
Tcl_Interp *interp,
int flags)
{
@@ -1329,7 +1329,7 @@ ReflectClose(
static int
ReflectInput(
ClientData clientData,
void *clientData,
char *buf,
int toRead,
int *errorCodePtr)
@@ -1436,7 +1436,7 @@ ReflectInput(
static int
ReflectOutput(
ClientData clientData,
void *clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
@@ -1565,7 +1565,7 @@ ReflectOutput(
static long long
ReflectSeekWide(
ClientData clientData,
void *clientData,
long long offset,
int seekMode,
int *errorCodePtr)
@@ -1642,7 +1642,7 @@ ReflectSeekWide(
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
ClientData clientData,
void *clientData,
long offset,
int seekMode,
int *errorCodePtr)
@@ -1678,7 +1678,7 @@ ReflectSeek(
static void
ReflectWatch(
ClientData clientData,
void *clientData,
int mask)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1750,7 +1750,7 @@ ReflectWatch(
static int
ReflectBlock(
ClientData clientData,
void *clientData,
int nonblocking)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1817,7 +1817,7 @@ ReflectBlock(
static void
ReflectThread(
ClientData clientData,
void *clientData,
int action)
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -1854,7 +1854,7 @@ ReflectThread(
static int
ReflectSetOption(
ClientData clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
@@ -1926,7 +1926,7 @@ ReflectSetOption(
static int
ReflectGetOption(
ClientData clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
@@ -2020,7 +2020,7 @@ ReflectGetOption(
* result is a valid list. Nor that the list has an even number elements.
*/
if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) {
goto error;
}
@@ -2078,7 +2078,7 @@ ReflectGetOption(
static int
ReflectTruncate(
ClientData clientData, /* Channel to query */
void *clientData, /* Channel to query */
long long length) /* Length to truncate to. */
{
ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
@@ -2111,7 +2111,7 @@ ReflectTruncate(
Tcl_Preserve(rcPtr);
lenObj = Tcl_NewIntObj(length);
lenObj = Tcl_NewWideIntObj(length);
Tcl_IncrRefCount(lenObj);
if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
@@ -2166,7 +2166,7 @@ EncodeEventMask(
int evIndex; /* Id of event for an element of the eventspec
* list. */
if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2644,7 +2644,7 @@ MarkDead(
static void
DeleteReflectedChannelMap(
ClientData clientData, /* The per-interpreter data structure. */
void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
@@ -2823,7 +2823,7 @@ GetThreadReflectedChannelMap(void)
static void
DeleteThreadReflectedChannelMap(
TCL_UNUSED(ClientData))
TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -3331,7 +3331,7 @@ ForwardProc(
int listc;
Tcl_Obj **listv;
if (Tcl_ListObjGetElements(interp, resObj, &listc,
if (TclListObjGetElements(interp, resObj, &listc,
&listv) != TCL_OK) {
Tcl_DecrRefCount(resObj);
resObj = MarshallError(interp);
@@ -3361,7 +3361,7 @@ ForwardProc(
break;
case ForwardedTruncate: {
Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length);
Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length);
Tcl_IncrRefCount(lenObj);
Tcl_Preserve(rcPtr);
@@ -3409,7 +3409,7 @@ ForwardProc(
static void
SrcExitProc(
ClientData clientData)
void *clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
ForwardingResult *resultPtr;
+52 -52
View File
@@ -31,29 +31,29 @@
* Signatures of all functions used in the C layer of the reflection.
*/
static int ReflectClose(ClientData clientData,
static int ReflectClose(void *clientData,
Tcl_Interp *interp, int flags);
static int ReflectInput(ClientData clientData, char *buf,
static int ReflectInput(void *clientData, char *buf,
int toRead, int *errorCodePtr);
static int ReflectOutput(ClientData clientData, const char *buf,
static int ReflectOutput(void *clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
static long long ReflectSeekWide(ClientData clientData,
static void ReflectWatch(void *clientData, int mask);
static int ReflectBlock(void *clientData, int mode);
static long long ReflectSeekWide(void *clientData,
long long offset, int mode, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int ReflectSeek(ClientData clientData, long offset,
static int ReflectSeek(void *clientData, long offset,
int mode, int *errorCodePtr);
#endif
static int ReflectGetOption(ClientData clientData,
static int ReflectGetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(ClientData clientData,
static int ReflectSetOption(void *clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
static int ReflectHandle(ClientData clientData, int direction,
ClientData *handle);
static int ReflectNotify(ClientData clientData, int mask);
static int ReflectHandle(void *clientData, int direction,
void **handle);
static int ReflectNotify(void *clientData, int mask);
/*
* The C layer channel type/driver definition used by the reflection.
@@ -91,20 +91,20 @@ static const Tcl_ChannelType tclRTransformType = {
typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
int allocated; /* Allocated size of the buffer area. */
int used; /* Number of bytes in the buffer,
size_t allocated; /* Allocated size of the buffer area. */
size_t used; /* Number of bytes in the buffer,
* <= allocated. */
} ResultBuffer;
#define ResultLength(r) ((r)->used)
/* static int ResultLength(ResultBuffer *r); */
static void ResultClear(ResultBuffer *r);
static void ResultInit(ResultBuffer *r);
static void ResultAdd(ResultBuffer *r, unsigned char *buf,
int toWrite);
static int ResultCopy(ResultBuffer *r, unsigned char *buf,
int toRead);
static inline void ResultClear(ResultBuffer *r);
static inline void ResultInit(ResultBuffer *r);
static inline void ResultAdd(ResultBuffer *r, unsigned char *buf,
size_t toWrite);
static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf,
size_t toRead);
#define RB_INCREMENT (512)
@@ -220,7 +220,7 @@ typedef enum {
#define IMPLIES(a,b) ((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
#define HAS(x,f) ((x) & FLAG(f))
#if TCL_THREADS
/*
@@ -363,7 +363,7 @@ TCL_DECLARE_MUTEX(rtForwardMutex)
static void ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
ForwardedOperation op, const void *param);
static int ForwardProc(Tcl_Event *evPtr, int mask);
static void SrcExitProc(ClientData clientData);
static void SrcExitProc(void *clientData);
#define FreeReceivedError(p) \
do { \
@@ -402,7 +402,7 @@ static void ForwardSetObjError(ForwardParam *p,
Tcl_Obj *objPtr);
static ReflectedTransformMap * GetThreadReflectedTransformMap(void);
static void DeleteThreadReflectedTransformMap(
ClientData clientData);
void *clientData);
#endif /* TCL_THREADS */
#define SetChannelErrorStr(c,msgStr) \
@@ -428,7 +428,7 @@ static int InvokeTclMethod(ReflectedTransform *rtPtr,
Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
static ReflectedTransformMap * GetReflectedTransformMap(Tcl_Interp *interp);
static void DeleteReflectedTransformMap(ClientData clientData,
static void DeleteReflectedTransformMap(void *clientData,
Tcl_Interp *interp);
/*
@@ -458,7 +458,7 @@ static const char *msg_dstlost =
static void TimerKill(ReflectedTransform *rtPtr);
static void TimerSetup(ReflectedTransform *rtPtr);
static void TimerRun(ClientData clientData);
static void TimerRun(void *clientData);
static int TransformRead(ReflectedTransform *rtPtr,
int *errorCodePtr, Tcl_Obj *bufObj);
static int TransformWrite(ReflectedTransform *rtPtr,
@@ -503,7 +503,7 @@ static int TransformLimit(ReflectedTransform *rtPtr,
int
TclChanPushObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -607,7 +607,7 @@ TclChanPushObjCmd(
* through the mask. Compare open mode against optional r/w.
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
TclGetString(cmdObj), TclGetString(resObj)));
@@ -748,7 +748,7 @@ TclChanPushObjCmd(
int
TclChanPopObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
@@ -843,7 +843,7 @@ UnmarshallErrorResult(
* information; if we panic here, something has gone badly wrong already.
*/
if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
}
if (interp == NULL) {
@@ -884,7 +884,7 @@ UnmarshallErrorResult(
static int
ReflectClose(
ClientData clientData,
void *clientData,
Tcl_Interp *interp,
int flags)
{
@@ -1063,7 +1063,7 @@ ReflectClose(
static int
ReflectInput(
ClientData clientData,
void *clientData,
char *buf,
int toRead,
int *errorCodePtr)
@@ -1256,7 +1256,7 @@ ReflectInput(
static int
ReflectOutput(
ClientData clientData,
void *clientData,
const char *buf,
int toWrite,
int *errorCodePtr)
@@ -1329,7 +1329,7 @@ ReflectOutput(
static long long
ReflectSeekWide(
ClientData clientData,
void *clientData,
long long offset,
int seekMode,
int *errorCodePtr)
@@ -1411,7 +1411,7 @@ ReflectSeekWide(
#ifndef TCL_NO_DEPRECATED
static int
ReflectSeek(
ClientData clientData,
void *clientData,
long offset,
int seekMode,
int *errorCodePtr)
@@ -1447,7 +1447,7 @@ ReflectSeek(
static void
ReflectWatch(
ClientData clientData,
void *clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
@@ -1498,7 +1498,7 @@ ReflectWatch(
static int
ReflectBlock(
ClientData clientData,
void *clientData,
int nonblocking)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
@@ -1531,7 +1531,7 @@ ReflectBlock(
static int
ReflectSetOption(
ClientData clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of requested option */
const char *newValue) /* The new value */
@@ -1573,7 +1573,7 @@ ReflectSetOption(
static int
ReflectGetOption(
ClientData clientData, /* Channel to query */
void *clientData, /* Channel to query */
Tcl_Interp *interp, /* Interpreter to leave error messages in */
const char *optionName, /* Name of reuqested option */
Tcl_DString *dsPtr) /* String to place the result into */
@@ -1622,9 +1622,9 @@ ReflectGetOption(
static int
ReflectHandle(
ClientData clientData,
void *clientData,
int direction,
ClientData *handlePtr)
void **handlePtr)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
@@ -1658,7 +1658,7 @@ ReflectHandle(
static int
ReflectNotify(
ClientData clientData,
void *clientData,
int mask)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
@@ -1796,7 +1796,7 @@ NewReflectedTransform(
/* ASSERT: cmdpfxObj is a Tcl List */
Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);
TclListObjGetElements(interp, cmdpfxObj, &listc, &listv);
/*
* See [==] as well.
@@ -2147,7 +2147,7 @@ GetReflectedTransformMap(
static void
DeleteReflectedTransformMap(
ClientData clientData, /* The per-interpreter data structure. */
void *clientData, /* The per-interpreter data structure. */
Tcl_Interp *interp) /* The interpreter being deleted. */
{
ReflectedTransformMap *rtmPtr; /* The map */
@@ -2310,7 +2310,7 @@ GetThreadReflectedTransformMap(void)
static void
DeleteThreadReflectedTransformMap(
TCL_UNUSED(ClientData))
TCL_UNUSED(void *))
{
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -2759,7 +2759,7 @@ ForwardProc(
static void
SrcExitProc(
ClientData clientData)
void *clientData)
{
ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
ForwardingResult *resultPtr;
@@ -2899,7 +2899,7 @@ TimerSetup(
static void
TimerRun(
ClientData clientData)
void *clientData)
{
ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
@@ -2924,7 +2924,7 @@ TimerRun(
*----------------------------------------------------------------------
*/
static void
static inline void
ResultInit(
ResultBuffer *rPtr) /* Reference to the structure to
* initialize. */
@@ -2949,7 +2949,7 @@ ResultInit(
*----------------------------------------------------------------------
*/
static void
static inline void
ResultClear(
ResultBuffer *rPtr) /* Reference to the buffer to clear out */
{
@@ -2980,11 +2980,11 @@ ResultClear(
*----------------------------------------------------------------------
*/
static void
static inline void
ResultAdd(
ResultBuffer *rPtr, /* The buffer to extend */
unsigned char *buf, /* The buffer to read from */
int toWrite) /* The number of bytes in 'buf' */
size_t toWrite) /* The number of bytes in 'buf' */
{
if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
/*
@@ -3028,11 +3028,11 @@ ResultAdd(
*----------------------------------------------------------------------
*/
static int
static inline size_t
ResultCopy(
ResultBuffer *rPtr, /* The buffer to read from */
unsigned char *buf, /* The buffer to copy into */
int toRead) /* Number of requested bytes */
size_t toRead) /* Number of requested bytes */
{
int copied;
+5 -5
View File
@@ -1065,7 +1065,7 @@ Tcl_FSMatchInDirectory(
* resultPtr and tmpResultPtr are guaranteed to be distinct.
*/
ret = Tcl_ListObjGetElements(interp, tmpResultPtr,
ret = TclListObjGetElements(interp, tmpResultPtr,
&resLength, &elemsPtr);
for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
ret = Tcl_ListObjAppendElement(interp, resultPtr,
@@ -1113,10 +1113,10 @@ FsAddMountsToGlobResult(
return;
}
if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
if (TclListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
goto endOfMounts;
}
if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
if (TclListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
goto endOfMounts;
}
for (i=0 ; i<mLength ; i++) {
@@ -2476,7 +2476,7 @@ TclFSFileAttrIndex(
int i, objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
TclDecrRefCount(listObj);
return TCL_ERROR;
}
@@ -4072,7 +4072,7 @@ TclFSNonnativePathType(
Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
if (thisFsVolumes != NULL) {
if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
if (TclListObjLength(NULL, thisFsVolumes, &numVolumes)
!= TCL_OK) {
/*
* This is VERY bad; the listVolumesProc didn't return a
+24 -22
View File
@@ -25,13 +25,13 @@ static int GetIndexFromObjList(Tcl_Interp *interp,
static void UpdateStringOfIndex(Tcl_Obj *objPtr);
static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void FreeIndex(Tcl_Obj *objPtr);
static int PrefixAllObjCmd(ClientData clientData,
static int PrefixAllObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int PrefixLongestObjCmd(ClientData clientData,
static int PrefixLongestObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int PrefixMatchObjCmd(ClientData clientData,
static int PrefixMatchObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void PrintUsage(Tcl_Interp *interp,
@@ -73,7 +73,7 @@ typedef struct {
#define NEXT_ENTRY(table, offset) \
(&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)
(((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "")
/*
*----------------------------------------------------------------------
@@ -106,7 +106,7 @@ int
Tcl_GetIndexFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
const char *const*tablePtr, /* Array of strings to compare against the
const char *const *tablePtr, /* Array of strings to compare against the
* value of objPtr; last entry must be NULL
* and there must not be duplicate entries. */
const char *msg, /* Identifying word to use in error
@@ -132,7 +132,7 @@ Tcl_GetIndexFromObj(
* on odd platforms like a Cray PVP...
*/
if (indexRep->tablePtr == (void *) tablePtr
if (indexRep->tablePtr == (void *)tablePtr
&& indexRep->offset == sizeof(char *)) {
*indexPtr = indexRep->index;
return TCL_OK;
@@ -190,7 +190,7 @@ GetIndexFromObjList(
* of the code there. This is a bit ineffiecient but simpler.
*/
result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv);
result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv);
if (result != TCL_OK) {
return result;
}
@@ -261,7 +261,7 @@ Tcl_GetIndexFromObjStruct(
int offset, /* The number of bytes between entries */
const char *msg, /* Identifying word to use in error
* messages. */
int flags, /* 0 or TCL_EXACT */
int flags, /* 0, TCL_EXACT or TCL_INDEX_TEMP_TABLE */
int *indexPtr) /* Place to store resulting integer index. */
{
int index, idx, numAbbrev;
@@ -280,11 +280,13 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
if (!(flags & TCL_INDEX_TEMP_TABLE)) {
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
if ((indexRep->tablePtr == tablePtr)
&& (indexRep->offset == offset)
&& (indexRep->index >= 0)) {
*indexPtr = indexRep->index;
return TCL_OK;
}
@@ -296,7 +298,7 @@ Tcl_GetIndexFromObjStruct(
* abbreviations unless TCL_EXACT is set in flags.
*/
key = TclGetString(objPtr);
key = objPtr ? TclGetString(objPtr) : "";
index = -1;
numAbbrev = 0;
@@ -307,7 +309,7 @@ Tcl_GetIndexFromObjStruct(
* - Several abbreviations (never allowed, but overridden by exact match)
*/
for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL;
for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL;
entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
if (*p1 == '\0') {
@@ -344,7 +346,7 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
if (!(flags & TCL_INDEX_TEMP_TABLE)) {
if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
@@ -372,7 +374,7 @@ Tcl_GetIndexFromObjStruct(
int count = 0;
TclNewObj(resultPtr);
entryPtr = (const char* const *)tablePtr;
entryPtr = (const char *const *)tablePtr;
while ((*entryPtr != NULL) && !**entryPtr) {
entryPtr = NEXT_ENTRY(entryPtr, offset);
}
@@ -540,7 +542,7 @@ TclInitPrefixCmd(
static int
PrefixMatchObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -589,7 +591,7 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
i++;
result = Tcl_ListObjLength(interp, objv[i], &errorLength);
result = TclListObjLength(interp, objv[i], &errorLength);
if (result != TCL_OK) {
return TCL_ERROR;
}
@@ -613,7 +615,7 @@ PrefixMatchObjCmd(
* error case regardless of level.
*/
result = Tcl_ListObjLength(interp, tablePtr, &dummyLength);
result = TclListObjLength(interp, tablePtr, &dummyLength);
if (result != TCL_OK) {
return result;
}
@@ -664,7 +666,7 @@ PrefixMatchObjCmd(
static int
PrefixAllObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -678,7 +680,7 @@ PrefixAllObjCmd(
return TCL_ERROR;
}
result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
@@ -721,7 +723,7 @@ PrefixAllObjCmd(
static int
PrefixLongestObjCmd(
TCL_UNUSED(ClientData),
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -735,7 +737,7 @@ PrefixLongestObjCmd(
return TCL_ERROR;
}
result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
if (result != TCL_OK) {
return result;
}
@@ -851,7 +853,7 @@ Tcl_WrongNumArgs(
Tcl_Obj *objPtr;
int i, len, elemLen;
char flags;
Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *)interp;
const char *elementStr;
/*
-5
View File
@@ -1037,11 +1037,6 @@ declare 258 {
}
declare 259 {
unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *lengthPtr)
}
declare 260 {
void TclUnusedStubEntry(void)
}
+30 -17
View File
@@ -4326,7 +4326,7 @@ TclScaleTime(
/*
* Invalidate the string rep first so we can use the bytes value for our
* pointer chain, and signal an obj deletion (as opposed to shimmering) with
* 'length == -1'.
* 'length == TCL_INDEX_NONE'.
* Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
*/
@@ -4338,7 +4338,7 @@ TclScaleTime(
&& ((objPtr)->bytes != &tclEmptyString)) { \
ckfree((objPtr)->bytes); \
} \
(objPtr)->length = -1; \
(objPtr)->length = TCL_INDEX_NONE; \
TclFreeObjStorage(objPtr); \
TclIncrObjsFreed(); \
} else { \
@@ -4360,7 +4360,7 @@ TclScaleTime(
*/
# define TclAllocObjStorageEx(interp, objPtr) \
(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
(objPtr) = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj))
# define TclFreeObjStorageEx(interp, objPtr) \
ckfree(objPtr)
@@ -4486,15 +4486,22 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
/*
*----------------------------------------------------------------
* Macro used by the Tcl core to set a Tcl_Obj's string representation to a
* copy of the "len" bytes starting at "bytePtr". This code works even if the
* byte array contains NULLs as long as the length is correct. Because "len"
* is referenced multiple times, it should be as simple an expression as
* possible. The ANSI C "prototype" for this macro is:
* copy of the "len" bytes starting at "bytePtr". The value of "len" must
* not be negative. When "len" is 0, then it is acceptable to pass
* "bytePtr" = NULL. When "len" > 0, "bytePtr" must not be NULL, and it
* must point to a location from which "len" bytes may be read. These
* constraints are not checked here. The validity of the bytes copied
* as a value string representation is also not verififed. This macro
* must not be called while "objPtr" is being freed or when "objPtr"
* already has a string representation. The caller must use
* this macro properly. Improper use can lead to dangerous results.
* Because "len" is referenced multiple times, take care that it is an
* expression with the same value each use.
*
* The ANSI C "prototype" for this macro is:
*
* MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
*
* This macro should only be called on an unshared objPtr where
* objPtr->typePtr->freeIntRepProc == NULL
*----------------------------------------------------------------
*/
@@ -4503,7 +4510,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((len) + 1); \
(objPtr)->bytes = (char *)ckalloc((len) + 1); \
memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
@@ -4895,6 +4902,9 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
@@ -4920,6 +4930,9 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
#define TclNewIntObj(objPtr, w) \
(objPtr) = Tcl_NewWideIntObj(w)
#define TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
@@ -4932,7 +4945,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
* sizeof(sLiteral "") will fail to compile otherwise.
*/
#define TclNewLiteralStringObj(objPtr, sLiteral) \
TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1)
/*
*----------------------------------------------------------------
@@ -4945,7 +4958,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
*/
#define TclDStringAppendLiteral(dsPtr, sLiteral) \
Tcl_DStringAppend((dsPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))
Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
Tcl_DStringSetLength((dsPtr), 0)
@@ -5086,12 +5099,12 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclIncrObjsAllocated(); \
TclAllocObjStorageEx((interp), (_objPtr)); \
*(void **)&memPtr = (void *) (_objPtr); \
*(void **)&(memPtr) = (void *) (_objPtr); \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \
TclFreeObjStorageEx((interp), (Tcl_Obj *)(memPtr)); \
TclIncrObjsFreed(); \
} while (0)
@@ -5101,12 +5114,12 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_Obj *_objPtr; \
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
TclNewObj(_objPtr); \
*(void **)&memPtr = (void *) _objPtr; \
*(void **)&(memPtr) = (void *)_objPtr; \
} while (0)
#define TclSmallFreeEx(interp, memPtr) \
do { \
Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr; \
Tcl_Obj *_objPtr = (Tcl_Obj *)(memPtr); \
_objPtr->bytes = NULL; \
_objPtr->typePtr = NULL; \
_objPtr->refCount = 1; \
@@ -5179,7 +5192,7 @@ typedef struct NRE_callback {
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
(ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
((ptr) = ((void *)ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr) ckfree(ptr)
#endif
+2 -8
View File
@@ -659,9 +659,6 @@ EXTERN void TclStaticLibrary(Tcl_Interp *interp,
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
/* 259 */
EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, int *lengthPtr);
/* 260 */
EXTERN void TclUnusedStubEntry(void);
typedef struct TclIntStubs {
@@ -927,8 +924,7 @@ typedef struct TclIntStubs {
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */
void (*tclUnusedStubEntry) (void); /* 260 */
void (*tclUnusedStubEntry) (void); /* 259 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
@@ -1374,10 +1370,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclpCreateTemporaryDirectory \
(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclGetBytesFromObj \
(tclIntStubsPtr->tclGetBytesFromObj) /* 259 */
#define TclUnusedStubEntry \
(tclIntStubsPtr->tclUnusedStubEntry) /* 260 */
(tclIntStubsPtr->tclUnusedStubEntry) /* 259 */
#endif /* defined(USE_TCL_STUBS) */
+1 -1
View File
@@ -2418,7 +2418,7 @@ ChildCreate(
int isNew, objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
return NULL;
}
if (objc < 2) {
+1 -1
View File
@@ -947,7 +947,7 @@ LinkTraceProc(
*/
if (linkPtr->flags & LINK_ALLOC_LAST) {
if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
if (TclListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
|| objc != linkPtr->numElems) {
return (char *) "wrong dimension";
}
+29 -16
View File
@@ -28,7 +28,7 @@
* The default prompt used when the user has not overridden it.
*/
#define DEFAULT_PRIMARY_PROMPT "% "
static const char DEFAULT_PRIMARY_PROMPT[] = "% ";
/*
* This file can be compiled on Windows in UNICODE mode, as well as on all
@@ -43,7 +43,7 @@
# define _tcscmp strcmp
#endif
static Tcl_Obj *
static inline Tcl_Obj *
NewNativeObj(
TCHAR *string)
{
@@ -288,6 +288,7 @@ Tcl_MainEx(
* but before starting to execute commands. */
Tcl_Interp *interp)
{
int i=0; /* argv[i] index */
Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
int code, exitCode = 0;
@@ -296,7 +297,13 @@ Tcl_MainEx(
InteractiveState is;
TclpSetInitialEncodings();
TclpFindExecutable((const char *)argv[0]);
if (0 < argc) {
--argc; /* "consume" argv[0] */
++i;
}
TclpFindExecutable ((const char *)argv [0]); /* nb: this could be NULL
* w/ (eg) an empty argv
* supplied to execve() */
Tcl_InitMemory(interp);
@@ -318,18 +325,19 @@ Tcl_MainEx(
* FILENAME
*/
if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
/* mind argc is being adjusted as we proceed */
if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
&& ('-' != argv[3][0])) {
Tcl_Obj *value = NewNativeObj(argv[2]);
Tcl_SetStartupScript(NewNativeObj(argv[3]),
Tcl_GetString(value));
Tcl_DecrRefCount(value);
argc -= 3;
argv += 3;
} else if ((argc > 1) && ('-' != argv[1][0])) {
i += 3;
} else if ((argc >= 1) && ('-' != argv[1][0])) {
Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
argc--;
argv++;
i++;
}
}
@@ -340,14 +348,12 @@ Tcl_MainEx(
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++));
Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++]));
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
@@ -511,7 +517,7 @@ Tcl_MainEx(
* error messages troubles deeper in, so lop it back off.
*/
TclGetStringFromObj(is.commandPtr, &length);
(void)Tcl_GetStringFromObj(is.commandPtr, &length);
Tcl_SetObjLength(is.commandPtr, --length);
code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
TCL_EVAL_GLOBAL);
@@ -528,7 +534,7 @@ Tcl_MainEx(
} else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
TclGetStringFromObj(resultPtr, &length);
(void)Tcl_GetStringFromObj(resultPtr, &length);
chan = Tcl_GetStdChannel(TCL_STDOUT);
if ((length > 0) && chan) {
Tcl_WriteObj(chan, resultPtr);
@@ -731,18 +737,25 @@ StdinProc(
ClientData clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
int code, length;
int code;
int length;
InteractiveState *isPtr = (InteractiveState *)clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
Tcl_DString savedEncoding;
Tcl_DStringInit(&savedEncoding);
Tcl_GetChannelOption(NULL, chan, "-encoding", &savedEncoding);
Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
length = Tcl_GetsObj(chan, commandPtr);
Tcl_SetChannelOption(NULL, chan, "-encoding", Tcl_DStringValue(&savedEncoding));
Tcl_DStringFree(&savedEncoding);
if (length < 0) {
if (Tcl_InputBlocked(chan)) {
return;
@@ -771,7 +784,7 @@ StdinProc(
goto prompt;
}
isPtr->prompt = PROMPT_START;
TclGetStringFromObj(commandPtr, &length);
(void)Tcl_GetStringFromObj(commandPtr, &length);
Tcl_SetObjLength(commandPtr, --length);
/*
@@ -803,7 +816,7 @@ StdinProc(
chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
TclGetStringFromObj(resultPtr, &length);
(void)Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && (chan != NULL)) {
Tcl_WriteObj(chan, resultPtr);
Tcl_WriteChars(chan, "\n", 1);
@@ -866,7 +879,7 @@ Prompt(
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan != NULL) {
Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
strlen(DEFAULT_PRIMARY_PROMPT));
sizeof(DEFAULT_PRIMARY_PROMPT) - 1);
}
}
} else {
+2 -2
View File
@@ -5010,7 +5010,7 @@ TclLogCommandInfo(
int len;
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
@@ -5095,7 +5095,7 @@ TclErrorStackResetIf(
int len;
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
+8 -8
View File
@@ -1065,7 +1065,7 @@ MagicDefinitionInvoke(
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
/* TODO: overflow? */
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
TclListObjGetElements(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
if (isRoot) {
@@ -2372,7 +2372,7 @@ ClassFilterSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
} else if (TclListObjGetElements(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2456,7 +2456,7 @@ ClassMixinSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
} else if (TclListObjGetElements(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2566,7 +2566,7 @@ ClassSuperSet(
"may not modify the superclass of the root object", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &superc,
} else if (TclListObjGetElements(interp, objv[0], &superc,
&superv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2736,7 +2736,7 @@ ClassVarsSet(
"attempt to misuse API", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
} else if (TclListObjGetElements(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2828,7 +2828,7 @@ ObjFilterSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
if (TclListObjGetElements(interp, objv[0], &filterc,
&filterv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2902,7 +2902,7 @@ ObjMixinSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
if (TclListObjGetElements(interp, objv[0], &mixinc,
&mixinv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2992,7 +2992,7 @@ ObjVarsSet(
return TCL_ERROR;
}
objv += Tcl_ObjectContextSkippedArgs(context);
if (Tcl_ListObjGetElements(interp, objv[0], &varc,
if (TclListObjGetElements(interp, objv[0], &varc,
&varv) != TCL_OK) {
return TCL_ERROR;
}
+1 -1
View File
@@ -631,7 +631,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
#define FOREACH(var,ary) \
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
continue; \
} else if (var = (ary).list[i], 1)
} else if ((var) = (ary).list[i], 1)
/*
* A variation where the array is an array of structs. There's no issue with
+5 -5
View File
@@ -339,7 +339,7 @@ TclOONewProcInstanceMethod(
ProcedureMethod *pmPtr;
Tcl_Method method;
if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
}
pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
@@ -397,7 +397,7 @@ TclOONewProcMethod(
TclNewObj(argsObj);
Tcl_IncrRefCount(argsObj);
procName = "<destructor>";
} else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
} else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
return NULL;
} else {
procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
@@ -1389,7 +1389,7 @@ TclOONewForwardInstanceMethod(
int prefixLen;
ForwardMethod *fmPtr;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
@@ -1428,7 +1428,7 @@ TclOONewForwardMethod(
int prefixLen;
ForwardMethod *fmPtr;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
}
if (prefixLen < 1) {
@@ -1476,7 +1476,7 @@ InvokeForwardMethod(
* can ignore here.
*/
Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
numPrefixes, prefixObjs, &len);
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+37 -22
View File
@@ -567,7 +567,7 @@ TclContinuationsEnter(
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int));
ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
if (!newEntry) {
/*
@@ -1815,32 +1815,48 @@ Tcl_InitStringRep(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
/* Allocate */
if (objPtr->bytes == NULL) {
/* Allocate only as empty - extend later if bytes copied */
objPtr->length = 0;
if (numBytes) {
objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
if (objPtr->bytes == NULL) {
return NULL;
}
if (bytes) {
/* Copy */
memcpy(objPtr->bytes, bytes, numBytes);
objPtr->length = (int) numBytes;
}
} else {
/* Start with no string rep */
if (numBytes == 0) {
TclInitStringRep(objPtr, NULL, 0);
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
if (bytes) {
memcpy(objPtr->bytes, bytes, numBytes);
}
objPtr->bytes[objPtr->length] = '\0';
}
}
} else if (objPtr->bytes == &tclEmptyString) {
/* Start with empty string rep (not allocated) */
if (numBytes == 0) {
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
objPtr->bytes[objPtr->length] = '\0';
}
}
} else {
/* objPtr->bytes != NULL bytes == NULL - Truncate */
objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes + 1);
objPtr->length = (int)numBytes;
/* Start with non-empty string rep (allocated) */
if (numBytes == 0) {
ckfree(objPtr->bytes);
TclInitStringRep(objPtr, NULL, 0);
return objPtr->bytes;
} else {
objPtr->bytes = (char *)attemptckrealloc(objPtr->bytes,
numBytes + 1);
if (objPtr->bytes) {
objPtr->length = (int) numBytes;
objPtr->bytes[objPtr->length] = '\0';
}
}
}
/* Terminate */
objPtr->bytes[objPtr->length] = '\0';
return objPtr->bytes;
}
@@ -3517,7 +3533,6 @@ UpdateStringOfBignum(
if (MP_OKAY != mp_to_radix(&bignumVal, stringVal, size, NULL, 10)) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
(void) Tcl_InitStringRep(objPtr, NULL, size - 1);
}
/*
+3 -2
View File
@@ -45,7 +45,8 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
*----------------------------------------------------------------------
*/
void
#undef Tcl_SetPanicProc
const char *
Tcl_SetPanicProc(
TCL_NORETURN1 Tcl_PanicProc *proc)
{
@@ -58,7 +59,7 @@ Tcl_SetPanicProc(
else
#endif
panicProc = proc;
Tcl_InitSubsystems();
return Tcl_InitSubsystems();
}
/*
+5 -4
View File
@@ -812,12 +812,12 @@ Tcl_FSJoinPath(
int objc;
Tcl_Obj **objv;
if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
TclListObjGetElements(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
@@ -836,7 +836,8 @@ TclJoinPath(
assert ( elements >= 0 );
if (elements == 0) {
return Tcl_NewObj();
TclNewObj(res);
return res;
}
assert ( elements > 0 );
@@ -2312,7 +2313,7 @@ SetFsPathFromAny(
Tcl_Obj **objv;
Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL);
Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
TclListObjGetElements(NULL, parts, &objc, &objv);
/*
* Skip '~'. It's replaced by its expansion.
+5 -5
View File
@@ -1359,7 +1359,7 @@ TclNRPackageObjCmd(
objvListPtr = Tcl_NewListObj(0, NULL);
Tcl_IncrRefCount(objvListPtr);
Tcl_ListObjAppendElement(interp, objvListPtr, ov);
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp,
TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
@@ -1386,7 +1386,7 @@ TclNRPackageObjCmd(
Tcl_ListObjAppendElement(interp, objvListPtr,
Tcl_DuplicateObj(newobjv[i]));
}
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
Tcl_NRAddCallback(interp,
TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL);
Tcl_NRAddCallback(interp,
@@ -1696,7 +1696,7 @@ CheckVersionAndConvert(
*ip++ = *p;
for (prevChar = *p, p++; *p != 0; p++) {
for (prevChar = *p, p++; (*p != 0) && (*p != '+'); p++) {
if (!isdigit(UCHAR(*p)) && /* INTL: digit */
((*p!='.' && *p!='a' && *p!='b') ||
((hasunstable && (*p=='a' || *p=='b')) ||
@@ -2000,10 +2000,10 @@ CheckRequirement(
char *dash = NULL, *buf;
dash = (char *)strchr(string, '-');
dash = strchr(string, '+') ? NULL : (char *)strchr(string, '-');
if (dash == NULL) {
/*
* No dash found, has to be a simple version.
* '+' found or no dash found: has to be a simple version.
*/
return CheckVersionAndConvert(interp, string, NULL, NULL);
+2
View File
@@ -93,6 +93,7 @@
#endif
static Tcl_Config const cfg[] = {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"debug", CFG_DEBUG},
{"threaded", CFG_THREADED},
{"profiled", CFG_PROFILED},
@@ -101,6 +102,7 @@ static Tcl_Config const cfg[] = {
{"mem_debug", CFG_MEMDEBUG},
{"compile_debug", CFG_COMPILE_DEBUG},
{"compile_stats", CFG_COMPILE_STATS},
#endif
/* Runtime paths to various stuff */
+6 -6
View File
@@ -484,7 +484,7 @@ TclCreateProc(
* in the Proc.
*/
result = Tcl_ListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
result = TclListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
if (result != TCL_OK) {
goto procError;
}
@@ -514,7 +514,7 @@ TclCreateProc(
* Now divide the specifier up into name and default.
*/
result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,
result = TclListObjGetElements(interp, argArray[i], &fieldCount,
&fieldValues);
if (result != TCL_OK) {
goto procError;
@@ -529,7 +529,7 @@ TclCreateProc(
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
if ((fieldCount == 0) || (fieldValues[0]->length == 0)) {
if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
@@ -633,7 +633,7 @@ TclCreateProc(
*/
localPtr = (CompiledLocal *)ckalloc(
offsetof(CompiledLocal, name) + fieldValues[0]->length + 1);
offsetof(CompiledLocal, name) + 1U + fieldValues[0]->length);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -920,7 +920,7 @@ TclNRUplevelObjCmd(
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
int status ,llength;
status = Tcl_ListObjLength(interp, objv[1], &llength);
status = TclListObjLength(interp, objv[1], &llength);
if (status == TCL_OK && llength > 1) {
/* the first argument can't interpreted as a level. Avoid
* generating a string representation of the script. */
@@ -1438,7 +1438,6 @@ InitArgsAndLocals(
numArgs = procPtr->numArgs;
argCt = framePtr->objc - skip; /* Set it to the number of args to the
* procedure. */
argObjs = framePtr->objv + skip;
if (numArgs == 0) {
if (argCt) {
goto incorrectArgs;
@@ -1446,6 +1445,7 @@ InitArgsAndLocals(
goto correctArgs;
}
}
argObjs = framePtr->objv + skip;
imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
/*
+2 -2
View File
@@ -533,7 +533,7 @@ ProcessStatusObjCmd(
* Only return statuses of provided processes.
*/
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
@@ -648,7 +648,7 @@ ProcessPurgeObjCmd(
* Purge only provided processes.
*/
result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs);
if (result != TCL_OK) {
return result;
}
+1 -1
View File
@@ -677,7 +677,7 @@ TclRegAbout(
*/
TclNewObj(resultObj);
TclNewIntObj(infoObj, regexpPtr->re.re_nsub);
TclNewIndexObj(infoObj, regexpPtr->re.re_nsub);
Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
/*
+4 -4
View File
@@ -1328,12 +1328,12 @@ TclProcessReturn(
* if someone does [return -errorstack [info errorstack]]
*/
if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc,
if (TclListObjGetElements(interp, valuePtr, &valueObjc,
&valueObjv) == TCL_ERROR) {
return TCL_ERROR;
}
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
TclListObjLength(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
@@ -1490,7 +1490,7 @@ TclMergeReturnOptions(
if (valuePtr != NULL) {
int length;
if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorcode.
*/
@@ -1512,7 +1512,7 @@ TclMergeReturnOptions(
if (valuePtr != NULL) {
int length;
if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorstack.
*/
+2 -2
View File
@@ -34,7 +34,7 @@ typedef struct {
Tcl_UniChar end;
} Range;
typedef struct CharSet {
typedef struct {
int exclude; /* 1 if this is an exclusion set. */
int nchars;
Tcl_UniChar *chars;
@@ -1089,7 +1089,7 @@ Tcl_ScanObjCmd(
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
TclNewIntObj(objPtr, TCL_INDEX_NONE);
TclNewIndexObj(objPtr, TCL_INDEX_NONE);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
+69 -16
View File
@@ -721,9 +721,9 @@ TclParseNumber(
if (!octalSignificandOverflow) {
/*
* Shifting by more bits than are in the value being
* shifted is at least de facto nonportable. Check for
* too large shifts first.
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if ((octalSignificandWide != 0)
@@ -737,8 +737,17 @@ TclParseNumber(
}
}
if (!octalSignificandOverflow) {
octalSignificandWide =
(octalSignificandWide << shift) + (c - '0');
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (octalSignificandWide != 0) {
octalSignificandWide <<= shift;
}
octalSignificandWide += c - '0';
} else {
if (err == MP_OKAY) {
err = mp_mul_2d(&octalSignificandBig, shift,
@@ -863,9 +872,9 @@ TclParseNumber(
shift = 4 * (numTrailZeros + 1);
if (!significandOverflow) {
/*
* Shifting by more bits than are in the value being
* shifted is at least de facto nonportable. Check for too
* large shifts first.
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if (significandWide != 0 &&
@@ -877,7 +886,17 @@ TclParseNumber(
}
}
if (!significandOverflow) {
significandWide = (significandWide << shift) + d;
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
significandWide += d;
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
if (err == MP_OKAY) {
@@ -917,9 +936,9 @@ TclParseNumber(
shift = numTrailZeros + 1;
if (!significandOverflow) {
/*
* Shifting by more bits than are in the value being
* shifted is at least de facto nonportable. Check for too
* large shifts first.
* Shifting by as many or more bits than are in the
* value being shifted is undefined behavior. Check
* for too large shifts first.
*/
if (significandWide != 0 &&
@@ -931,7 +950,17 @@ TclParseNumber(
}
}
if (!significandOverflow) {
significandWide = (significandWide << shift) + 1;
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
significandWide += 1;
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
if (err == MP_OKAY) {
@@ -1330,7 +1359,15 @@ TclParseNumber(
}
if (shift) {
if (!significandOverflow) {
significandWide <<= shift;
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
}
@@ -1354,7 +1391,15 @@ TclParseNumber(
}
if (shift) {
if (!significandOverflow) {
significandWide <<= shift;
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (significandWide != 0) {
significandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&significandBig, shift, &significandBig);
}
@@ -1379,7 +1424,15 @@ TclParseNumber(
}
if (shift) {
if (!octalSignificandOverflow) {
octalSignificandWide <<= shift;
/*
* When the significand is 0, it is possible for the
* amount to be shifted to equal or exceed the width
* of the significand. Do not shift when the
* significand is 0 to avoid undefined behavior.
*/
if (octalSignificandWide != 0) {
octalSignificandWide <<= shift;
}
} else if (err == MP_OKAY) {
err = mp_mul_2d(&octalSignificandBig, shift,
&octalSignificandBig);
+27 -21
View File
@@ -148,7 +148,7 @@ GrowStringBuffer(
if (flag == 0 || stringPtr->allocated > 0) {
if (needed <= INT_MAX / 2) {
attempt = 2 * needed;
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U);
}
if (ptr == NULL) {
/*
@@ -161,7 +161,7 @@ GrowStringBuffer(
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U);
}
}
if (ptr == NULL) {
@@ -170,7 +170,7 @@ GrowStringBuffer(
*/
attempt = needed;
ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1);
ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1U);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
@@ -485,7 +485,7 @@ TclCheckEmptyString(
}
if (TclListObjIsCanonical(objPtr)) {
Tcl_ListObjLength(NULL, objPtr, &length);
TclListObjLength(NULL, objPtr, &length);
return length == 0;
}
@@ -698,8 +698,7 @@ TclGetUnicodeFromObj(
*
* Create a Tcl Object that contains the chars between first and last of
* the object indicated by "objPtr". If the object is not already a
* String object, convert it to one. The first and last indices are
* assumed to be in the appropriate range.
* String object, convert it to one.
*
* Results:
* Returns a new Tcl Object of the String type.
@@ -732,11 +731,12 @@ Tcl_GetRange(
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (last >= length) {
if (last < 0 || last >= length) {
last = length - 1;
}
if (last < first) {
return Tcl_NewObj();
TclNewObj(newObjPtr);
return newObjPtr;
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
@@ -757,13 +757,14 @@ Tcl_GetRange(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last >= stringPtr->numChars) {
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last < first) {
return Tcl_NewObj();
TclNewObj(newObjPtr);
return newObjPtr;
}
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);
/*
* Since we know the char length of the result, store it.
@@ -777,11 +778,12 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (last > stringPtr->numChars) {
last = stringPtr->numChars;
if (last < 0 || last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last < first) {
return Tcl_NewObj();
TclNewObj(newObjPtr);
return newObjPtr;
}
#if TCL_UTF_MAX <= 3
/* See: bug [11ae2be95dac9417] */
@@ -1674,10 +1676,10 @@ AppendUtfToUtfRep(
objPtr->length = 0;
}
oldLength = objPtr->length;
newLength = numBytes + oldLength;
if (newLength < 0) {
if (numBytes > INT_MAX - oldLength) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
newLength = numBytes + oldLength;
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
@@ -1689,8 +1691,8 @@ AppendUtfToUtfRep(
* the reallocs below.
*/
if (bytes && bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
if (bytes && objPtr->bytes && (bytes >= objPtr->bytes)
&& (bytes <= objPtr->bytes + objPtr->length)) {
offset = bytes - objPtr->bytes;
}
@@ -2085,7 +2087,11 @@ Tcl_AppendFormatToObj(
if (gotPrecision) {
numChars = Tcl_GetCharLength(segment);
if (precision < numChars) {
segment = Tcl_GetRange(segment, 0, precision - 1);
if (precision < 1) {
TclNewObj(segment);
} else {
segment = Tcl_GetRange(segment, 0, precision - 1);
}
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
@@ -3688,7 +3694,7 @@ TclStringFirst(
}
}
firstEnd:
TclNewIntObj(result, value);
TclNewIndexObj(result, value);
return result;
}
@@ -3775,7 +3781,7 @@ TclStringLast(
checkStr--;
}
lastEnd:
TclNewIntObj(result, value);
TclNewIndexObj(result, value);
return result;
}
+1 -1
View File
@@ -67,7 +67,7 @@ typedef struct {
#define STRING_MAXCHARS \
(int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
(offsetof(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
(offsetof(String, unicode) + (((numChars) + 1U) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
+3 -4
View File
@@ -1041,8 +1041,7 @@ static const TclIntStubs tclIntStubs = {
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
TclGetBytesFromObj, /* 259 */
TclUnusedStubEntry, /* 260 */
TclUnusedStubEntry, /* 259 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
@@ -1933,8 +1932,8 @@ const TclStubs tclStubs = {
Tcl_UtfToUniChar, /* 646 */
Tcl_UniCharToUtfDString, /* 647 */
Tcl_UtfToUniCharDString, /* 648 */
0, /* 649 */
0, /* 650 */
TclGetBytesFromObj, /* 649 */
Tcl_GetBytesFromObj, /* 650 */
TclGetStringFromObj, /* 651 */
TclGetUnicodeFromObj, /* 652 */
TclGetByteArrayFromObj, /* 653 */
+54 -94
View File
@@ -225,7 +225,6 @@ static Tcl_CmdProc TestcreatecommandCmd;
static Tcl_CmdProc TestdcallCmd;
static Tcl_CmdProc TestdelCmd;
static Tcl_CmdProc TestdelassocdataCmd;
static Tcl_ObjCmdProc TestdebugObjCmd;
static Tcl_ObjCmdProc TestdoubledigitsObjCmd;
static Tcl_CmdProc TestdstringCmd;
static Tcl_ObjCmdProc TestencodingObjCmd;
@@ -264,7 +263,6 @@ static Tcl_ObjCmdProc TestparsevarObjCmd;
static Tcl_ObjCmdProc TestparsevarnameObjCmd;
static Tcl_ObjCmdProc TestpreferstableObjCmd;
static Tcl_ObjCmdProc TestprintObjCmd;
static Tcl_ObjCmdProc TestpurifyObjCmd;
static Tcl_ObjCmdProc TestregexpObjCmd;
static Tcl_ObjCmdProc TestreturnObjCmd;
static void TestregexpXflags(const char *string,
@@ -329,12 +327,13 @@ static Tcl_ObjCmdProc TestNumUtfCharsCmd;
static Tcl_ObjCmdProc TestFindFirstCmd;
static Tcl_ObjCmdProc TestFindLastCmd;
static Tcl_ObjCmdProc TestHashSystemHashCmd;
static Tcl_ObjCmdProc TestGetIntForIndexCmd;
static Tcl_NRPostProc NREUnwind_callback;
static Tcl_ObjCmdProc TestNREUnwind;
static Tcl_ObjCmdProc TestNRELevels;
static Tcl_ObjCmdProc TestInterpResolverCmd;
#if defined(HAVE_CPUID) || defined(_WIN32)
#if defined(HAVE_CPUID)
static Tcl_ObjCmdProc TestcpuidCmd;
#endif
@@ -504,8 +503,6 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
NULL, NULL);
@@ -570,8 +567,6 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
@@ -604,6 +599,8 @@ Tcltest_Init(
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetintforindex",
TestGetIntForIndexCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
@@ -619,7 +616,7 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
#if defined(HAVE_CPUID)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
NULL, NULL);
#endif
@@ -1623,7 +1620,7 @@ TestdoubledigitsObjCmd(
int objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
{
static const char* options[] = {
static const char *options[] = {
"shortest",
"e",
"f",
@@ -1642,8 +1639,8 @@ TestdoubledigitsObjCmd(
int type;
int decpt;
int signum;
char* str;
char* endPtr;
char *str;
char *endPtr;
Tcl_Obj* strObj;
Tcl_Obj* retval;
@@ -1758,7 +1755,7 @@ TestdstringCmd(
strcpy(s, "This is a malloc-ed string");
Tcl_SetResult(interp, s, TCL_DYNAMIC);
} else if (strcmp(argv[2], "special") == 0) {
char *s = (char*)ckalloc(100) + 16;
char *s = (char *)ckalloc(100) + 16;
strcpy(s, "This is a specially-allocated string");
Tcl_SetResult(interp, s, SpecialFree);
} else {
@@ -3356,40 +3353,6 @@ TestlocaleCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestdebugObjCmd --
*
* Implements the "testdebug" command, to detect whether Tcl was built with
* --enabble-symbols.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TestdebugObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
#if defined(NDEBUG) && NDEBUG == 1
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
#else
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
#endif
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -3614,8 +3577,9 @@ PrintParse(
Tcl_NewIntObj(tokenPtr->numComponents));
}
Tcl_ListObjAppendElement(NULL, objPtr,
parsePtr->commandStart ?
Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
-1));
-1) : Tcl_NewObj());
}
/*
@@ -3791,40 +3755,6 @@ TestprintObjCmd(
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestpurifyObjCmd --
*
* Implements the "testpurify" command, to detect whether Tcl was built with
* -DPURIFY.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TestpurifyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
#ifdef PURIFY
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
#else
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
#endif
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -4039,7 +3969,7 @@ TestregexpObjCmd(
if (ii == -1) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
newPtr = Tcl_GetRange(objPtr, start, end);
} else if (ii > info.nsubs) {
} else if (ii > info.nsubs || info.matches[ii].end <= 0) {
newPtr = Tcl_NewObj();
} else {
newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
@@ -5135,7 +5065,7 @@ TestbytestringObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int n = 0;
size_t n = 0;
const char *p;
if (objc != 2) {
@@ -5143,7 +5073,7 @@ TestbytestringObjCmd(
return TCL_ERROR;
}
p = (const char *)TclGetBytesFromObj(interp, objv[1], &n);
p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n);
if (p == NULL) {
return TCL_ERROR;
}
@@ -6357,21 +6287,24 @@ TestGetIndexFromObjStructObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *const ary[] = {
"a", "b", "c", "d", "e", "f", NULL, NULL
"a", "b", "c", "d", "ee", "ff", NULL, NULL
};
int idx,target;
int idx,target, flags = 0;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
"dummy", 0, &idx) != TCL_OK) {
if (objc != 3 && objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?");
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) {
return TCL_ERROR;
}
if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) {
return TCL_ERROR;
}
if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *),
"dummy", flags, &idx) != TCL_OK) {
return TCL_ERROR;
}
if (idx != target) {
char buffer[64];
sprintf(buffer, "%d", idx);
@@ -6381,7 +6314,7 @@ TestGetIndexFromObjStructObjCmd(
Tcl_AppendResult(interp, " when ", buffer, " expected", NULL);
return TCL_ERROR;
}
Tcl_WrongNumArgs(interp, 3, objv, NULL);
Tcl_WrongNumArgs(interp, objc, objv, NULL);
return TCL_OK;
}
@@ -7106,7 +7039,34 @@ TestFindLastCmd(
return TCL_OK;
}
#if defined(HAVE_CPUID) || defined(_WIN32)
static int
TestGetIntForIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_WideInt endvalue;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "index endvalue");
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &endvalue) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetIntForIndex(interp, objv[1], endvalue, &result) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
#if defined(HAVE_CPUID)
/*
*----------------------------------------------------------------------
*
+8 -8
View File
@@ -948,8 +948,8 @@ Tcl_AfterObjCmd(
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
"after#%d", afterPtr->id));
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
"after#%d", afterPtr->id));
}
}
Tcl_SetObjResult(interp, resultObj);
@@ -968,15 +968,15 @@ Tcl_AfterObjCmd(
Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
return TCL_ERROR;
} else {
Tcl_Obj *resultListPtr;
Tcl_Obj *resultListPtr;
TclNewObj(resultListPtr);
Tcl_ListObjAppendElement(interp, resultListPtr,
afterPtr->commandPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
TclNewObj(resultListPtr);
Tcl_ListObjAppendElement(interp, resultListPtr,
afterPtr->commandPtr);
Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
(afterPtr->token == NULL) ? "idle" : "timer", -1));
Tcl_SetObjResult(interp, resultListPtr);
}
}
break;
default:
Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
+5 -5
View File
@@ -167,11 +167,11 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b);
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#endif /* !TCL_WITH_EXTERNAL_TOMMATH */
#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") TclBN_mp_init_u64(a,(unsigned int)(b)))
#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),((unsigned int)(b))),MP_OKAY))
#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),(long)(b)),MP_OKAY))
#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (TclBN_mp_set_u64((a),(b)),MP_OKAY))
#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)TclBN_mp_ubin_size(mp))
#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") mp_init_u64(a,(unsigned int)(b)))
#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),((unsigned int)(b))),MP_OKAY))
#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (mp_set_u64((a),(long)(b)),MP_OKAY))
#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (mp_set_u64((a),(b)),MP_OKAY))
#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)mp_ubin_size(mp))
#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
+7 -7
View File
@@ -159,8 +159,8 @@ typedef struct {
#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
(clientData) = NULL; \
while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
TraceCommandProc, clientData)) != NULL)
while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \
TraceCommandProc, (clientData))) != NULL)
/*
*----------------------------------------------------------------------
@@ -432,7 +432,7 @@ TraceExecutionObjCmd(
* pointer to its array of element pointers.
*/
result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -602,7 +602,7 @@ TraceExecutionObjCmd(
TclNewLiteralStringObj(opObj, "leavestep");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
TclListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
@@ -673,7 +673,7 @@ TraceCommandObjCmd(
* pointer to its array of element pointers.
*/
result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
@@ -797,7 +797,7 @@ TraceCommandObjCmd(
TclNewLiteralStringObj(opObj, "delete");
Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
}
Tcl_ListObjLength(NULL, elemObjPtr, &numOps);
TclListObjLength(NULL, elemObjPtr, &numOps);
if (0 == numOps) {
Tcl_DecrRefCount(elemObjPtr);
continue;
@@ -872,7 +872,7 @@ TraceVariableObjCmd(
* pointer to its array of element pointers.
*/
result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
if (result != TCL_OK) {
return result;
}
+6 -4
View File
@@ -802,9 +802,11 @@ TclCopyAndCollapse(
char c = *src;
if (c == '\\') {
char buf[4] = "";
int numRead;
int backslashCount = TclParseBackslash(src, count, &numRead, dst);
int backslashCount = TclParseBackslash(src, count, &numRead, buf);
memcpy(dst, buf, backslashCount);
dst += backslashCount;
newCount += backslashCount;
src += numRead;
@@ -3699,11 +3701,11 @@ Tcl_GetIntForIndex(
{
Tcl_WideInt wide;
if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
return TCL_ERROR;
}
if (indexPtr != NULL) {
if ((wide < 0) && (endValue > TCL_INDEX_END)) {
if ((wide < 0) && (endValue >= 0)) {
*indexPtr = -1;
} else if (wide > INT_MAX) {
*indexPtr = INT_MAX;
@@ -3784,7 +3786,7 @@ GetEndOffsetFromObj(
if ((TclMaxListLength(bytes, -1, NULL) > 1)
/* If it's possible, do the full list parse. */
&& (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
&& (TCL_OK == TclListObjLength(NULL, objPtr, &length))
&& (length > 1)) {
goto parseError;
}
+3 -3
View File
@@ -3191,7 +3191,7 @@ ArrayForNRCmd(
* Parse arguments.
*/
if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) {
return TCL_ERROR;
}
@@ -3302,7 +3302,7 @@ ArrayForLoopCallback(
goto arrayfordone;
}
Tcl_ListObjGetElements(NULL, varListObj, &varc, &varv);
TclListObjGetElements(NULL, varListObj, &varc, &varv);
if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
@@ -3842,7 +3842,7 @@ ArrayGetCmd(
*/
TclNewObj(tmpResObj);
result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
if (result != TCL_OK) {
goto errorInArrayGet;
}
+97 -69
View File
@@ -36,6 +36,39 @@
#include <dlfcn.h>
#endif
/*
* Macros to report errors only if an interp is present.
*/
#define ZIPFS_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
} \
} while (0)
#define ZIPFS_MEM_ERROR(interp) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj( \
"out of memory", -1)); \
Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \
} \
} while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
"%s: %s", errstr, Tcl_PosixError(interp))); \
} \
} while (0)
#define ZIPFS_ERROR_CODE(interp,errcode) \
do { \
if (interp) { \
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL); \
} \
} while (0)
#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
@@ -124,38 +157,6 @@
#define DEFAULT_WRITE_MAX_SIZE (2 * 1024 * 1024)
/*
* Macros to report errors only if an interp is present.
*/
#define ZIPFS_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
} \
} while (0)
#define ZIPFS_MEM_ERROR(interp) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_NewStringObj( \
"out of memory", -1)); \
Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \
} \
} while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
do { \
if (interp) { \
Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
"%s: %s", errstr, Tcl_PosixError(interp))); \
} \
} while (0)
#define ZIPFS_ERROR_CODE(interp,errcode) \
do { \
if (interp) { \
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", errcode, NULL); \
} \
} while (0)
/*
* Windows drive letters.
*/
@@ -308,13 +309,11 @@ static inline int ListMountPoints(Tcl_Interp *interp);
static void SerializeCentralDirectoryEntry(
const unsigned char *start,
const unsigned char *end, unsigned char *buf,
ZipEntry *z, size_t nameLength,
long long dataStartOffset);
ZipEntry *z, size_t nameLength);
static void SerializeCentralDirectorySuffix(
const unsigned char *start,
const unsigned char *end, unsigned char *buf,
int entryCount, long long dataStartOffset,
long long directoryStartOffset,
int entryCount, long long directoryStartOffset,
long long suffixStartOffset);
static void SerializeLocalEntryHeader(
const unsigned char *start,
@@ -1187,7 +1186,7 @@ ZipFSFindTOC(
int needZip,
ZipFile *zf)
{
size_t i;
size_t i, minoff;
const unsigned char *p, *q;
const unsigned char *start = zf->data;
const unsigned char *end = zf->data + zf->length;
@@ -1245,6 +1244,8 @@ ZipFSFindTOC(
q = zf->data + ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSTART_OFFS);
p -= ZipReadInt(start, end, p + ZIP_CENTRAL_DIRSIZE_OFFS);
zf->baseOffset = zf->passOffset = (p>q) ? p - q : 0;
zf->directoryOffset = q - zf->data + zf->baseOffset;
if ((p < q) || (p < zf->data) || (p > zf->data + zf->length)
|| (q < zf->data) || (q > zf->data + zf->length)) {
if (!needZip) {
@@ -1260,11 +1261,11 @@ ZipFSFindTOC(
* Read the central directory.
*/
zf->baseOffset = zf->passOffset = p - q;
zf->directoryOffset = p - zf->data;
q = p;
minoff = zf->length;
for (i = 0; i < zf->numFiles; i++) {
int pathlen, comlen, extra;
size_t localhdr_off = zf->length;
if (q + ZIP_CENTRAL_HEADER_LEN > end) {
ZIPFS_ERROR(interp, "wrong header length");
@@ -1279,16 +1280,27 @@ ZipFSFindTOC(
pathlen = ZipReadShort(start, end, q + ZIP_CENTRAL_PATHLEN_OFFS);
comlen = ZipReadShort(start, end, q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
extra = ZipReadShort(start, end, q + ZIP_CENTRAL_EXTRALEN_OFFS);
localhdr_off = ZipReadInt(start, end, q + ZIP_CENTRAL_LOCALHDR_OFFS);
if (ZipReadInt(start, end, zf->data + zf->baseOffset + localhdr_off) != ZIP_LOCAL_HEADER_SIG) {
ZIPFS_ERROR(interp, "Failed to find local header");
ZIPFS_ERROR_CODE(interp, "LCL_HDR");
goto error;
}
if (localhdr_off < minoff) {
minoff = localhdr_off;
}
q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
}
zf->passOffset = minoff + zf->baseOffset;
/*
* If there's also an encoded password, extract that too (but don't decode
* yet).
*/
q = zf->data + zf->baseOffset;
if ((zf->baseOffset >= 6) &&
q = zf->data + zf->passOffset;
if ((zf->passOffset >= 6) && (start < q-4) &&
(ZipReadInt(start, end, q - 4) == ZIP_PASSWORD_END_SIG)) {
const unsigned char *passPtr;
@@ -1300,6 +1312,7 @@ ZipFSFindTOC(
zf->passOffset -= i ? (5 + i) : 0;
}
}
return TCL_OK;
error:
@@ -2991,8 +3004,6 @@ ZipFSMkZipOrImg(
Tcl_Channel out;
int pwlen = 0, slen = 0, count, ret = TCL_ERROR, lobjc;
size_t len, i = 0;
long long dataStartOffset; /* The overall file offset of the start of the
* data section of the file. */
long long directoryStartOffset;
/* The overall file offset of the start of the
* central directory. */
@@ -3030,7 +3041,7 @@ ZipFSMkZipOrImg(
}
}
Tcl_IncrRefCount(list);
if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
if (TclListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
Tcl_DecrRefCount(list);
return TCL_ERROR;
}
@@ -3169,7 +3180,6 @@ ZipFSMkZipOrImg(
*/
Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
dataStartOffset = Tcl_Tell(out);
if (mappingList == NULL && stripPrefix != NULL) {
strip = Tcl_GetStringFromObj(stripPrefix, &slen);
if (!slen) {
@@ -3210,7 +3220,7 @@ ZipFSMkZipOrImg(
name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, -1, &ds);
len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len, dataStartOffset);
z, len);
if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN)
!= ZIP_CENTRAL_HEADER_LEN)
|| ((size_t) Tcl_Write(out, name, len) != len)) {
@@ -3230,7 +3240,7 @@ ZipFSMkZipOrImg(
Tcl_Flush(out);
suffixStartOffset = Tcl_Tell(out);
SerializeCentralDirectorySuffix(start, end, (unsigned char *) buf,
count, dataStartOffset, directoryStartOffset, suffixStartOffset);
count, directoryStartOffset, suffixStartOffset);
if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"write error: %s", Tcl_PosixError(interp)));
@@ -3387,9 +3397,7 @@ SerializeCentralDirectoryEntry(
const unsigned char *end, /* The end of writable memory. */
unsigned char *buf, /* Where to serialize to */
ZipEntry *z, /* The description of what to serialize. */
size_t nameLength, /* The length of the name. */
long long dataStartOffset) /* The overall file offset of the start of the
* data section of the file. */
size_t nameLength) /* The length of the name. */
{
ZipWriteInt(start, end, buf + ZIP_CENTRAL_SIG_OFFS,
ZIP_CENTRAL_HEADER_SIG);
@@ -3414,7 +3422,7 @@ SerializeCentralDirectoryEntry(
ZipWriteShort(start, end, buf + ZIP_CENTRAL_IATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_EATTR_OFFS, 0);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_LOCALHDR_OFFS,
z->offset - dataStartOffset);
z->offset);
}
static void
@@ -3423,8 +3431,6 @@ SerializeCentralDirectorySuffix(
const unsigned char *end, /* The end of writable memory. */
unsigned char *buf, /* Where to serialize to */
int entryCount, /* The number of entries in the directory */
long long dataStartOffset, /* The overall file offset of the start of the
* data section of the file. */
long long directoryStartOffset,
/* The overall file offset of the start of the
* central directory. */
@@ -3441,7 +3447,7 @@ SerializeCentralDirectorySuffix(
ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSIZE_OFFS,
suffixStartOffset - directoryStartOffset);
ZipWriteInt(start, end, buf + ZIP_CENTRAL_DIRSTART_OFFS,
directoryStartOffset - dataStartOffset);
directoryStartOffset);
ZipWriteShort(start, end, buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
}
@@ -5702,6 +5708,8 @@ TclZipfs_Init(
#endif /* HAVE_ZLIB */
}
#ifdef HAVE_ZLIB
#if !defined(STATIC_BUILD)
static int
ZipfsAppHookFindTclInit(
@@ -5786,7 +5794,7 @@ ZipfsMountExitHandler(
}
}
/*
*-------------------------------------------------------------------------
*
@@ -5797,7 +5805,7 @@ ZipfsMountExitHandler(
*-------------------------------------------------------------------------
*/
int
const char *
TclZipfs_AppHook(
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
int *argcPtr, /* Pointer to argc */
@@ -5811,6 +5819,7 @@ TclZipfs_AppHook(
#endif /* _WIN32 */
{
const char *archive;
const char *version = Tcl_InitSubsystems();
#ifdef _WIN32
Tcl_FindExecutable(NULL);
@@ -5853,7 +5862,7 @@ TclZipfs_AppHook(
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return TCL_OK;
return version;
}
}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
@@ -5886,7 +5895,7 @@ TclZipfs_AppHook(
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
}
return TCL_OK;
return version;
} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
int found;
Tcl_Obj *vfsInitScript;
@@ -5910,7 +5919,7 @@ TclZipfs_AppHook(
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return TCL_OK;
return version;
}
}
#ifdef _WIN32
@@ -5918,10 +5927,10 @@ TclZipfs_AppHook(
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
}
return TCL_OK;
return version;
}
#ifndef HAVE_ZLIB
#else /* !HAVE_ZLIB */
/*
*-------------------------------------------------------------------------
@@ -5936,9 +5945,9 @@ TclZipfs_AppHook(
int
TclZipfs_Mount(
Tcl_Interp *interp, /* Current interpreter. */
const char *mountPoint, /* Mount point path. */
const char *zipname, /* Path to ZIP file to mount. */
const char *passwd) /* Password for opening the ZIP, or NULL if
TCL_UNUSED(const char *), /* Mount point path. */
TCL_UNUSED(const char *), /* Path to ZIP file to mount. */
TCL_UNUSED(const char *)) /* Password for opening the ZIP, or NULL if
* the ZIP is unprotected. */
{
ZIPFS_ERROR(interp, "no zlib available");
@@ -5949,10 +5958,10 @@ TclZipfs_Mount(
int
TclZipfs_MountBuffer(
Tcl_Interp *interp, /* Current interpreter. NULLable. */
const char *mountPoint, /* Mount point path. */
unsigned char *data,
size_t datalen,
int copy)
TCL_UNUSED(const char *), /* Mount point path. */
TCL_UNUSED(unsigned char *),
TCL_UNUSED(size_t),
TCL_UNUSED(int))
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
@@ -5962,12 +5971,31 @@ TclZipfs_MountBuffer(
int
TclZipfs_Unmount(
Tcl_Interp *interp, /* Current interpreter. */
const char *mountPoint) /* Mount point path. */
TCL_UNUSED(const char *)) /* Mount point path. */
{
ZIPFS_ERROR(interp, "no zlib available");
ZIPFS_ERROR_CODE(interp, "NO_ZLIB");
return TCL_ERROR;
}
const char *
TclZipfs_AppHook(
TCL_UNUSED(int *), /*argcPtr*/
#ifdef _WIN32
TCL_UNUSED(WCHAR ***)) /* argvPtr */
#else /* !_WIN32 */
TCL_UNUSED(char ***)) /* Pointer to argv */
#endif /* _WIN32 */
{
return NULL;
}
Tcl_Obj *
TclZipfs_TclLibrary(void)
{
return NULL;
}
#endif /* !HAVE_ZLIB */
/*
+11 -11
View File
@@ -1154,7 +1154,7 @@ Tcl_ZlibStreamSetCompressionDictionary(
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL,
compressionDictionaryObj, NULL))) {
compressionDictionaryObj, (int *)NULL))) {
/* Missing or invalid compression dictionary */
compressionDictionaryObj = NULL;
}
@@ -1370,7 +1370,7 @@ Tcl_ZlibStreamGet(
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = NULL;
}
Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
TclListObjLength(NULL, zshPtr->inData, &listLen);
if (listLen > 0) {
/*
* There is more input available, get it from the list and
@@ -1419,7 +1419,7 @@ Tcl_ZlibStreamGet(
e = inflate(&zshPtr->stream, zshPtr->flush);
}
};
Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
TclListObjLength(NULL, zshPtr->inData, &listLen);
while ((zshPtr->stream.avail_out > 0)
&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
@@ -1499,7 +1499,7 @@ Tcl_ZlibStreamGet(
inflateEnd(&zshPtr->stream);
}
} else {
Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
TclListObjLength(NULL, zshPtr->outData, &listLen);
if (count == -1) {
count = 0;
for (i=0; i<listLen; i++) {
@@ -1521,7 +1521,7 @@ Tcl_ZlibStreamGet(
dataPtr += existing;
while ((count > dataPos) &&
(Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
(TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
&& (listLen > 0)) {
/*
* Get the next chunk off our list of chunks and grab the data out
@@ -4072,18 +4072,18 @@ Tcl_ZlibInflate(
unsigned int
Tcl_ZlibCRC32(
unsigned int crc,
const char *buf,
int len)
TCL_UNUSED(unsigned int),
TCL_UNUSED(const unsigned char *),
TCL_UNUSED(int))
{
return 0;
}
unsigned int
Tcl_ZlibAdler32(
unsigned int adler,
const char *buf,
int len)
TCL_UNUSED(unsigned int),
TCL_UNUSED(const unsigned char *),
TCL_UNUSED(int))
{
return 0;
}
+1 -1
View File
@@ -10,7 +10,7 @@ apply {{dir} {
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
0 tcl::idna 1.0.1 {cookiejar idna.tcl}
0 platform 1.0.17 {platform platform.tcl}
0 platform 1.0.18 {platform platform.tcl}
0 platform::shell 1.1.4 {platform shell.tcl}
1 tcltest 2.5.4 {tcltest tcltest.tcl}
} {
+1 -1
View File
@@ -1,3 +1,3 @@
package ifneeded platform 1.0.17 [list source [file join $dir platform.tcl]]
package ifneeded platform 1.0.18 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]
+12 -1
View File
@@ -364,6 +364,17 @@ proc ::platform::patterns {id} {
foreach {major minor} [split $v .] break
set res {}
if {$major eq 12} {
# Add 12.0 to 12.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
lappend res macosx${major}.${j}-${cpu}
foreach a $alt {
lappend res macosx${major}.${j}-$a
}
}
set major 11
set minor 5
}
if {$major eq 11} {
# Add 11.0 to 11.minor to patterns.
for {set j $minor} {$j >= 0} {incr j -1} {
@@ -409,7 +420,7 @@ proc ::platform::patterns {id} {
# ### ### ### ######### ######### #########
## Ready
package provide platform 1.0.17
package provide platform 1.0.18
# ### ### ### ######### ######### #########
## Demo application
+79 -79
View File
@@ -124,161 +124,161 @@ set TZData(:Asia/Gaza) {
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
{1635544800 7200 0 EET}
{1635458400 7200 0 EET}
{1648245600 10800 1 EEST}
{1666994400 7200 0 EET}
{1666908000 7200 0 EET}
{1679695200 10800 1 EEST}
{1698444000 7200 0 EET}
{1698357600 7200 0 EET}
{1711749600 10800 1 EEST}
{1729893600 7200 0 EET}
{1729807200 7200 0 EET}
{1743199200 10800 1 EEST}
{1761343200 7200 0 EET}
{1761861600 7200 0 EET}
{1774648800 10800 1 EEST}
{1792792800 7200 0 EET}
{1793311200 7200 0 EET}
{1806098400 10800 1 EEST}
{1824847200 7200 0 EET}
{1824760800 7200 0 EET}
{1837548000 10800 1 EEST}
{1856296800 7200 0 EET}
{1856210400 7200 0 EET}
{1868997600 10800 1 EEST}
{1887746400 7200 0 EET}
{1887660000 7200 0 EET}
{1901052000 10800 1 EEST}
{1919196000 7200 0 EET}
{1919109600 7200 0 EET}
{1932501600 10800 1 EEST}
{1950645600 7200 0 EET}
{1951164000 7200 0 EET}
{1963951200 10800 1 EEST}
{1982700000 7200 0 EET}
{1982613600 7200 0 EET}
{1995400800 10800 1 EEST}
{2014149600 7200 0 EET}
{2014063200 7200 0 EET}
{2026850400 10800 1 EEST}
{2045599200 7200 0 EET}
{2045512800 7200 0 EET}
{2058300000 10800 1 EEST}
{2077048800 7200 0 EET}
{2076962400 7200 0 EET}
{2090354400 10800 1 EEST}
{2108498400 7200 0 EET}
{2109016800 7200 0 EET}
{2121804000 10800 1 EEST}
{2139948000 7200 0 EET}
{2140466400 7200 0 EET}
{2153253600 10800 1 EEST}
{2172002400 7200 0 EET}
{2171916000 7200 0 EET}
{2184703200 10800 1 EEST}
{2203452000 7200 0 EET}
{2203365600 7200 0 EET}
{2216152800 10800 1 EEST}
{2234901600 7200 0 EET}
{2234815200 7200 0 EET}
{2248207200 10800 1 EEST}
{2266351200 7200 0 EET}
{2266264800 7200 0 EET}
{2279656800 10800 1 EEST}
{2297800800 7200 0 EET}
{2298319200 7200 0 EET}
{2311106400 10800 1 EEST}
{2329250400 7200 0 EET}
{2329768800 7200 0 EET}
{2342556000 10800 1 EEST}
{2361304800 7200 0 EET}
{2361218400 7200 0 EET}
{2374005600 10800 1 EEST}
{2392754400 7200 0 EET}
{2392668000 7200 0 EET}
{2405455200 10800 1 EEST}
{2424204000 7200 0 EET}
{2424117600 7200 0 EET}
{2437509600 10800 1 EEST}
{2455653600 7200 0 EET}
{2455567200 7200 0 EET}
{2468959200 10800 1 EEST}
{2487103200 7200 0 EET}
{2487621600 7200 0 EET}
{2500408800 10800 1 EEST}
{2519157600 7200 0 EET}
{2519071200 7200 0 EET}
{2531858400 10800 1 EEST}
{2550607200 7200 0 EET}
{2550520800 7200 0 EET}
{2563308000 10800 1 EEST}
{2582056800 7200 0 EET}
{2581970400 7200 0 EET}
{2595362400 10800 1 EEST}
{2613506400 7200 0 EET}
{2613420000 7200 0 EET}
{2626812000 10800 1 EEST}
{2644956000 7200 0 EET}
{2645474400 7200 0 EET}
{2658261600 10800 1 EEST}
{2676405600 7200 0 EET}
{2676924000 7200 0 EET}
{2689711200 10800 1 EEST}
{2708460000 7200 0 EET}
{2708373600 7200 0 EET}
{2721160800 10800 1 EEST}
{2739909600 7200 0 EET}
{2739823200 7200 0 EET}
{2752610400 10800 1 EEST}
{2771359200 7200 0 EET}
{2771272800 7200 0 EET}
{2784664800 10800 1 EEST}
{2802808800 7200 0 EET}
{2802722400 7200 0 EET}
{2816114400 10800 1 EEST}
{2834258400 7200 0 EET}
{2834776800 7200 0 EET}
{2847564000 10800 1 EEST}
{2866312800 7200 0 EET}
{2866226400 7200 0 EET}
{2879013600 10800 1 EEST}
{2897762400 7200 0 EET}
{2897676000 7200 0 EET}
{2910463200 10800 1 EEST}
{2929212000 7200 0 EET}
{2929125600 7200 0 EET}
{2941912800 10800 1 EEST}
{2960661600 7200 0 EET}
{2960575200 7200 0 EET}
{2973967200 10800 1 EEST}
{2992111200 7200 0 EET}
{2992629600 7200 0 EET}
{3005416800 10800 1 EEST}
{3023560800 7200 0 EET}
{3024079200 7200 0 EET}
{3036866400 10800 1 EEST}
{3055615200 7200 0 EET}
{3055528800 7200 0 EET}
{3068316000 10800 1 EEST}
{3087064800 7200 0 EET}
{3086978400 7200 0 EET}
{3099765600 10800 1 EEST}
{3118514400 7200 0 EET}
{3118428000 7200 0 EET}
{3131820000 10800 1 EEST}
{3149964000 7200 0 EET}
{3149877600 7200 0 EET}
{3163269600 10800 1 EEST}
{3181413600 7200 0 EET}
{3181932000 7200 0 EET}
{3194719200 10800 1 EEST}
{3212863200 7200 0 EET}
{3213381600 7200 0 EET}
{3226168800 10800 1 EEST}
{3244917600 7200 0 EET}
{3244831200 7200 0 EET}
{3257618400 10800 1 EEST}
{3276367200 7200 0 EET}
{3276280800 7200 0 EET}
{3289068000 10800 1 EEST}
{3307816800 7200 0 EET}
{3307730400 7200 0 EET}
{3321122400 10800 1 EEST}
{3339266400 7200 0 EET}
{3339180000 7200 0 EET}
{3352572000 10800 1 EEST}
{3370716000 7200 0 EET}
{3371234400 7200 0 EET}
{3384021600 10800 1 EEST}
{3402770400 7200 0 EET}
{3402684000 7200 0 EET}
{3415471200 10800 1 EEST}
{3434220000 7200 0 EET}
{3434133600 7200 0 EET}
{3446920800 10800 1 EEST}
{3465669600 7200 0 EET}
{3465583200 7200 0 EET}
{3478975200 10800 1 EEST}
{3497119200 7200 0 EET}
{3497032800 7200 0 EET}
{3510424800 10800 1 EEST}
{3528568800 7200 0 EET}
{3529087200 7200 0 EET}
{3541874400 10800 1 EEST}
{3560018400 7200 0 EET}
{3560536800 7200 0 EET}
{3573324000 10800 1 EEST}
{3592072800 7200 0 EET}
{3591986400 7200 0 EET}
{3604773600 10800 1 EEST}
{3623522400 7200 0 EET}
{3623436000 7200 0 EET}
{3636223200 10800 1 EEST}
{3654972000 7200 0 EET}
{3654885600 7200 0 EET}
{3668277600 10800 1 EEST}
{3686421600 7200 0 EET}
{3686335200 7200 0 EET}
{3699727200 10800 1 EEST}
{3717871200 7200 0 EET}
{3718389600 7200 0 EET}
{3731176800 10800 1 EEST}
{3749925600 7200 0 EET}
{3749839200 7200 0 EET}
{3762626400 10800 1 EEST}
{3781375200 7200 0 EET}
{3781288800 7200 0 EET}
{3794076000 10800 1 EEST}
{3812824800 7200 0 EET}
{3812738400 7200 0 EET}
{3825525600 10800 1 EEST}
{3844274400 7200 0 EET}
{3844188000 7200 0 EET}
{3857580000 10800 1 EEST}
{3875724000 7200 0 EET}
{3876242400 7200 0 EET}
{3889029600 10800 1 EEST}
{3907173600 7200 0 EET}
{3907692000 7200 0 EET}
{3920479200 10800 1 EEST}
{3939228000 7200 0 EET}
{3939141600 7200 0 EET}
{3951928800 10800 1 EEST}
{3970677600 7200 0 EET}
{3970591200 7200 0 EET}
{3983378400 10800 1 EEST}
{4002127200 7200 0 EET}
{4002040800 7200 0 EET}
{4015432800 10800 1 EEST}
{4033576800 7200 0 EET}
{4033490400 7200 0 EET}
{4046882400 10800 1 EEST}
{4065026400 7200 0 EET}
{4065544800 7200 0 EET}
{4078332000 10800 1 EEST}
{4096476000 7200 0 EET}
{4096994400 7200 0 EET}
}
+79 -79
View File
@@ -123,161 +123,161 @@ set TZData(:Asia/Hebron) {
{1585346400 10800 1 EEST}
{1603490400 7200 0 EET}
{1616796000 10800 1 EEST}
{1635544800 7200 0 EET}
{1635458400 7200 0 EET}
{1648245600 10800 1 EEST}
{1666994400 7200 0 EET}
{1666908000 7200 0 EET}
{1679695200 10800 1 EEST}
{1698444000 7200 0 EET}
{1698357600 7200 0 EET}
{1711749600 10800 1 EEST}
{1729893600 7200 0 EET}
{1729807200 7200 0 EET}
{1743199200 10800 1 EEST}
{1761343200 7200 0 EET}
{1761861600 7200 0 EET}
{1774648800 10800 1 EEST}
{1792792800 7200 0 EET}
{1793311200 7200 0 EET}
{1806098400 10800 1 EEST}
{1824847200 7200 0 EET}
{1824760800 7200 0 EET}
{1837548000 10800 1 EEST}
{1856296800 7200 0 EET}
{1856210400 7200 0 EET}
{1868997600 10800 1 EEST}
{1887746400 7200 0 EET}
{1887660000 7200 0 EET}
{1901052000 10800 1 EEST}
{1919196000 7200 0 EET}
{1919109600 7200 0 EET}
{1932501600 10800 1 EEST}
{1950645600 7200 0 EET}
{1951164000 7200 0 EET}
{1963951200 10800 1 EEST}
{1982700000 7200 0 EET}
{1982613600 7200 0 EET}
{1995400800 10800 1 EEST}
{2014149600 7200 0 EET}
{2014063200 7200 0 EET}
{2026850400 10800 1 EEST}
{2045599200 7200 0 EET}
{2045512800 7200 0 EET}
{2058300000 10800 1 EEST}
{2077048800 7200 0 EET}
{2076962400 7200 0 EET}
{2090354400 10800 1 EEST}
{2108498400 7200 0 EET}
{2109016800 7200 0 EET}
{2121804000 10800 1 EEST}
{2139948000 7200 0 EET}
{2140466400 7200 0 EET}
{2153253600 10800 1 EEST}
{2172002400 7200 0 EET}
{2171916000 7200 0 EET}
{2184703200 10800 1 EEST}
{2203452000 7200 0 EET}
{2203365600 7200 0 EET}
{2216152800 10800 1 EEST}
{2234901600 7200 0 EET}
{2234815200 7200 0 EET}
{2248207200 10800 1 EEST}
{2266351200 7200 0 EET}
{2266264800 7200 0 EET}
{2279656800 10800 1 EEST}
{2297800800 7200 0 EET}
{2298319200 7200 0 EET}
{2311106400 10800 1 EEST}
{2329250400 7200 0 EET}
{2329768800 7200 0 EET}
{2342556000 10800 1 EEST}
{2361304800 7200 0 EET}
{2361218400 7200 0 EET}
{2374005600 10800 1 EEST}
{2392754400 7200 0 EET}
{2392668000 7200 0 EET}
{2405455200 10800 1 EEST}
{2424204000 7200 0 EET}
{2424117600 7200 0 EET}
{2437509600 10800 1 EEST}
{2455653600 7200 0 EET}
{2455567200 7200 0 EET}
{2468959200 10800 1 EEST}
{2487103200 7200 0 EET}
{2487621600 7200 0 EET}
{2500408800 10800 1 EEST}
{2519157600 7200 0 EET}
{2519071200 7200 0 EET}
{2531858400 10800 1 EEST}
{2550607200 7200 0 EET}
{2550520800 7200 0 EET}
{2563308000 10800 1 EEST}
{2582056800 7200 0 EET}
{2581970400 7200 0 EET}
{2595362400 10800 1 EEST}
{2613506400 7200 0 EET}
{2613420000 7200 0 EET}
{2626812000 10800 1 EEST}
{2644956000 7200 0 EET}
{2645474400 7200 0 EET}
{2658261600 10800 1 EEST}
{2676405600 7200 0 EET}
{2676924000 7200 0 EET}
{2689711200 10800 1 EEST}
{2708460000 7200 0 EET}
{2708373600 7200 0 EET}
{2721160800 10800 1 EEST}
{2739909600 7200 0 EET}
{2739823200 7200 0 EET}
{2752610400 10800 1 EEST}
{2771359200 7200 0 EET}
{2771272800 7200 0 EET}
{2784664800 10800 1 EEST}
{2802808800 7200 0 EET}
{2802722400 7200 0 EET}
{2816114400 10800 1 EEST}
{2834258400 7200 0 EET}
{2834776800 7200 0 EET}
{2847564000 10800 1 EEST}
{2866312800 7200 0 EET}
{2866226400 7200 0 EET}
{2879013600 10800 1 EEST}
{2897762400 7200 0 EET}
{2897676000 7200 0 EET}
{2910463200 10800 1 EEST}
{2929212000 7200 0 EET}
{2929125600 7200 0 EET}
{2941912800 10800 1 EEST}
{2960661600 7200 0 EET}
{2960575200 7200 0 EET}
{2973967200 10800 1 EEST}
{2992111200 7200 0 EET}
{2992629600 7200 0 EET}
{3005416800 10800 1 EEST}
{3023560800 7200 0 EET}
{3024079200 7200 0 EET}
{3036866400 10800 1 EEST}
{3055615200 7200 0 EET}
{3055528800 7200 0 EET}
{3068316000 10800 1 EEST}
{3087064800 7200 0 EET}
{3086978400 7200 0 EET}
{3099765600 10800 1 EEST}
{3118514400 7200 0 EET}
{3118428000 7200 0 EET}
{3131820000 10800 1 EEST}
{3149964000 7200 0 EET}
{3149877600 7200 0 EET}
{3163269600 10800 1 EEST}
{3181413600 7200 0 EET}
{3181932000 7200 0 EET}
{3194719200 10800 1 EEST}
{3212863200 7200 0 EET}
{3213381600 7200 0 EET}
{3226168800 10800 1 EEST}
{3244917600 7200 0 EET}
{3244831200 7200 0 EET}
{3257618400 10800 1 EEST}
{3276367200 7200 0 EET}
{3276280800 7200 0 EET}
{3289068000 10800 1 EEST}
{3307816800 7200 0 EET}
{3307730400 7200 0 EET}
{3321122400 10800 1 EEST}
{3339266400 7200 0 EET}
{3339180000 7200 0 EET}
{3352572000 10800 1 EEST}
{3370716000 7200 0 EET}
{3371234400 7200 0 EET}
{3384021600 10800 1 EEST}
{3402770400 7200 0 EET}
{3402684000 7200 0 EET}
{3415471200 10800 1 EEST}
{3434220000 7200 0 EET}
{3434133600 7200 0 EET}
{3446920800 10800 1 EEST}
{3465669600 7200 0 EET}
{3465583200 7200 0 EET}
{3478975200 10800 1 EEST}
{3497119200 7200 0 EET}
{3497032800 7200 0 EET}
{3510424800 10800 1 EEST}
{3528568800 7200 0 EET}
{3529087200 7200 0 EET}
{3541874400 10800 1 EEST}
{3560018400 7200 0 EET}
{3560536800 7200 0 EET}
{3573324000 10800 1 EEST}
{3592072800 7200 0 EET}
{3591986400 7200 0 EET}
{3604773600 10800 1 EEST}
{3623522400 7200 0 EET}
{3623436000 7200 0 EET}
{3636223200 10800 1 EEST}
{3654972000 7200 0 EET}
{3654885600 7200 0 EET}
{3668277600 10800 1 EEST}
{3686421600 7200 0 EET}
{3686335200 7200 0 EET}
{3699727200 10800 1 EEST}
{3717871200 7200 0 EET}
{3718389600 7200 0 EET}
{3731176800 10800 1 EEST}
{3749925600 7200 0 EET}
{3749839200 7200 0 EET}
{3762626400 10800 1 EEST}
{3781375200 7200 0 EET}
{3781288800 7200 0 EET}
{3794076000 10800 1 EEST}
{3812824800 7200 0 EET}
{3812738400 7200 0 EET}
{3825525600 10800 1 EEST}
{3844274400 7200 0 EET}
{3844188000 7200 0 EET}
{3857580000 10800 1 EEST}
{3875724000 7200 0 EET}
{3876242400 7200 0 EET}
{3889029600 10800 1 EEST}
{3907173600 7200 0 EET}
{3907692000 7200 0 EET}
{3920479200 10800 1 EEST}
{3939228000 7200 0 EET}
{3939141600 7200 0 EET}
{3951928800 10800 1 EEST}
{3970677600 7200 0 EET}
{3970591200 7200 0 EET}
{3983378400 10800 1 EEST}
{4002127200 7200 0 EET}
{4002040800 7200 0 EET}
{4015432800 10800 1 EEST}
{4033576800 7200 0 EET}
{4033490400 7200 0 EET}
{4046882400 10800 1 EEST}
{4065026400 7200 0 EET}
{4065544800 7200 0 EET}
{4078332000 10800 1 EEST}
{4096476000 7200 0 EET}
{4096994400 7200 0 EET}
}
+3 -3
View File
@@ -1,5 +1,5 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
LoadTimeZoneFile Europe/Berlin
if {![info exists TZData(Europe/Oslo)]} {
LoadTimeZoneFile Europe/Oslo
}
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Berlin)
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Oslo)
-2
View File
@@ -31,8 +31,6 @@ set TZData(:Pacific/Fiji) {
{1578751200 43200 0 +12}
{1608386400 46800 1 +12}
{1610805600 43200 0 +12}
{1636812000 46800 1 +12}
{1642255200 43200 0 +12}
{1668261600 46800 1 +12}
{1673704800 43200 0 +12}
{1699711200 46800 1 +12}
+8
View File
@@ -0,0 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kanton) {
{-9223372036854775808 0 0 -00}
{-1020470400 -43200 0 -12}
{307627200 -39600 0 -11}
{788871600 46800 0 +13}
}
BIN
View File
Binary file not shown.
+1 -1
View File
@@ -21,7 +21,7 @@ catch [list package require -exact tcl::test [info patchlevel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
testConstraint knownMsvcBug [string match msvc-* [tcl::build-info compiler]]
proc async1 {result code} {
global aresult acode
+1 -1
View File
@@ -776,7 +776,7 @@ test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
lreverse [list]
} {}
test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
test cmdIL-7.8 {lreverse command - shared internalrep [Bug 1675044]} -setup {
teststringobj set 1 {1 2 3}
testobj convert 1 list
testobj duplicate 1 2
+1 -1
View File
@@ -500,7 +500,7 @@ test compile-13.2 {TclCompileScript: testing expected nested scripts compilation
# with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
# boxes or systems, please don't decrease it (either provide a constraint)
ti eval {foreach cmd {eval "if 1" try catch} {
set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd]
set c [gencode [expr {[tcl::build-info debug] ? 1500 : 1000}] $cmd]
if 1 $c
}}
ti eval {set result}
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
test pkgconfig-1.1 {query keys} -body {
lsort [::tcl::pkgconfig list]
} -match glob -result {64bit bindir,install bindir,runtime compile_debug compile_stats debug*docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
} -match glob -result {*bindir,install bindir,runtime*docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime*scriptdir,install scriptdir,runtime*}
test pkgconfig-1.2 {query keys multiple times} {
string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
+32 -12
View File
@@ -287,6 +287,12 @@ test encoding-11.8 {encoding: extended Unicode UTF-16} {
test encoding-11.9 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16be 😹]
} {Ø=Þ9 (\u00D8=\u00DE9)}
test encoding-11.10 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32le 😹]
} "9\xF6\x01\x00 (9\\u00F6\\u0001\\u0000)"
test encoding-11.11 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32be 😹]
} "\x00\x01\xF69 (\\u0000\\u0001\\u00F69)"
# OpenEncodingFile is fully tested by the rest of the tests in this file.
test encoding-12.1 {LoadTableEncoding: normal encoding} {
@@ -343,61 +349,61 @@ test encoding-15.6 {UtfToUtfProc emoji character output} {
set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D]
binary scan $y H* z
list [string length $y] $z
} {10 efbfbdf09f9882efbfbd}
} {10 edb882f09f9882eda0bd}
test encoding-15.7 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83D\uD83D
set y [encoding convertto utf-8 \uDE02\uD83D\uD83D]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {3 9 efbfbdefbfbdefbfbd}
} {3 9 edb882eda0bdeda0bd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83Dé
set y [encoding convertto utf-8 \uDE02\uD83Dé]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {3 8 efbfbdefbfbdc3a9}
} {3 8 edb882eda0bdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} {
set x \uDE02\uD83DX
set y [encoding convertto utf-8 \uDE02\uD83DX]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {3 7 efbfbdefbfbd58}
} {3 7 edb882eda0bd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
set x \uDE02é
set y [encoding convertto utf-8 \uDE02é]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
} {2 5 edb882c3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
set x \uDA02é
set y [encoding convertto utf-8 \uDA02é]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 5 efbfbdc3a9}
} {2 5 eda882c3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} {
set x \uDE02Y
set y [encoding convertto utf-8 \uDE02Y]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
} {2 4 edb88259}
test encoding-15.13 {UtfToUtfProc low surrogate character output} {
set x \uDA02Y
set y [encoding convertto utf-8 \uDA02Y]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {2 4 efbfbd59}
} {2 4 eda88259}
test encoding-15.14 {UtfToUtfProc high surrogate character output} {
set x \uDE02
set y [encoding convertto utf-8 \uDE02]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {1 3 efbfbd}
} {1 3 edb882}
test encoding-15.15 {UtfToUtfProc low surrogate character output} {
set x \uDA02
set y [encoding convertto utf-8 \uDA02]
binary scan $y H* z
list [string length $x] [string length $y] $z
} {1 3 efbfbd}
} {1 3 eda882}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
set x \xF0\xA0\xA1\xC2
set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2]
@@ -461,10 +467,18 @@ test encoding-16.4 {Ucs2ToUtfProc} -body {
set val [encoding convertfrom ucs-2 NN]
list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.4 {Ucs2ToUtfProc} -body {
test encoding-16.5 {Ucs2ToUtfProc} -body {
set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.6 {Utf32ToUtfProc} -body {
set val [encoding convertfrom utf-32le NN\0\0]
list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-16.7 {Utf32ToUtfProc} -body {
set val [encoding convertfrom utf-32be \0\0NN]
list $val [format %x [scan $val %c]]
} -result "乎 4e4e"
test encoding-17.1 {UtfToUtf16Proc} -body {
encoding convertto utf-16 "\U460DC"
@@ -478,6 +492,12 @@ test encoding-17.3 {UtfToUtf16Proc} -body {
test encoding-17.4 {UtfToUtf16Proc} -body {
encoding convertto utf-16le "\uD8D8"
} -result "\xFD\xFF"
test encoding-17.5 {UtfToUtf16Proc} -body {
encoding convertto utf-32le "\U460DC"
} -result "\xDC\x60\x04\x00"
test encoding-17.6 {UtfToUtf16Proc} -body {
encoding convertto utf-32be "\U460DC"
} -result "\x00\x04\x60\xDC"
test encoding-18.1 {TableToUtfProc} {
} {}
@@ -777,7 +797,7 @@ test encoding-28.0 {all encodings load} -body {
llength $name
}
return $count
} -result [expr {[info exists ::tcl_precision] ? 89 : 88}]
} -result [expr {[info exists ::tcl_precision] ? 92 : 91}]
runtests
+1 -1
View File
@@ -106,7 +106,7 @@ variable keep {
__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
ProgramFiles(x86) CommonProgramW6432 ProgramW6432
WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE
}
variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
+5 -5
View File
@@ -374,7 +374,7 @@ test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
file delete -force foo
} -constraints {unix notRoot} -body {
file mkdir foo
file attr foo -perm 040000
file attr foo -perm 0o40000
file mkdir foo/tf1
} -returnCodes error -cleanup {
file delete -force foo
@@ -687,11 +687,11 @@ test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
} -constraints {unix notRoot} -body {
file mkdir foo/bar
file attr foo -perm 040555
file attr foo -perm 0o40555
file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
catch {file delete [file join $tmpspace bar]}
catch {file attr foo -perm 040777}
catch {file attr foo -perm 0o40777}
catch {file delete -force foo}
} -match glob -result {*: permission denied}
test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
@@ -744,7 +744,7 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug} -body {
# Labelled knownBug because it is dangerous [Bug: 3881]
file mkdir td1
file attr td1 -perm 040000
file attr td1 -perm 0o40000
file rename ~$user td1
} -returnCodes error -cleanup {
file delete -force td1
@@ -763,7 +763,7 @@ test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
} -constraints {unix notRoot} -body {
file mkdir td1
file mkdir td2
file attr td2 -perm 040000
file attr td2 -perm 0o40000
file rename td1 td2/
} -returnCodes error -cleanup {
file delete -force td2
+4 -4
View File
@@ -23,8 +23,8 @@ testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]
testConstraint knownMsvcBug [expr {![string match msvc-* [tcl::build-info compiler]]}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
@@ -620,12 +620,12 @@ test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded}
} -returnCodes error -result "max size for a Tcl value exceeded"
# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
test format-20.1 {Bug 2932421: plain %s caused internalrep change of args} -body {
set x [dict create a b c d]
format %s $x
# After this, obj in $x should be a dict
# We are testing to make sure it has not been shimmered to a
# different intrep when that is not necessary.
# different internalrep when that is not necessary.
# Whether or not there is a string rep - we should not care!
tcl::unsupported::representation $x
} -match glob -result {value is a dict *}
+66 -11
View File
@@ -17,6 +17,7 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]
test indexObj-1.1 {exact match} testindexobj {
@@ -91,46 +92,54 @@ test indexObj-4.1 {free old internal representation} testindexobj {
test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "?-switch?" mycmd
} "wrong # args: should be \"mycmd ?-switch?\""
} {wrong # args: should be "mycmd ?-switch?"}
test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "bar" mycmd foo
} "wrong # args: should be \"mycmd foo bar\""
} {wrong # args: should be "mycmd foo bar"}
test indexObj-5.3 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 0 "bar" mycmd foo
} "wrong # args: should be \"bar\""
} {wrong # args: should be "bar"}
test indexObj-5.4 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 0 "" mycmd foo
} "wrong # args: should be \"\""
} {wrong # args: should be ""}
test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 1 "" mycmd foo
} "wrong # args: should be \"mycmd\""
} {wrong # args: should be "mycmd"}
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
testwrongnumargs 2 "" mycmd foo
} "wrong # args: should be \"mycmd foo\""
} {wrong # args: should be "mycmd foo"}
# Contrast this with test proc-3.6; they have to be like this because
# of [Bug 1066837] so Itcl won't break.
test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} {
testwrongnumargs 2 "fee fi" "fo fum" foo bar
} "wrong # args: should be \"fo fum foo fee fi\""
} {wrong # args: should be "fo fum foo fee fi"}
test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
testgetindexfromobjstruct $x 0
} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
} {wrong # args: should be "testgetindexfromobjstruct a 0"}
test indexObj-6.2 {Tcl_GetIndexFromObjStruct} testindexobj {
set x a
testgetindexfromobjstruct $x 0
testgetindexfromobjstruct $x 0
} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
} {wrong # args: should be "testgetindexfromobjstruct a 0"}
test indexObj-6.3 {Tcl_GetIndexFromObjStruct} testindexobj {
set x c
testgetindexfromobjstruct $x 1
} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
} {wrong # args: should be "testgetindexfromobjstruct c 1"}
test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
set x c
testgetindexfromobjstruct $x 1
testgetindexfromobjstruct $x 1
} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
} {wrong # args: should be "testgetindexfromobjstruct c 1"}
test indexObj-6.5 {Tcl_GetIndexFromObjStruct with TCL_EXACT flag} -constraints testindexobj -body {
set x e
testgetindexfromobjstruct $x 0 1
} -returnCodes error -result {bad dummy "e": must be a, c, or ee}
test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testindexobj -body {
set x ""
testgetindexfromobjstruct $x 0
} -returnCodes error -result {ambiguous dummy "": must be a, c, or ee}
test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
testparseargs
@@ -157,6 +166,52 @@ test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex 0 0
} 0
test indexObj-8.2 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex -1 0
} -1
test indexObj-8.3 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex -2 0
} -1
test indexObj-8.4 {Tcl_GetIntForIndex INT_MAX} testgetintforindex {
testgetintforindex 2147483647 0
} 2147483647
test indexObj-8.5 {Tcl_GetIntForIndex INT_MAX+1} testgetintforindex {
testgetintforindex 2147483648 0
} 2147483647
test indexObj-8.6 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 2147483646
} 2147483645
test indexObj-8.7 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 2147483647
} 2147483646
test indexObj-8.8 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end 2147483646
} 2147483646
test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end 2147483647
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -2
} -3
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -2
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
testgetintforindex end+1 -1
} 0
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
testgetintforindex end+1 -2
} -1
# cleanup
::tcltest::cleanupTests
return
+2 -2
View File
@@ -20,9 +20,9 @@ if {{::tcltest} ni [namespace children]} {
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
package require tcltests
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]
testConstraint nodep [info exists tcl_precision]
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
@@ -101,7 +101,7 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body {
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} nodep {
test info-2.6 {info body option, returning list bodies} deprecated {
proc foo args [list subst bar]
list [string bytelength [info body foo]] \
[foo; string bytelength [info body foo]]
+1 -1
View File
@@ -8752,7 +8752,7 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
} {1}
test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
# Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters.
# Invalidate internalrep of 'channel' Tcl_Obj when transiting between interpreters.
set f [open [info script] r]
} -body {
interp create foo
+1 -1
View File
@@ -412,7 +412,7 @@ test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testeva
} "{ { 1 2 } { 3 4 } } { 3 4 }"
testConstraint testobj [llength [info commands testobj]]
test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {
test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup {
teststringobj set 1 {{1 2} 3}
testobj convert 1 list
testobj duplicate 1 2
+9
View File
@@ -325,6 +325,15 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} tcl::test {
tcl::procbodytest::check
} 1
test proc-4.10 {
TclCreateProc, issue a8579d906a28, argument with no name
} -body {
catch {
proc p1 [list [list [expr {1 + 2}] default]] {}
}
} -cleanup {
catch {rename p1 {}}
} -result 0
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
+2 -3
View File
@@ -17,9 +17,8 @@ if {"::tcltest" ni [namespace children]} {
}
unset -nocomplain foo
package require tcltests
testConstraint exec [llength [info commands exec]]
testConstraint nodep [info exists tcl_precision]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
@@ -766,7 +765,7 @@ test regexp-19.2 {regsub null replacement} {
string equal $result $expected
} 1
test regexp-20.1 {regsub shared object shimmering} -constraints nodep -body {
test regexp-20.1 {regsub shared object shimmering} -constraints deprecated -body {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
+2 -2
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
testConstraint nodep [info exists tcl_precision]
package require tcltests
# Procedure to evaluate a script within a proc, to test compilation
# functionality
@@ -793,7 +793,7 @@ test regexpComp-19.1 {regsub null replacement} {
}
} "\0a\0hel\0a\0lo\0a\0 14"
test regexpComp-20.1 {regsub shared object shimmering} nodep {
test regexpComp-20.1 {regsub shared object shimmering} deprecated {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz

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