Compare commits

...
Author SHA1 Message Date
apnadkarni d87f07df98 Merge main 2023-08-24 15:37:21 +00:00
griffin 4a4195dde8 Replace test data with something more acceptable. 2023-08-24 01:45:05 +00:00
jan.nijtmans 0290bc2e58 Merge 8.7 2023-08-23 20:18:27 +00:00
jan.nijtmans 4408536018 Merge 8.6 2023-08-23 16:56:24 +00:00
jan.nijtmans 813e29b286 Fix [84a5355235] (not visible in 8.6, but meant to be forwared to 8.7) 2023-08-23 16:13:58 +00:00
jan.nijtmans ea37e7d256 Backport [bae0d30c7f5047a4]. Don't suggest that TCL_UTF_MAX=1 might work any more. See: [457523] 2023-08-23 15:31:20 +00:00
bch 264cdba5ac Tcl_Read(), Tcl_ReadChars() return Tcl_Size 2023-08-21 03:00:12 +00:00
apnadkarni bc67254346 Back out [2a01c62b1a55a] - causes tcllib failures. 2023-08-20 13:26:21 +00:00
apnadkarni df59030308 Merge 8.7 - Fix UtfToUtf16Proc 2023-08-18 07:08:55 +00:00
apnadkarni 8f08010332 Fix UtfToUtf16Proc and UtfToUCS2Proc to not assume sizeof(Tcl_UniChar) is size of UTF16 / UCS2 code unit" 2023-08-18 06:57:08 +00:00
griffin cbaacc8765 Fix bug: Performance regression in 9.0 accessing dicts as lists [f4c01e42a7] 2023-08-17 21:03:54 +00:00
griffin 8b2e668afd Remove ineffective index operation. Shimmering is already optimal. 2023-08-17 17:37:58 +00:00
griffin ac90f7932a Working index operation, but terrible performance. (not surprising) 2023-08-17 17:16:40 +00:00
griffin 90743534a8 Fix llength function for dict types. 2023-08-16 21:36:18 +00:00
griffin c3237c427f merge bug-bc7ddc7944 (revert use of TclDuplicatePureObj) 2023-08-14 15:46:21 +00:00
apnadkarni d8efa035d1 Bug [457523]. Trivial comment edit just to close the bug 2023-08-14 12:55:16 +00:00
griffin 08461f8e8f merge trunk 2023-08-14 05:07:19 +00:00
apnadkarni ed918cb027 Bug [bc076f4f0e]. Fix large indexing broken by commit [0b05b5c750df]. Also preserves Tk bug fix [a9929f112a] 2023-08-14 03:42:58 +00:00
apnadkarni 37289addc2 Fix up tests for modified Tcl_GetIntForIndex semantics 2023-08-13 13:37:23 +00:00
apnadkarni e2d5a2cd60 Merge in fix for end+1 indices. 2023-08-13 11:56:12 +00:00
apnadkarni 5860a89267 Fix for Tk [a9929f112a] 2023-08-13 10:35:29 +00:00
apnadkarni aa0e1c2bd9 Revert [0b05b5c750df] that broke bigdata tests and lseq-1.13 2023-08-13 06:22:28 +00:00
griffin 558680d5e5 merge trunk 2023-08-13 04:29:59 +00:00
griffin baa91f87ba Rename Tcl_BumpObj() to Tcl_BounceRefCount().
After the presentation on Abstract Lists at the 2023 OpenACS/Tcl
Conference, there was a strong opinion that this function should be
renamed. The results of an informal poll had a tie between
Tcl_DoneWithObj() and Tcl_BounceRefCount(). Having seen a reference to
"Bounce" in a research paper on Ref Counting, I chose to use
Tcl_BounceRefCount().
2023-08-12 23:14:43 +00:00
griffin c29c4e023f More replacements of DuplicateObj with ListObjCopy. 2023-08-12 17:56:23 +00:00
griffin 997617cd7d Replace more DuplicateObj with ListObjCopy. 2023-08-12 04:07:57 +00:00
griffin 0a0ba9e309 Replace DuplicateObj with ListObjCopy where appropriate. 2023-08-11 17:55:27 +00:00
dgp 073b0f729a Tcl_DuplicateObj() does not need DECACHE/CACHE protections. 2023-08-11 15:09:31 +00:00
griffin bf8b4d6d18 Revert more bits. 2023-08-10 21:12:05 +00:00
griffin 45a4664dc2 Revert DupolicatePureObj back to DuplicateObj. 2023-08-10 17:48:37 +00:00
dgp 946847b4b9 silence compiler warning 2023-08-10 14:09:55 +00:00
griffin 5b6a975221 Proposed fix for bug-bc7ddc7944 2023-08-10 01:47:42 +00:00
griffin 96b27040f7 Fix uninitialized variable. 2023-08-09 22:55:25 +00:00
griffin 7dc2ed805f Corrections and additions for ObjectType Abstract List descriptions. Part of bug [30e4e9102f] 2023-08-08 22:55:50 +00:00
griffin 0d106bd729 Fix bug [30e4e9102f] - Abstract List ListIndex should return NULL when index out of range. 2023-08-08 17:10:20 +00:00
griffin 4eef7b0ff0 Implement in,ni operator for abstract lists 2023-08-08 15:21:47 +00:00
apnadkarni 59462a578f Bug [f5c01e42a7]. Disable DictAsListIndex for the time being. 2023-08-08 06:02:32 +00:00
dgp 67a433cc8e quiet test noise 2023-08-04 14:06:34 +00:00
dgp b87eac8cd9 Add DECACHE/CACHE_STACK_INFO() protections to calls out of the bytecode
execution engine to avoid panics from corrupted execution stack.
2023-08-03 20:00:01 +00:00
jan.nijtmans 89cc07aa34 Merge 8.7 2023-08-03 13:04:33 +00:00
jan.nijtmans aeaba6971a Merge 8.7 2023-08-03 11:26:37 +00:00
jan.nijtmans a53c12b3b5 Implement TCL_LIB_FLAG/TCL_BUILD_LIB_SPEC for Windows (which - aparently - has always been just empty) 2023-08-03 10:59:49 +00:00
jan.nijtmans b29ad5dcf2 DOn't use --out-implib on Cygwin any more, no longer needed 2023-08-03 10:15:41 +00:00
jan.nijtmans a6714c6778 Merge 8.7 2023-08-02 20:51:52 +00:00
jan.nijtmans 0472854629 Merge 8.6 2023-08-02 19:34:00 +00:00
jan.nijtmans cca28f5ef3 deprecate TCL_EXPORT_FILE_SUFFIX: no longer needed. Fix some path handling containing spaces 2023-08-02 19:13:20 +00:00
jan.nijtmans e97b71f139 Merge 8.7 2023-08-01 16:12:15 +00:00
jan.nijtmans 47f462c33c Make sure that zdll.lib and tommath.lib are installed in windows, for possible use by extensions. 2023-08-01 16:09:48 +00:00
jan.nijtmans 66027ff8e6 Merge 8.7 2023-08-01 15:52:03 +00:00
jan.nijtmans 2e364fd375 Merge 8.6 2023-08-01 15:42:36 +00:00
jan.nijtmans cb7eb97a8d Add TCL_ZLIB_LIB_NAME to tclConfig.sh (for Windows) 2023-08-01 15:27:33 +00:00
jan.nijtmans 911d6f8e5e Merge 8.7 2023-08-01 13:57:28 +00:00
jan.nijtmans 09e16559af testcase cleanup 2023-08-01 13:19:26 +00:00
apnadkarni c94d0732e0 Bug [76d45ec836] - mingw - tommath not copied on install 2023-08-01 13:01:25 +00:00
jan.nijtmans 2618ae962a merge-mark 2023-08-01 06:53:46 +00:00
jan.nijtmans 82703fea0a merge-mark 2023-08-01 06:52:30 +00:00
jan.nijtmans 3b99720301 Prevent Tcl 8.6 header-file to be usable for Tcl 9 compiles. (see [6f22c7a1fc]) 2023-08-01 06:46:56 +00:00
jan.nijtmans f70182e63c Some more int -> Tcl_Size (backported from 9.0) 2023-08-01 06:39:33 +00:00
jan.nijtmans 1625f9f678 Fix [e58d7e19e9]: Upwards compatibility of TclObjTypeHasProc() 2023-07-31 15:58:14 +00:00
jan.nijtmans fddaf810d4 Add (hopefully confincing) testcase for bug [e58d7e19e9] 2023-07-31 15:45:13 +00:00
jan.nijtmans fc19cf036c Merge bug-e58d7e19e9-demo branch: Show that everything works fine here. 2023-07-29 20:35:16 +00:00
jan.nijtmans e7cef5d811 Demo bug [e58d7e19e9] 2023-07-29 18:11:26 +00:00
apnadkarni 848c57d596 Merge 8.7 - Tcl_ListObjIndex tests 2023-07-29 06:46:16 +00:00
apnadkarni a0cee2b681 Add tests for out of bounds Tcl_ListObjIndex 2023-07-29 05:56:10 +00:00
apnadkarni ae7471ec7e A bunch of 64 bit fixes (int->Tcl_Size) and the like. 2023-07-28 15:51:02 +00:00
jan.nijtmans 861b69164d Merge 8.7 2023-07-28 08:04:01 +00:00
jan.nijtmans c94fa5b242 "utf-8" is the new "identity": make it available always 2023-07-28 07:50:18 +00:00
apnadkarni dc033db224 Merge 8.7 Encoding doc fix 2023-07-28 05:04:44 +00:00
apnadkarni 5c12e53355 Fix transposing of TCL_OK, TCL_ERROR in Encoding docs 2023-07-28 05:02:37 +00:00
jan.nijtmans d74efff177 Add some implicit "-profile tcl8" to testcases 2023-07-27 16:27:21 +00:00
apnadkarni e253c3eed9 Merge trunk 2023-07-27 16:26:38 +00:00
apnadkarni 35a47e7051 Merge trunk 2023-07-27 15:32:11 +00:00
jan.nijtmans 78c6a505b7 Demonstration how to add TCL_OBJTYPE_V3, while keeping upwards compatibility: all other TCL_OBJTYPE_V? macro's continue to work 2023-07-27 13:19:48 +00:00
jan.nijtmans 503165d9c2 Proposed fix for [e58d7e19e9]: Upwards compatibility of TclObjTypeHasProc() 2023-07-27 13:10:40 +00:00
jan.nijtmans e4971bdffc Proposed fix for [e58d7e19e9]: Upwards compatibility of TclObjTypeHasProc() 2023-07-27 12:57:27 +00:00
jan.nijtmans af64c95042 merge-mark 2023-07-27 07:56:27 +00:00
jan.nijtmans 90034cb557 Merge 8.7 2023-07-27 07:52:44 +00:00
jan.nijtmans d49a7f9c8d int -> Tcl_Size in Tcl_MacOSXOpen*BundleResources 2023-07-27 07:22:56 +00:00
jan.nijtmans 3f7d896efb merge-mark 2023-07-26 15:18:53 +00:00
jan.nijtmans 60c1d787b1 Simplify tenviron2utfdstr(), since 2nd argument is always -1. 2023-07-26 15:15:22 +00:00
jan.nijtmans df1e155f68 Merge 8.7 2023-07-26 08:06:52 +00:00
jan.nijtmans 862ae1266c Merge 8.6 2023-07-26 08:03:45 +00:00
jan.nijtmans b985fb8965 Fix [c54e4a1aeb] (again): High Tcl latencies with fork() in larger systems.
vfork() is now prefered, if available
2023-07-26 07:15:26 +00:00
jan.nijtmans 004d2e654f Close fork. Prefer vfork over posix_spawnp 2023-07-25 15:57:02 +00:00
neumann 323f750af8 Regenerated configure file 2023-07-25 15:07:31 +00:00
jan.nijtmans 8733687efc Add (back) check for vfork() 2023-07-25 10:35:22 +00:00
neumann d880550d56 Prefer vfork() over posix_spawnp()
In essence, older versions of the posix_spawn(p) implementation under
glibc have the problem not returning the correct error number in case
the spawn call fails. This is e.g. a problem with CentOS 7, which uses
GNU libc 2.17, which was released 2012-12-25. This has the consequence
that on such systems, Tcl is not error message compliant to versions
without posix_spawn.

The versions of vfork() do not face this problem and show similar
performance characteristics like with posix_spawnp() (spawn time in
essence independent of memory footprint size).

This change was tested with macOS 13.4, Ubuntu 20.04, CentOS 7.9 and
OpenBSD 7.2.
2023-07-25 09:01:51 +00:00
jan.nijtmans c1e69b2d6b Make use_spawn static 2023-07-25 07:54:42 +00:00
jan.nijtmans ecc60b1256 Re-generate configure and tclConfig.h.in 2023-07-25 07:44:01 +00:00
jan.nijtmans b7f335b27d attempt to fix posix_spawn on linux 2023-07-25 07:36:19 +00:00
jan.nijtmans 50944b9abf merge-mark 2023-07-24 15:18:50 +00:00
jan.nijtmans 4dd445404b Merge 8.7 2023-07-24 15:14:46 +00:00
jan.nijtmans ffe298076d Merge 8.6 2023-07-24 15:13:51 +00:00
jan.nijtmans 4f7e149fb6 For now, disable posix_spawnp, until we have a better solution for [407b70361c148773] 2023-07-24 15:12:04 +00:00
jan.nijtmans 545fe029f6 Merge 8.7 2023-07-24 13:32:43 +00:00
jan.nijtmans 399309020d Merge 8.6 2023-07-24 11:13:58 +00:00
jan.nijtmans 30816932df Keeping open [c54e4a1aeb]: Can the exec-17.1 test-failure on MaxOS be fixed? 2023-07-24 10:34:59 +00:00
jan.nijtmans 03b881a299 Fix [c54e4a1aeb]: High Tcl latencies with fork() in larger systems 2023-07-24 10:19:52 +00:00
apnadkarni a3581baf86 Docs - tilde substitution and unsigned int->size_t in Tcl_Alloc 2023-07-24 05:40:38 +00:00
apnadkarni 7e80d62929 Merge trunk 2023-07-22 13:54:46 +00:00
jan.nijtmans 72fef9d4d0 Merge 8.7 2023-07-21 12:00:42 +00:00
jan.nijtmans 7caf2af1db simplify tenviron2utfdstr/utf2tenvirondstr macro's, since 2nd argument is always -1
Improve error-handling related to environment variables
All 'stolen' from TIP #571 branch
2023-07-21 11:37:21 +00:00
jan.nijtmans a22f4cc167 Check for _LARGEFILE64_SOURCE after _FILE_OFFSET_BITS=64, since the latter is prefered 2023-07-21 07:11:25 +00:00
jan.nijtmans d357339eb6 Merge 8.7 2023-07-20 21:01:03 +00:00
jan.nijtmans 9195d0b1bc Fix handling of pre-built libtommath.dll on win64-arm 2023-07-20 20:52:03 +00:00
jan.nijtmans 041458aca6 Add comment to cmdAH-24.20.[12] 2023-07-20 13:32:47 +00:00
jan.nijtmans 6a7b44b23c .... forgot to re-generate tclConfig.h.in 2023-07-20 13:07:41 +00:00
jan.nijtmans c45f83b3db Fix [d40b9c8503]: Enforcing 64-bit time_t? 2023-07-20 12:45:01 +00:00
jan.nijtmans 72db4a5deb Don't bail out when no 64-bit time is available 2023-07-20 12:41:32 +00:00
jan.nijtmans 73a790977d Rebase to 9.0 2023-07-19 16:00:31 +00:00
jan.nijtmans c510082005 Merge 8.7 2023-07-19 14:49:55 +00:00
jan.nijtmans 515bd7c0e7 Improve error-reporting possibilities for Tcl_ExternalToUtfDStringEx/Tcl_UtfToExternalDStringEx in case no interpreter is available, by setting "errno". 2023-07-19 14:23:31 +00:00
jan.nijtmans 50eeabb101 Bugfix for escape-encoding, 'stolen' from TIP #671 branch 2023-07-19 13:04:51 +00:00
apnadkarni 2e4dede387 Merge 8.7 - install tommath.lib 2023-07-17 16:48:17 +00:00
apnadkarni 0a3cfc7902 Fix: tommath.lib needs to be installed to permit extensions to link when using the tommath C API 2023-07-17 16:36:51 +00:00
apnadkarni 53f75ee8c8 Merge 8.7 - update for missing TIP 548 function docs 2023-07-17 06:31:17 +00:00
apnadkarni fc0c89372c Fix missing TIP 548 function docs. Some copy editing of doc prototypes for clarity (sez he). 2023-07-17 06:19:41 +00:00
apnadkarni 7791d13f5c Merge 8.7 - Bug [a366c6efee] 2023-07-16 07:23:13 +00:00
apnadkarni ccf857a3db Bug [a366c6efee] 2023-07-16 06:15:36 +00:00
griffin 56ca2a64d7 Fix bug [c25d2cd3e6], as well as memory leaks in lsearch and concat.
Add cleanup to some tests.
Fix bug and leak in tclTestABSList.c
Correct comment in tclArithSeries.c
2023-07-16 00:24:54 +00:00
dgp e10b5cb8b9 Same fix in chanio.test 2023-07-14 15:59:12 +00:00
dgp 88dd8c1911 Move channel close commands to -cleanup so that when the (expected) error
occurs in [fcopy] we do not leave open channels lurking to interfere with
later tests.
2023-07-14 15:36:05 +00:00
dgp 20188493af dup test name 2023-07-14 14:18:18 +00:00
jan.nijtmans d08eb4bc7d Merge 8.7 2023-07-14 06:28:38 +00:00
oehhar 3fb975f30d Correct wording in Comment 2023-07-13 17:19:06 +00:00
jan.nijtmans 1e54e0ba13 Merge 8.7 2023-07-13 16:23:10 +00:00
jan.nijtmans 55d08599b5 Backport changes in tclListObj.c from Tcl 9.0 2023-07-13 15:42:07 +00:00
pooryorick 0900f426bd Remove incorrect lines that were added to SetDuplicatePureObj().
SetDuplicatePureObj() is specifically not about preserving immutable string
value semantics from the orginal object to the new object.
2023-07-13 12:06:14 +00:00
apnadkarni 5ef0c1ab2d NewStringObj more efficient than NewUnicodeObj 2023-07-13 03:33:34 +00:00
jan.nijtmans 7709859190 Eliminate another compiler-warning, with -DTCL_NO_DEPRECATED=1 2023-07-12 20:02:39 +00:00
jan.nijtmans aeb6cd1eb9 One more unresolved reference (see prev commit) 2023-07-12 19:56:27 +00:00
jan.nijtmans ca2928e660 More fixes related to [c1691dc608]: 32-bit Linux regressions, like ".... undefined reference to `TclGetUnicodeFromObj'" 2023-07-12 19:36:00 +00:00
jan.nijtmans 99e286f193 Merge 8.7 2023-07-12 19:13:25 +00:00
jan.nijtmans a123c440eb (partial) fix for [c1691dc608]: 32-bit Linux regressions. Eliminate compiler warning 2023-07-12 19:11:46 +00:00
jan.nijtmans 6b299f271e Merge 8.7 2023-07-12 15:12:20 +00:00
jan.nijtmans 74ba5e4336 Fix special-case in SetDuplicatePureObj(): Since typePtr is always &tclListType (ALL current calls to TclDuplicatePureObj() have &tclListType as last argument), this constructions can never work.
(I'm not sure this code is usefull at all, but that's for another day)
2023-07-12 15:09:52 +00:00
jan.nijtmans 6535d19542 Merge 8.7 2023-07-12 14:43:13 +00:00
jan.nijtmans 56aabaf032 Consider 3 more types as special in TclDuplicatePureObj(). Updated comment for the reason why. 2023-07-12 11:38:08 +00:00
apnadkarni d26b9d5751 Merge trunk 2023-07-12 08:33:31 +00:00
apnadkarni 03e22c83db Merge mark 2023-07-12 06:42:39 +00:00
apnadkarni 38d334f8f2 Fix [54329e39c7] 2023-07-12 06:39:22 +00:00
griffin 62f180300b Fix foreach bug [a34733451b].
Other code cleanup discovered by code review.
2023-07-12 03:06:54 +00:00
apnadkarni 6c4636e94b Fix [54329e39c7] 2023-07-12 02:51:50 +00:00
apnadkarni 4ee94e4f67 Add test 2023-07-12 02:31:54 +00:00
apnadkarni 5073e2599b Abstract list type for strings 2023-07-11 16:48:14 +00:00
apnadkarni 04328bc720 Tweak last for performance in case of traditional lists. 2023-07-11 16:43:13 +00:00
apnadkarni d852753be2 Wrap DECACHE_STACK_INFO around Tcl_ListObjIndex call from bytecode engine. 2023-07-11 12:59:13 +00:00
apnadkarni f7429e3230 Prevent foreach memory bloat iterating within a proc 2023-07-11 11:35:01 +00:00
jan.nijtmans cd97018033 Merge 8.7 2023-07-11 09:23:33 +00:00
jan.nijtmans 531cd741e0 Fix [5916e48806]: tcl.pc: hardcoded depedencies, missing build flags 2023-07-11 09:20:52 +00:00
jan.nijtmans 7aa511f93b Merge 8.7 2023-07-10 16:07:08 +00:00
jan.nijtmans bc24a1ca5a Code cleanup for arithSeries, all backported from 9.0 2023-07-10 15:57:51 +00:00
apnadkarni 481f6f184e Create new branch named "apn-string-split" 2023-07-10 11:49:25 +00:00
apnadkarni 7f10145e49 Permit large scripts > INT_MAX. Not complete because compiler source line tracking still limited. 2023-07-09 14:47:22 +00:00
apnadkarni 3edb9b4175 Create new branch named "apn-fix-scripts64" 2023-07-09 13:51:12 +00:00
jan.nijtmans 0f0bd5de07 Unbreak Windows build (broken by [765c9c37a2] due to TIP #628) 2023-07-08 20:36:56 +00:00
jan.nijtmans 35baa585da Merge-mark 2023-07-08 20:28:06 +00:00
jan.nijtmans 6cc4425966 Fix [c5bcbf3494]: Output of surrogates seems to repeat following character 2023-07-08 20:25:28 +00:00
griffin 14cb83639f Cleanup abstract list ObjType function definitions. 2023-07-07 21:06:45 +00:00
jan.nijtmans 68d6146f53 Make TIP #636 work together with TIP #628: Shared 8.7/9.0 build environment 2023-07-07 14:57:17 +00:00
jan.nijtmans ad7e9fe625 TIP #636 cleanup: Eliminate the use of Tcl_ObjTypeLength() et al, which look public but are internal and not documented anywhere. 2023-07-07 14:23:37 +00:00
neumann 5452282a91 - reduced error of posix_spawnp() cases for macOS to 1 (exec-17.1).
The problem seems related to a different I/O setup for cases,
  when stdout is closed and to be replaced by a different stream
- deactivated posix_spawnp() for macOS for the time being
2023-07-07 13:30:19 +00:00
griffin 1858192725 merge TIP #636 (tip-636-tcl9-644) 2023-07-07 02:56:48 +00:00
griffin e7d7e2db67 merge trunk 2023-07-06 21:37:23 +00:00
griffin 024c0aa13a merge trunk 2023-07-06 19:12:14 +00:00
jan.nijtmans 5e662840fb off-by-one. Minor optimization 2023-07-06 16:13:13 +00:00
jan.nijtmans 6ad38477e3 Proposed fix for [c5bcbf3494]: Output of surrogates seems to repeat following character. Also use more ***_SURROGATE() macro's 2023-07-06 15:07:48 +00:00
jan.nijtmans 7ef194a7d1 Merge 8.7 2023-07-05 15:10:20 +00:00
jan.nijtmans a2e7501d74 Merge 8.6 2023-07-05 15:08:38 +00:00
jan.nijtmans 575f580d51 Backport [66ffafd309]: Truncated encoding for DBCS results in infinite loop and running out of memory 2023-07-05 14:55:51 +00:00
apnadkarni 3106ce90c0 Merge 8.7 - Bug [5be203d6ca] - io-7.3 failure 2023-07-05 05:52:58 +00:00
apnadkarni 0109dc8279 Bug [5be203d6ca] - io-7.3 failure 2023-07-05 05:08:56 +00:00
apnadkarni b49afc700b Bug [5be203d6ca] - better fix and add test 2023-07-05 03:23:43 +00:00
griffin 70ca2e60fd merge trunk 2023-07-04 18:13:54 +00:00
jan.nijtmans 3135d809f5 Merge 8.7 2023-07-04 15:13:50 +00:00
jan.nijtmans 6bf04853ec Use more uppercase hex in documentation and test-cases (for consistancy) 2023-07-04 14:52:30 +00:00
jan.nijtmans a2c7cc0d23 Use "tcltest::Asciify" in stead of "printable" 2023-07-04 11:18:44 +00:00
apnadkarni 3d2de6ed07 Correctly compute consumed bytes in case of truncated byte sequence at end. 2023-07-04 06:47:13 +00:00
griffin 7e59780763 merge trunk 2023-07-03 17:07:04 +00:00
jan.nijtmans a071f9c13b Remove useless section in tclUnixPort.h 2023-07-03 15:29:37 +00:00
jan.nijtmans edd3934b32 Merge 8.6. Put vfork check a little bit earlier in unix/tcl.m4. Re-generate unix/configure with (modified) autoconf-2.59 2023-07-03 15:07:05 +00:00
jan.nijtmans f24bab84df Branch meant for bug-fixing [5be203d6ca]: io-7.3 and chanio-7.3 fail in debug mode 2023-07-03 14:16:37 +00:00
jan.nijtmans 3d98702f45 Merge 8.7 2023-07-03 14:10:34 +00:00
jan.nijtmans 6416a20fd8 Adapt tcltest::Asciify, so it's usable for Tcl 8.5 and 8.6 too 2023-07-03 14:09:23 +00:00
jan.nijtmans 77c8868be4 Fix testcase (broken by previous commit) 2023-07-03 14:08:41 +00:00
jan.nijtmans ee7499c2e3 Fix comment (missing ticket ID) 2023-07-03 13:51:28 +00:00
jan.nijtmans 3bfb46688d Temporary disable tests io-7.3 and chanio-7.3, which fail in debug mode. Ticket [5be203d6ca] created. 2023-07-03 13:46:54 +00:00
jan.nijtmans 78c9978aa1 Fix [a5901fc953]: Version control should ignore unix/dltest/embtest 2023-07-03 08:03:03 +00:00
griffin 7968fff465 Add tests for scalar numeric values. 2023-07-03 00:33:16 +00:00
jan.nijtmans 67dfc6e7e3 Merge 8.7 2023-07-02 12:07:35 +00:00
jan.nijtmans 690c5c2c9e Merge 8.6 2023-07-02 12:02:51 +00:00
jan.nijtmans 0070215933 No need for function prototypes in unix/dltest/*.c 2023-07-02 11:53:38 +00:00
fvogel e668c10036 merge core-8-branch (no change) 2023-07-02 09:26:53 +00:00
fvogel 4773d1dadd merge core-8-6-branch (no change) 2023-07-02 09:26:29 +00:00
fvogel bf2b5846b0 Unbreak the 8.6 build. 2023-07-02 09:25:57 +00:00
fvogel 32bd9fd0d2 We definitely need to build core-8-6-branch of Tcl IMHO. 2023-07-02 08:21:04 +00:00
fvogel 5162de4fec We definitely need to build core-8-6-branch of Tcl IMHO. 2023-07-02 08:20:53 +00:00
fvogel 6b4a453621 We definitely need to build core-8-6-branch of Tcl IMHO. 2023-07-02 08:20:36 +00:00
apnadkarni 6a1f856c63 8.7 merge mark 2023-07-02 04:57:10 +00:00
apnadkarni 5dab0fa5de Backport fix [66ffafd309]. DBCS infinite loop on invalid encoding 2023-07-02 04:55:47 +00:00
apnadkarni f368137ec5 8.7 merge mark (lseq tests) 2023-07-02 04:54:33 +00:00
apnadkarni b863e0d57a Tests for [66ffafd309] 2023-07-02 03:03:30 +00:00
apnadkarni 01785b73fb Fix [66ffafd309]. DBCS infinite loop on invalid encoding 2023-07-02 02:41:59 +00:00
apnadkarni cfc103c6b8 Bug [66ffafd309] 2023-07-01 18:02:07 +00:00
griffin 7de69aeb41 merge trunk 2023-06-30 22:16:55 +00:00
griffin a55934d712 Test update for bug [63530267aa]. 2023-06-30 20:34:09 +00:00
griffin 04249bbcd7 Test update for bug [63530267aa]. Fix 32-bit embtest build issue. 2023-06-30 19:02:34 +00:00
griffin eb1f9c9989 merge trunk 2023-06-30 14:34:09 +00:00
jan.nijtmans da8010ca5c Merge 8.7. Remove unused TclArithSeriesObjLength() 2023-06-30 13:40:48 +00:00
jan.nijtmans 6c5be5280f Merge 8.6 2023-06-30 13:28:56 +00:00
jan.nijtmans 24f3e6199d Use more strict compilation-flags (but not -DTCL_MEM_DEBUG) in unix/dltest/Makefile 2023-06-30 13:10:36 +00:00
jan.nijtmans 81da6c1a9a Since TCL_MAJOR_VERSION is always "8", don't check for it. Add C++-compatible typecasts. 2023-06-30 13:08:30 +00:00
neumann f4a4df7a48 Updated configure script to ease testing with this branch 2023-06-30 09:56:01 +00:00
neumann c59dfa5e83 Removed automated setting of USE_VFORK for macOS
The automatic setting of USE_VFORK in unix/configure.in is useless,
confusing, and deprecated. 

Background: configure.in had a section, where it sets
automatically USE_VFORK for macOS.

if test "`uname -s`" = "Darwin" ; then
...
    AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
...

However, Daniel Steffen has added the following section 17 years ago
which effectively deactivated USE_VFORK for the x86_64 platform, when
it is set, due to a bug report in RDAR (Apple's bug tracking
system). 16 years ago a section was added to deactivate USE_VFORK for
all platforms with llvm-gcc-4.2 or newer.

/* 
 *---------------------------------------------------------------------------
 * At present, using vfork() instead of fork() causes execve() to fail
 * intermittently on Darwin x86_64. rdar://4685553
 *---------------------------------------------------------------------------
 */

/* Workaround problems with vfork() when building with llvm-gcc-4.2 */
            (__GNUC__ > 4 || (__GNUC__ == 4 && (__GNUC_MINOR__ > 2 || \
            (__GNUC_MINOR__ == 2 && __GNUC_PATCHLEVEL__ > 0))))

This means, that the last 17 years, USE_VFORK was not doing anything
on macOS. Furthermore, macOS 12 (Monterey, released 2021) deprecated
vfork() officially. 

Therefore, it is safe to remove the setting of USE_VFORK from the
default configuration for macOS.

It is still possible to set USE_VFORK manually for certain platform if
needed.
2023-06-30 09:49:08 +00:00
neumann 3f68e9f64f Added auto-configuration of posix_spawnp()
Removed the manual setting of USE_POSIX_SPAWN and
replaced it by HAVE_POSIX_SPAWNP.
2023-06-30 09:12:02 +00:00
jan.nijtmans 801ae4d914 Revert 'fix' for [ac874937c5], committed as part of a "Merge 8.7" commit. It's wrong, since "embtest" is expected to be an executable, not a shared library 2023-06-30 07:40:19 +00:00
griffin cd82527608 merge 8.7 2023-06-29 18:30:13 +00:00
griffin 6f98b30d5b Fix uninitialized variable. 2023-06-29 15:42:14 +00:00
dkf 4b6859f9dc Add timeouts to github workflows to catch runaway scripts 2023-06-29 15:13:57 +00:00
apnadkarni 13b2522d41 Merge 8.7 - Bug [6a3e2cb0f0] - invalid bytes in escape encodings 2023-06-29 11:30:51 +00:00
apnadkarni 6ae93efff0 Bug [6a3e2cb0f0] - invalid bytes in escape encodings 2023-06-29 11:09:29 +00:00
jan.nijtmans 3a1e74ddc5 Merge-mark 2023-06-29 07:24:20 +00:00
griffin b95bc2b4ce Fix ticket [63530267aa] by implementing ticket [e5f06285de] and making additional corrections. 2023-06-28 19:36:41 +00:00
jan.nijtmans 324c39d51c Merge 8.7 2023-06-28 07:27:17 +00:00
jan.nijtmans 26aa7dd453 Fix [26960060d7]: lseq-3.14 triggers use-after-free 2023-06-28 07:20:18 +00:00
jan.nijtmans bc27046551 Fix [78b9b6860c]: Please sync tclOOScript.h 2023-06-28 07:15:59 +00:00
jan.nijtmans e30e67e0cd Fix [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]: Bugs in the implementation of TIP #577 ('Enhanced index values for Tk') 2023-06-28 07:10:49 +00:00
jan.nijtmans e5d7a4afce Merge 9.0 2023-06-27 15:31:05 +00:00
jan.nijtmans d273c052a5 Fix [24a8c16dbd]: bigdata.test: invalid command name "testbigdata" on 32-bit 2023-06-27 12:57:13 +00:00
pooryorick 53cfe378b3 Fix previous errors in encoding.test 2023-06-27 10:07:19 +00:00
jan.nijtmans 7f18f499d0 Merge 8.7 2023-06-27 06:55:41 +00:00
jan.nijtmans 04d66a2571 Remove compat/dirent*.h and some other compat/*.c files: Modern C-compilers all have those now 2023-06-27 06:42:06 +00:00
jan.nijtmans e8d619b292 Merge 8.7 2023-06-26 10:12:17 +00:00
jan.nijtmans 1b53ef3bbd Remove compat/stdint.h and compat/stdlib.h: All C-compilers nowadays have it. 2023-06-26 09:52:00 +00:00
jan.nijtmans 07ea9d3df5 Merge 9.0 2023-06-23 23:18:41 +00:00
griffin bd64729686 merge trunk 2023-06-23 17:48:07 +00:00
griffin 4fdc66665f Fix build issue with no_deprecated. 2023-06-23 17:32:43 +00:00
jan.nijtmans be1a8384ef Merge 8.7 2023-06-22 20:07:18 +00:00
jan.nijtmans e37db31205 Fix [44452e2c55]: indexObj.test failures on i386 2023-06-22 19:00:59 +00:00
jan.nijtmans 823a3f2b2b Merge-mark 2023-06-22 13:40:35 +00:00
jan.nijtmans 9df01df02c Since Tcl 8.6 doesn't know about Tcl_Size, don't use it, not even in test comments 2023-06-22 13:39:14 +00:00
jan.nijtmans f35db8a093 Proposed fix for [44452e2c55]: indexObj.test failures on i386 2023-06-22 11:59:58 +00:00
jan.nijtmans b8c47674a4 WIP for fixing [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a] 2023-06-22 10:12:42 +00:00
jan.nijtmans 9a18abc855 merge-mark 2023-06-21 22:44:08 +00:00
jan.nijtmans 22c9ba1a27 (partial) fix for [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]: Bugs in the implementation of TIP 577 ("Enhanced index values for Tk" ) 2023-06-21 22:38:58 +00:00
jan.nijtmans bc87d9a2bc Fix 3 "lset" testcases 2023-06-21 21:30:53 +00:00
jan.nijtmans 7c2d72933f (partial) fix for [https://core.tcl-lang.org/tk/tktview/a9929f112a|a9929f112a]. Tk needs some changes too 2023-06-21 14:52:44 +00:00
jan.nijtmans eb09d3860d Merge 8.7 2023-06-21 07:18:34 +00:00
jan.nijtmans 09c0f68355 "trace variable" -> "trace add variable" in testcases (and documentation) 2023-06-21 07:13:48 +00:00
griffin 172063cace Fix bug in TEBC foreach with abstractlists 2023-06-20 22:16:54 +00:00
jan.nijtmans e26ccd75b1 Merge 8.7 2023-06-20 07:11:30 +00:00
jan.nijtmans 104527a107 Move VarHashGetKey() to tclInt.h. More int -> Tcl_Size 2023-06-20 06:51:49 +00:00
griffin 2e4b97b87f merge trunk 2023-06-20 01:47:47 +00:00
griffin be39d74ee7 Fix crash in BC execution when str concat and abstract list lindex operations have recursive BC execution.
Add testcase for this bug.
2023-06-20 01:28:25 +00:00
apnadkarni ded49faad5 Merge 8.7 - fix tests - hardcoded port and wsl. 2023-06-19 13:39:31 +00:00
apnadkarni 73a582c685 Merge 8.6 - fix tests - hardcoded port and wsl. 2023-06-19 13:21:46 +00:00
apnadkarni c2f255fe84 Fix hardcoded port numbers causing Windows failures with hyperv. Disable
file perm test for WSL.
2023-06-19 12:49:29 +00:00
jan.nijtmans 2ebe7012db Merge 8.7 2023-06-19 12:42:00 +00:00
jan.nijtmans ec8dfd57db Some more Tcl_Size usage 2023-06-19 11:47:58 +00:00
griffin d8ce1ffde8 merge trunk 2023-06-19 04:29:28 +00:00
jan.nijtmans 7f8e25f907 Fix [c13819225e]: Problem with lsort|lsearch -stride on 32-bit linux 2023-06-18 11:04:22 +00:00
griffin 06465624ac Clarification. 2023-06-18 01:51:10 +00:00
jan.nijtmans cf84dd6daf Proposed fix for [c13819225e]: Problem with lsort|lsearch -stride on 32-bit linux. Also fix some compiler warnings 2023-06-16 12:21:21 +00:00
oehhar 954457baf9 tip-636-tcl9-644: doc/Object.3: remove double "the" 2023-06-16 10:49:41 +00:00
griffin f1b8cb6289 Add Tcl_ObjType changes to the appropriate docs. 2023-06-15 20:45:55 +00:00
neumann 414a984d04 Made variant using USE_POSIX_SPAWN error message compatible
This change makes Tcl compiled with USE_POSIX_SPAWN activated error
message compatible with previous versions (using fork). Now, the Tcl
regression test succeeds without errors.
2023-06-15 16:56:35 +00:00
griffin 2e79331ac0 merge trunk 2023-06-13 16:59:57 +00:00
griffin 7d37ba8e63 Remove getdbl abstraction. 2023-06-13 16:47:25 +00:00
jan.nijtmans 478601a07b Merge 8.7 2023-06-13 09:12:25 +00:00
jan.nijtmans 3c8ac03074 Specify implicit "-profile tcl8" in encoding-24.4 testcase 2023-06-13 06:05:02 +00:00
pooryorick d07e50e54a Revert unwarranted change in Tcl_CreateChannel() from [1776327edd]. 2023-06-12 04:10:52 +00:00
jan.nijtmans 7ab30f565b Merge 8.6 2023-06-08 12:39:44 +00:00
oehhar 4314e8e438 ticket [c54e4a1aeb] patch: Use vfork instead fork. 2023-06-08 12:01:40 +00:00
jan.nijtmans 96c8069270 (cherry-pick): Added note about how some commands are mainly for Tk 2023-06-08 11:59:30 +00:00
griffin dde4e1b094 merge trunk 2023-06-06 20:26:59 +00:00
griffin ac52dca2ba Clean up logic to detect failures. 2023-06-06 16:04:41 +00:00
dkf a9377a35b7 Added note about how some commands are mainly for Tk 2023-06-05 11:12:08 +00:00
griffin d4e8db78c9 Function name cleanup. 2023-05-26 17:15:12 +00:00
griffin 22306f855b merge trunk, fix leak. 2023-05-25 20:55:52 +00:00
griffin 09bc3f7033 Remove old cruft. 2023-05-25 04:38:32 +00:00
griffin ba261e8e87 merge trunk 2023-05-24 23:17:17 +00:00
griffin c3f8318a3f Cleanup abstract list definitions. 2023-05-24 20:13:20 +00:00
griffin e91f967003 Merge trunk 2023-05-23 21:36:46 +00:00
griffin fa313109d6 Merge trunk 2023-05-17 16:12:25 +00:00
griffin 6781fbdf4b Add Tcl_BumpObj() used to prevent leaks from Abstract List elements.
Add Abstract List (ArithSeries) support in Tcl_ListObjIndex().
Fix obj leaks in lsearch operatations on ArithSeries.
Fix obj leaks in concat operations on ArithSeries.
Add concat and lsearch tests using lseq lists.
2023-05-17 05:09:01 +00:00
griffin 7b647d920a merge trunk 2023-05-09 15:58:53 +00:00
griffin 9aac3677ed merge trunk 2023-05-03 02:01:11 +00:00
griffin ca58c3ae9a Partial sync-up with trunk. 2023-04-30 23:09:13 +00:00
jan.nijtmans 84a0e08557 Patch from chrstphrchvz, fixing [d40b9c8503]. Many thanks! 2023-03-26 15:51:21 +00:00
griffin 879e7b7112 Merge trunk 2023-03-25 00:29:59 +00:00
jan.nijtmans ef7bbf24e8 code cleanup (reduce diff with trunk) 2022-12-24 09:11:56 +00:00
jan.nijtmans 4531aa608d Merge 9.0 2022-12-22 16:17:57 +00:00
griffin bc3ff73062 Make as much abstract list implementation as possible internal.
Other code cleanup also.
2022-12-21 06:59:38 +00:00
jan.nijtmans a3f8bc6993 Merge 9.0. Now really make dist tests working (again) on Windows/gcc 2022-12-20 10:58:06 +00:00
jan.nijtmans bc7cadbfec Merge 9.0. Make dist tests working (again) on Windows/gcc 2022-12-20 07:24:42 +00:00
jan.nijtmans ab239a3b1f Merge 9.0 2022-12-18 21:38:14 +00:00
jan.nijtmans 7157c6b878 Reserve a place in abstractlist for an additional function 2022-12-18 10:05:40 +00:00
jan.nijtmans 0cdcbf3481 Merge 9.0 2022-12-18 09:10:25 +00:00
jan.nijtmans 9006753369 Merge 9.0. Fix testcases 2022-12-08 14:24:20 +00:00
griffin 6b52bc1a64 Add 'getdouble' function to ObjType, used for abstractlist types. -- Experimental 2022-12-07 23:56:10 +00:00
jan.nijtmans 3836fc2905 Code cleanup (undo some unnecessary changed compared to trunk) 2022-12-01 15:57:20 +00:00
jan.nijtmans 01f2b842e8 Merge 9.0. Fix Windows build (testcases need tcl::test package). Modify TCL_OBJTYPE_V1() macro, so it checks for the number of arguments 2022-12-01 15:16:37 +00:00
griffin b22a59093e Fix bug with slice (range) operation 2022-12-01 02:10:32 +00:00
jan.nijtmans f101fd4d8b Merge 9.0. Rename TclObjTypeHasProc to ABSTRACTLIST_PROC 2022-11-30 22:05:52 +00:00
jan.nijtmans bacd42baab Merge 9.0 2022-11-30 11:13:47 +00:00
jan.nijtmans 4a8099f371 Merge 9.0 (but without the "llength" optimization) 2022-11-30 10:46:57 +00:00
jan.nijtmans 5f45d1454b Merge 9.0 2022-11-29 10:38:49 +00:00
jan.nijtmans b1ee845c02 Merge 9.0 2022-11-29 09:53:43 +00:00
jan.nijtmans 64383b33bd Simplify TclObjTypeHasProc() (a lot!) 2022-11-28 21:45:49 +00:00
jan.nijtmans 2aa92d31a0 Merge 9.0 2022-11-28 16:13:34 +00:00
jan.nijtmans feee6ec002 Merge 9.0 2022-11-25 10:14:57 +00:00
jan.nijtmans b22f30259b TCL_OBJTYPE_V0_INIT -> TCL_OBJTYPE_V0 (See TIP #644). Remove Tcl_SavedResult (See TIP #640) 2022-11-24 21:48:42 +00:00
griffin 85ff1f33c9 Sync with trunk 2022-11-24 20:31:05 +00:00
griffin a4e76a1c02 Sync with trunk 2022-11-24 03:32:46 +00:00
griffin 7b6d022905 Support multiple indicies in abstract list lindex operation.
Catch up with trunk.
2022-11-24 01:18:36 +00:00
griffin 4335a4f475 Remove unused/incomplete functions. Some cleanup. 2022-11-08 22:02:33 +00:00
griffin 3e26e1b26d Sync with trunk 2022-11-06 05:20:26 +00:00
griffin 93374294e8 Sync with trunk 2022-11-05 23:35:46 +00:00
griffin 44a73b3640 Implement abstractlist with tip-644 2022-11-04 22:47:23 +00:00
griffin 853e484a64 TIP 636 for Tcl 9 2022-11-02 22:33:01 +00:00
griffin e2e526bea8 Swap which ObjTyp ptr is used for concrete Rep to match other types. 2022-11-02 16:45:47 +00:00
griffin c5bb0bc339 Sync with core-8-branch 2022-11-01 03:18:39 +00:00
griffin 028b789aec Add missing GetType call to export decls. Change SetElement to support multiple indicies. Improve abstract list test coverage. 2022-10-31 21:50:46 +00:00
griffin bb6cdd342a Sync with core-8-branch 2022-10-28 18:53:27 +00:00
griffin a89453a9e9 Expand AbstractList regression testing. 2022-10-28 06:13:11 +00:00
griffin 119e80fb28 Sync with core-8-branch 2022-10-25 02:30:28 +00:00
griffin 6d3452eeac Add AbstractList regression test (exercise the C API) 2022-10-25 01:13:45 +00:00
griffin e38c5076fe Sync with core-8-branch 2022-10-22 21:13:54 +00:00
griffin 6f1b4d55a4 Add Replace (lreplace) function to AbstractList type, and corrisponding Tcl_AbstractListObjReplace() API. 2022-10-22 00:07:40 +00:00
griffin 8b7cf2c7eb Sync with core-8-branch 2022-10-19 22:29:46 +00:00
griffin 0bc040dc40 More work on lset support in AbstractLists 2022-10-19 04:35:15 +00:00
griffin fb722eca56 Add SetElement function to abstract lists. Fix a few bugs. 2022-10-18 01:03:19 +00:00
griffin 699ec9db36 Sync with core-8-branch 2022-10-14 22:35:01 +00:00
griffin f72344d643 Update AbstractList man page. 2022-10-14 22:06:42 +00:00
griffin 999de87fbf Sync with core-8-branch 2022-10-12 21:16:12 +00:00
griffin 48ae5e307e Modify AbstractList functions to include interp for error reporting. Other various improvements. 2022-10-11 03:49:20 +00:00
apnadkarni 80303ffb39 Generalize UpdateStringOfAbstractList 2022-10-09 06:21:43 +00:00
griffin 7468d97286 Code cleanup and reorganize 2022-10-08 22:31:32 +00:00
griffin d24ee59fb5 TIP #636 starting imiplementation. 2022-10-08 04:28:55 +00:00
griffin f2fd360d01 Sync with core-8-branch 2022-10-08 02:39:41 +00:00
griffin af613a176f Sync with core-8-branch 2022-10-07 19:14:18 +00:00
griffin 9ed6390f05 Remove redundant file references in makefiles 2022-09-30 18:33:34 +00:00
griffin 259828fa5f Sync with core-8-branch 2022-09-29 13:45:46 +00:00
jan.nijtmans a60681c2f3 Mrge 8.7. Make it work with C++, adapt win/Makefile.in to make it build on Windows with gcc 2022-09-08 14:53:35 +00:00
jan.nijtmans b9b527183a Merge 8.7 2022-09-07 13:26:09 +00:00
griffin 446587dc91 Missed change for Windows. 2022-08-28 00:45:40 +00:00
griffin 31c68fa4e7 Move all ArithSeries code to it's own file. Sync other changes wil TIP-629. 2022-08-28 00:10:13 +00:00
griffin f9e3b4dd74 Reimplement AbstrctList type structure to simplify. fix various bugs. 2022-08-19 18:08:39 +00:00
griffin 8bf1d3fbf1 Fix memory leak. 2022-08-15 15:23:24 +00:00
griffin 298667e221 Fix UpdateString to handle general case. Fix bug with elements list. 2022-08-11 16:21:39 +00:00
griffin 129d7aee61 Fix memory leak with Tcl_AbstractListObjGetElements. 2022-08-10 17:28:09 +00:00
griffin 92f5f9afc6 Make AbstractListRepPtr part of the public API as Tcl_AbstractListRepPtr.
Fix bug with ArithSeries Reverse function.
2022-08-10 04:21:16 +00:00
apnadkarni f3b81a9854 Fix Windows Visual C++ build 2022-08-09 16:07:24 +00:00
griffin 7561d600a6 Add version number to AbstractList implementation. Make sure lsort and lreplace do not shimer their input argument. 2022-08-08 23:52:43 +00:00
griffin 7030b2b274 Abstract Lists (TIP-225) initial implementation. 2022-08-08 19:38:19 +00:00
137 changed files with 10228 additions and 10004 deletions
+2
View File
@@ -48,9 +48,11 @@ libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/dltest/*.bundle
unix/dltest/*.dll
unix/dltest/*.dylib
unix/dltest/*.exe
unix/dltest/*.o
unix/dltest/*.sl
unix/dltest/*.so
+9
View File
@@ -4,6 +4,7 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -28,6 +29,7 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -38,23 +40,30 @@ jobs:
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: |
make all
timeout-minutes: 5
- name: Build Test Harness
run: |
make tcltest
timeout-minutes: 5
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
timeout-minutes: 30
- name: Test-Drive Installation
run: |
make install
timeout-minutes: 5
- name: Create Distribution Package
run: |
make dist
timeout-minutes: 5
- name: Convert Documentation to HTML
run: |
make html-tcl
timeout-minutes: 5
+8
View File
@@ -4,6 +4,7 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -18,6 +19,7 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -26,11 +28,13 @@ jobs:
run: make all
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Run Tests
run: make test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 15
clang:
runs-on: macos-11
strategy:
@@ -48,6 +52,7 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -59,14 +64,17 @@ jobs:
env:
CFLAGS: -arch x86_64 -arch arm64
CFGOPT: ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: |
make all tcltest
env:
CFLAGS: -arch x86_64 -arch arm64
timeout-minutes: 15
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
timeout-minutes: 15
+3
View File
@@ -15,6 +15,7 @@ jobs:
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v3
@@ -50,6 +51,7 @@ jobs:
defaults:
run:
shell: bash
timeout-minutes: 10
steps:
- name: Checkout
uses: actions/checkout@v3
@@ -112,6 +114,7 @@ jobs:
defaults:
run:
shell: msys2 {0}
timeout-minutes: 10
env:
CC: gcc
CFGOPT: --disable-symbols --disable-shared
+12
View File
@@ -4,6 +4,7 @@ on:
branches:
- "main"
- "core-8-branch"
- "core-8-6-branch"
tags:
- "core-**"
permissions:
@@ -30,26 +31,31 @@ jobs:
steps:
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
timeout-minutes: 5
- name: Build ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} all
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Build Test Harness ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 5
- name: Run Tests ${{ matrix.cfgopt }}
run: |
&nmake -f makefile.vc ${{ matrix.cfgopt }} test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
timeout-minutes: 30
gcc:
runs-on: windows-2022
defaults:
@@ -73,8 +79,10 @@ jobs:
with:
msystem: MINGW64
install: git mingw-w64-x86_64-toolchain make
timeout-minutes: 10
- name: Checkout
uses: actions/checkout@v3
timeout-minutes: 5
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -85,12 +93,16 @@ jobs:
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
timeout-minutes: 5
- name: Build
run: make all
timeout-minutes: 5
- name: Build Test Harness
run: make tcltest
timeout-minutes: 5
- name: Run Tests
run: make test
timeout-minutes: 30
# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.
+1
View File
@@ -53,6 +53,7 @@ libtommath/*.tex
macosx/configure
unix/autoMkindex.tcl
unix/dltest.marker
unix/dltest/embtest
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
+1 -1
View File
@@ -8247,7 +8247,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans)
2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
-21
View File
@@ -1,21 +0,0 @@
/*
* dirent.h --
*
* This file is a replacement for <dirent.h> in systems that
* support the old BSD-style <sys/dir.h> with a "struct direct".
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _DIRENT
#define _DIRENT
#include <sys/dir.h>
#define dirent direct
#endif /* _DIRENT */
-53
View File
@@ -1,53 +0,0 @@
/*
* dirent.h --
*
* Declarations of a library of directory-reading procedures
* in the POSIX style ("struct dirent").
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _DIRENT
#define _DIRENT
/*
* Dirent structure, which holds information about a single
* directory entry.
*/
#define MAXNAMLEN 255
#define DIRBLKSIZ 512
struct dirent {
long d_ino; /* Inode number of entry */
short d_reclen; /* Length of this record */
short d_namlen; /* Length of string in d_name */
char d_name[MAXNAMLEN + 1]; /* Name must be no longer than this */
};
/*
* State that keeps track of the reading of a directory (clients
* should never look inside this structure; the fields should
* only be accessed by the library procedures).
*/
typedef struct _dirdesc {
int dd_fd;
long dd_loc;
long dd_size;
char dd_buf[DIRBLKSIZ];
} DIR;
/*
* Procedures defined for reading directories:
*/
extern void closedir (DIR *dirp);
extern DIR * opendir (char *name);
extern struct dirent * readdir (DIR *dirp);
#endif /* _DIRENT */
-64
View File
@@ -1,64 +0,0 @@
/*
* memcmp.c --
*
* Source code for the "memcmp" library routine.
*
* Copyright (c) 1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclPort.h"
/*
* Here is the prototype just in case it is not included in tclPort.h.
*/
int memcmp(const void *s1, const void *s2, size_t n);
/*
*----------------------------------------------------------------------
*
* memcmp --
*
* Compares two bytes sequences.
*
* Results:
* Compares its arguments, looking at the first n bytes (each interpreted
* as an unsigned char), and returns an integer less than, equal to, or
* greater than 0, according as s1 is less than, equal to, or greater
* than s2 when taken to be unsigned 8 bit numbers.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
memcmp(
const void *s1, /* First string. */
const void *s2, /* Second string. */
size_t n) /* Length to compare. */
{
const unsigned char *ptr1 = (const unsigned char *) s1;
const unsigned char *ptr2 = (const unsigned char *) s2;
for ( ; n-- ; ptr1++, ptr2++) {
unsigned char u1 = *ptr1, u2 = *ptr2;
if (u1 != u2) {
return (u1-u2);
}
}
return 0;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
-109
View File
@@ -1,109 +0,0 @@
/*
* opendir.c --
*
* This file provides dirent-style directory-reading procedures for V7
* Unix systems that don't have such procedures. The origin of this code
* is unclear, but it seems to have come originally from Larry Wall.
*/
#include "tclInt.h"
#undef DIRSIZ
#define DIRSIZ(dp) \
((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
/*
* open a directory.
*/
DIR *
opendir(
char *name)
{
DIR *dirp;
int fd;
const char *myname;
myname = ((*name == '\0') ? "." : name);
if ((fd = open(myname, 0, 0)) == -1) {
return NULL;
}
dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
if (dirp == NULL) {
close(fd);
return NULL;
}
dirp->dd_fd = fd;
dirp->dd_loc = 0;
return dirp;
}
/*
* read an old style directory entry and present it as a new one
*/
#ifndef pyr
#define ODIRSIZ 14
struct olddirect {
ino_t od_ino;
char od_name[ODIRSIZ];
};
#else /* a Pyramid in the ATT universe */
#define ODIRSIZ 248
struct olddirect {
long od_ino;
short od_fill1, od_fill2;
char od_name[ODIRSIZ];
};
#endif
/*
* get next entry in a directory.
*/
struct dirent *
readdir(
DIR *dirp)
{
struct olddirect *dp;
static struct dirent dir;
for (;;) {
if (dirp->dd_loc == 0) {
dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
if (dirp->dd_size <= 0) {
return NULL;
}
}
if (dirp->dd_loc >= dirp->dd_size) {
dirp->dd_loc = 0;
continue;
}
dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
dirp->dd_loc += sizeof(struct olddirect);
if (dp->od_ino == 0) {
continue;
}
dir.d_ino = dp->od_ino;
strncpy(dir.d_name, dp->od_name, ODIRSIZ);
dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
dir.d_namlen = strlen(dir.d_name);
dir.d_reclen = DIRSIZ(&dir);
return &dir;
}
}
/*
* close a directory.
*/
void
closedir(
DIR *dirp)
{
close(dirp->dd_fd);
dirp->dd_fd = -1;
dirp->dd_loc = 0;
Tcl_Free(dirp);
}
-919
View File
@@ -1,919 +0,0 @@
/* A portable stdint.h
****************************************************************************
* BSD License:
****************************************************************************
*
* Copyright (c) 2005-2016 Paul Hsieh
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the author may not be used to endorse or promote products
* derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
****************************************************************************
*
* Version 0.1.16.0
*
* The ANSI C standard committee, for the C99 standard, specified the
* inclusion of a new standard include file called stdint.h. This is
* a very useful and long desired include file which contains several
* very precise definitions for integer scalar types that is critically
* important for making several classes of applications portable
* including cryptography, hashing, variable length integer libraries
* and so on. But for most developers its likely useful just for
* programming sanity.
*
* The problem is that some compiler vendors chose to ignore the C99
* standard and some older compilers have no opportunity to be updated.
* Because of this situation, simply including stdint.h in your code
* makes it unportable.
*
* So that's what this file is all about. It's an attempt to build a
* single universal include file that works on as many platforms as
* possible to deliver what stdint.h is supposed to. Even compilers
* that already come with stdint.h can use this file instead without
* any loss of functionality. A few things that should be noted about
* this file:
*
* 1) It is not guaranteed to be portable and/or present an identical
* interface on all platforms. The extreme variability of the
* ANSI C standard makes this an impossibility right from the
* very get go. Its really only meant to be useful for the vast
* majority of platforms that possess the capability of
* implementing usefully and precisely defined, standard sized
* integer scalars. Systems which are not intrinsically 2s
* complement may produce invalid constants.
*
* 2) There is an unavoidable use of non-reserved symbols.
*
* 3) Other standard include files are invoked.
*
* 4) This file may come in conflict with future platforms that do
* include stdint.h. The hope is that one or the other can be
* used with no real difference.
*
* 5) In the current version, if your platform can't represent
* int32_t, int16_t and int8_t, it just dumps out with a compiler
* error.
*
* 6) 64 bit integers may or may not be defined. Test for their
* presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
* Note that this is different from the C99 specification which
* requires the existence of 64 bit support in the compiler. If
* this is not defined for your platform, yet it is capable of
* dealing with 64 bits then it is because this file has not yet
* been extended to cover all of your system's capabilities.
*
* 7) (u)intptr_t may or may not be defined. Test for its presence
* with the test: #ifdef PTRDIFF_MAX. If this is not defined
* for your platform, then it is because this file has not yet
* been extended to cover all of your system's capabilities, not
* because its optional.
*
* 8) The following might not been defined even if your platform is
* capable of defining it:
*
* WCHAR_MIN
* WCHAR_MAX
* (u)int64_t
* PTRDIFF_MIN
* PTRDIFF_MAX
* (u)intptr_t
*
* 9) The following have not been defined:
*
* WINT_MIN
* WINT_MAX
*
* 10) The criteria for defining (u)int_least(*)_t isn't clear,
* except for systems which don't have a type that precisely
* defined 8, 16, or 32 bit types (which this include file does
* not support anyways). Default definitions have been given.
*
* 11) The criteria for defining (u)int_fast(*)_t isn't something I
* would trust to any particular compiler vendor or the ANSI C
* committee. It is well known that "compatible systems" are
* commonly created that have very different performance
* characteristics from the systems they are compatible with,
* especially those whose vendors make both the compiler and the
* system. Default definitions have been given, but its strongly
* recommended that users never use these definitions for any
* reason (they do *NOT* deliver any serious guarantee of
* improved performance -- not in this file, nor any vendor's
* stdint.h).
*
* 12) The following macros:
*
* PRINTF_INTMAX_MODIFIER
* PRINTF_INT64_MODIFIER
* PRINTF_INT32_MODIFIER
* PRINTF_INT16_MODIFIER
* PRINTF_LEAST64_MODIFIER
* PRINTF_LEAST32_MODIFIER
* PRINTF_LEAST16_MODIFIER
* PRINTF_INTPTR_MODIFIER
*
* are strings which have been defined as the modifiers required
* for the "d", "u" and "x" printf formats to correctly output
* (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
* (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
* PRINTF_INTPTR_MODIFIER is not defined for some systems which
* provide their own stdint.h. PRINTF_INT64_MODIFIER is not
* defined if INT64_MAX is not defined. These are an extension
* beyond what C99 specifies must be in stdint.h.
*
* In addition, the following macros are defined:
*
* PRINTF_INTMAX_HEX_WIDTH
* PRINTF_INT64_HEX_WIDTH
* PRINTF_INT32_HEX_WIDTH
* PRINTF_INT16_HEX_WIDTH
* PRINTF_INT8_HEX_WIDTH
* PRINTF_INTMAX_DEC_WIDTH
* PRINTF_INT64_DEC_WIDTH
* PRINTF_INT32_DEC_WIDTH
* PRINTF_INT16_DEC_WIDTH
* PRINTF_UINT8_DEC_WIDTH
* PRINTF_UINTMAX_DEC_WIDTH
* PRINTF_UINT64_DEC_WIDTH
* PRINTF_UINT32_DEC_WIDTH
* PRINTF_UINT16_DEC_WIDTH
* PRINTF_UINT8_DEC_WIDTH
*
* Which specifies the maximum number of characters required to
* print the number of that type in either hexadecimal or decimal.
* These are an extension beyond what C99 specifies must be in
* stdint.h.
*
* Compilers tested (all with 0 warnings at their highest respective
* settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
* bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
* .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
*
* This file should be considered a work in progress. Suggestions for
* improvements, especially those which increase coverage are strongly
* encouraged.
*
* Acknowledgements
*
* The following people have made significant contributions to the
* development and testing of this file:
*
* Chris Howie
* John Steele Scott
* Dave Thorup
* John Dill
* Florian Wobbe
* Christopher Sean Morrison
* Mikkel Fahnoe Jorgensen
*
*/
#include <stddef.h>
#include <limits.h>
#include <signal.h>
/*
* For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
* do nothing else. On the Mac OS X version of gcc this is _STDINT_H_.
*/
#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
#include <stdint.h>
#define _PSTDINT_H_INCLUDED
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "l"
# endif
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
# else
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# ifndef PRINTF_INT32_MODIFIER
# if (UINT_MAX == UINT32_MAX)
# define PRINTF_INT32_MODIFIER ""
# else
# define PRINTF_INT32_MODIFIER "l"
# endif
# endif
# endif
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_UINT64_HEX_WIDTH
# define PRINTF_UINT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_UINT32_HEX_WIDTH
# define PRINTF_UINT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_UINT16_HEX_WIDTH
# define PRINTF_UINT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_UINT8_HEX_WIDTH
# define PRINTF_UINT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
# endif
# ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
# endif
# ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_UINTMAX_HEX_WIDTH
# define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
# ifndef PRINTF_UINTMAX_DEC_WIDTH
# define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
/*
* Something really weird is going on with Open Watcom. Just pull some of
* these duplicated definitions from Open Watcom's stdint.h file for now.
*/
# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
# if !defined (INT64_C)
# define INT64_C(x) (x + (INT64_MAX - INT64_MAX))
# endif
# if !defined (UINT64_C)
# define UINT64_C(x) (x + (UINT64_MAX - UINT64_MAX))
# endif
# if !defined (INT32_C)
# define INT32_C(x) (x + (INT32_MAX - INT32_MAX))
# endif
# if !defined (UINT32_C)
# define UINT32_C(x) (x + (UINT32_MAX - UINT32_MAX))
# endif
# if !defined (INT16_C)
# define INT16_C(x) (x)
# endif
# if !defined (UINT16_C)
# define UINT16_C(x) (x)
# endif
# if !defined (INT8_C)
# define INT8_C(x) (x)
# endif
# if !defined (UINT8_C)
# define UINT8_C(x) (x)
# endif
# if !defined (UINT64_MAX)
# define UINT64_MAX 18446744073709551615ULL
# endif
# if !defined (INT64_MAX)
# define INT64_MAX 9223372036854775807LL
# endif
# if !defined (UINT32_MAX)
# define UINT32_MAX 4294967295UL
# endif
# if !defined (INT32_MAX)
# define INT32_MAX 2147483647L
# endif
# if !defined (INTMAX_MAX)
# define INTMAX_MAX INT64_MAX
# endif
# if !defined (INTMAX_MIN)
# define INTMAX_MIN INT64_MIN
# endif
# endif
#endif
/*
* I have no idea what is the truly correct thing to do on older Solaris.
* From some online discussions, this seems to be what is being
* recommended. For people who actually are developing on older Solaris,
* what I would like to know is, does this define all of the relevant
* macros of a complete stdint.h? Remember, in pstdint.h 64 bit is
* considered optional.
*/
#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
#include <sys/inttypes.h>
#define _PSTDINT_H_INCLUDED
#endif
#ifndef _PSTDINT_H_INCLUDED
#define _PSTDINT_H_INCLUDED
#ifndef SIZE_MAX
# define SIZE_MAX ((size_t)-1)
#endif
/*
* Deduce the type assignments from limits.h under the assumption that
* integer sizes in bits are powers of 2, and follow the ANSI
* definitions.
*/
#ifndef UINT8_MAX
# define UINT8_MAX 0xff
#endif
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
typedef unsigned char uint8_t;
# define UINT8_C(v) ((uint8_t) v)
# else
# error "Platform not supported"
# endif
#endif
#ifndef INT8_MAX
# define INT8_MAX 0x7f
#endif
#ifndef INT8_MIN
# define INT8_MIN INT8_C(0x80)
#endif
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
typedef signed char int8_t;
# define INT8_C(v) ((int8_t) v)
# else
# error "Platform not supported"
# endif
#endif
#ifndef UINT16_MAX
# define UINT16_MAX 0xffff
#endif
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
typedef unsigned int uint16_t;
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER ""
# endif
# define UINT16_C(v) ((uint16_t) (v))
#elif (USHRT_MAX == UINT16_MAX)
typedef unsigned short uint16_t;
# define UINT16_C(v) ((uint16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef INT16_MAX
# define INT16_MAX 0x7fff
#endif
#ifndef INT16_MIN
# define INT16_MIN INT16_C(0x8000)
#endif
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
typedef signed int int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER ""
# endif
#elif (SHRT_MAX == INT16_MAX)
typedef signed short int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
# define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef UINT32_MAX
# define UINT32_MAX (0xffffffffUL)
#endif
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
typedef unsigned long uint32_t;
# define UINT32_C(v) v ## UL
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER "l"
# endif
#elif (UINT_MAX == UINT32_MAX)
typedef unsigned int uint32_t;
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
# define UINT32_C(v) v ## U
#elif (USHRT_MAX == UINT32_MAX)
typedef unsigned short uint32_t;
# define UINT32_C(v) ((unsigned short) (v))
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif
#ifndef INT32_MAX
# define INT32_MAX (0x7fffffffL)
#endif
#ifndef INT32_MIN
# define INT32_MIN INT32_C(0x80000000)
#endif
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
typedef signed long int32_t;
# define INT32_C(v) v ## L
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER "l"
# endif
#elif (INT_MAX == INT32_MAX)
typedef signed int int32_t;
# define INT32_C(v) v
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#elif (SHRT_MAX == INT32_MAX)
typedef signed short int32_t;
# define INT32_C(v) ((short) (v))
# ifndef PRINTF_INT32_MODIFIER
# define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif
/*
* The macro stdint_int64_defined is temporarily used to record
* whether or not 64 integer support is available. It must be
* defined for any 64 integer extensions for new platforms that are
* added.
*/
#undef stdint_int64_defined
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
# define stdint_int64_defined
typedef long long int64_t;
typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# endif
#endif
#if !defined (stdint_int64_defined)
# if defined(__GNUC__) && !defined(vxWorks)
# define stdint_int64_defined
__extension__ typedef long long int64_t;
__extension__ typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
# define stdint_int64_defined
typedef long long int64_t;
typedef unsigned long long uint64_t;
# define UINT64_C(v) v ## ULL
# define INT64_C(v) v ## LL
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "ll"
# endif
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
# define stdint_int64_defined
typedef __int64 int64_t;
typedef unsigned __int64 uint64_t;
# define UINT64_C(v) v ## UI64
# define INT64_C(v) v ## I64
# ifndef PRINTF_INT64_MODIFIER
# define PRINTF_INT64_MODIFIER "I64"
# endif
# endif
#endif
#if !defined (LONG_LONG_MAX) && defined (INT64_C)
# define LONG_LONG_MAX INT64_C (9223372036854775807)
#endif
#ifndef ULONG_LONG_MAX
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
#endif
#if !defined (INT64_MAX) && defined (INT64_C)
# define INT64_MAX INT64_C (9223372036854775807)
#endif
#if !defined (INT64_MIN) && defined (INT64_C)
# define INT64_MIN INT64_C (-9223372036854775808)
#endif
#if !defined (UINT64_MAX) && defined (INT64_C)
# define UINT64_MAX UINT64_C (18446744073709551615)
#endif
/*
* Width of hexadecimal for number field.
*/
#ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
#endif
#ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
#endif
#ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
#endif
#ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
#endif
#ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
#endif
#ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
#endif
#ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
#endif
#ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
#endif
/*
* Ok, lets not worry about 128 bit integers for now. Moore's law says
* we don't need to worry about that until about 2040 at which point
* we'll have bigger things to worry about.
*/
#ifdef stdint_int64_defined
typedef int64_t intmax_t;
typedef uint64_t uintmax_t;
# define INTMAX_MAX INT64_MAX
# define INTMAX_MIN INT64_MIN
# define UINTMAX_MAX UINT64_MAX
# define UINTMAX_C(v) UINT64_C(v)
# define INTMAX_C(v) INT64_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
# endif
#else
typedef int32_t intmax_t;
typedef uint32_t uintmax_t;
# define INTMAX_MAX INT32_MAX
# define UINTMAX_MAX UINT32_MAX
# define UINTMAX_C(v) UINT32_C(v)
# define INTMAX_C(v) INT32_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
# define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
# define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
# define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
# endif
#endif
/*
* Because this file currently only supports platforms which have
* precise powers of 2 as bit sizes for the default integers, the
* least definitions are all trivial. Its possible that a future
* version of this file could have different definitions.
*/
#ifndef stdint_least_defined
typedef int8_t int_least8_t;
typedef uint8_t uint_least8_t;
typedef int16_t int_least16_t;
typedef uint16_t uint_least16_t;
typedef int32_t int_least32_t;
typedef uint32_t uint_least32_t;
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
# define UINT_LEAST8_MAX UINT8_MAX
# define INT_LEAST8_MAX INT8_MAX
# define UINT_LEAST16_MAX UINT16_MAX
# define INT_LEAST16_MAX INT16_MAX
# define UINT_LEAST32_MAX UINT32_MAX
# define INT_LEAST32_MAX INT32_MAX
# define INT_LEAST8_MIN INT8_MIN
# define INT_LEAST16_MIN INT16_MIN
# define INT_LEAST32_MIN INT32_MIN
# ifdef stdint_int64_defined
typedef int64_t int_least64_t;
typedef uint64_t uint_least64_t;
# define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
# define UINT_LEAST64_MAX UINT64_MAX
# define INT_LEAST64_MAX INT64_MAX
# define INT_LEAST64_MIN INT64_MIN
# endif
#endif
#undef stdint_least_defined
/*
* The ANSI C committee has defined *int*_fast*_t types as well. This,
* of course, defies rationality -- you can't know what will be fast
* just from the type itself. Even for a given architecture, compatible
* implementations might have different performance characteristics.
* Developers are warned to stay away from these types when using this
* or any other stdint.h.
*/
typedef int_least8_t int_fast8_t;
typedef uint_least8_t uint_fast8_t;
typedef int_least16_t int_fast16_t;
typedef uint_least16_t uint_fast16_t;
typedef int_least32_t int_fast32_t;
typedef uint_least32_t uint_fast32_t;
#define UINT_FAST8_MAX UINT_LEAST8_MAX
#define INT_FAST8_MAX INT_LEAST8_MAX
#define UINT_FAST16_MAX UINT_LEAST16_MAX
#define INT_FAST16_MAX INT_LEAST16_MAX
#define UINT_FAST32_MAX UINT_LEAST32_MAX
#define INT_FAST32_MAX INT_LEAST32_MAX
#define INT_FAST8_MIN INT_LEAST8_MIN
#define INT_FAST16_MIN INT_LEAST16_MIN
#define INT_FAST32_MIN INT_LEAST32_MIN
#ifdef stdint_int64_defined
typedef int_least64_t int_fast64_t;
typedef uint_least64_t uint_fast64_t;
# define UINT_FAST64_MAX UINT_LEAST64_MAX
# define INT_FAST64_MAX INT_LEAST64_MAX
# define INT_FAST64_MIN INT_LEAST64_MIN
#endif
#undef stdint_int64_defined
/*
* Whatever piecemeal, per compiler thing we can do about the wchar_t
* type limits.
*/
#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
# include <wchar.h>
# ifndef WCHAR_MIN
# define WCHAR_MIN 0
# endif
# ifndef WCHAR_MAX
# define WCHAR_MAX ((wchar_t)-1)
# endif
#endif
/*
* Whatever piecemeal, per compiler/platform thing we can do about the
* (u)intptr_t types and limits.
*/
#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
# define STDINT_H_UINTPTR_T_DEFINED
#endif
#ifndef STDINT_H_UINTPTR_T_DEFINED
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
# define stdint_intptr_bits 64
# elif defined (__WATCOMC__) || defined (__TURBOC__)
# if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
# define stdint_intptr_bits 16
# else
# define stdint_intptr_bits 32
# endif
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
# define stdint_intptr_bits 32
# elif defined (__INTEL_COMPILER)
/* TODO -- what did Intel do about x86-64? */
# else
/* #error "This platform might not be supported yet" */
# endif
# ifdef stdint_intptr_bits
# define stdint_intptr_glue3_i(a,b,c) a##b##c
# define stdint_intptr_glue3(a,b,c) stdint_intptr_glue3_i(a,b,c)
# ifndef PRINTF_INTPTR_MODIFIER
# define PRINTF_INTPTR_MODIFIER stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
# endif
# ifndef PTRDIFF_MAX
# define PTRDIFF_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
# endif
# ifndef PTRDIFF_MIN
# define PTRDIFF_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
# endif
# ifndef UINTPTR_MAX
# define UINTPTR_MAX stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
# endif
# ifndef INTPTR_MAX
# define INTPTR_MAX stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
# endif
# ifndef INTPTR_MIN
# define INTPTR_MIN stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
# endif
# ifndef INTPTR_C
# define INTPTR_C(x) stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
# endif
# ifndef UINTPTR_C
# define UINTPTR_C(x) stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
# endif
typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t) intptr_t;
# else
/* TODO -- This following is likely wrong for some platforms, and does
nothing for the definition of uintptr_t. */
typedef ptrdiff_t intptr_t;
# endif
# define STDINT_H_UINTPTR_T_DEFINED
#endif
/*
* Assumes sig_atomic_t is signed and we have a 2s complement machine.
*/
#ifndef SIG_ATOMIC_MAX
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
#endif
#endif
#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)
/*
* Please compile with the maximum warning settings to make sure macros are
* not defined more than once.
*/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#define glue3_aux(x,y,z) x ## y ## z
#define glue3(x,y,z) glue3_aux(x,y,z)
#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);
#define DECL(us,bits) glue3(DECL,us,) (bits)
#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)
#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }
#define X_SIZE_MAX ((size_t)-1)
int main () {
int err_n = 0;
int err_first = 0;
DECL(I,8)
DECL(U,8)
DECL(I,16)
DECL(U,16)
DECL(I,32)
DECL(U,32)
#ifdef INT64_MAX
DECL(I,64)
DECL(U,64)
#endif
intmax_t imax = INTMAX_C(0);
uintmax_t umax = UINTMAX_C(0);
char str0[256], str1[256];
sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
#ifdef INT64_MAX
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
#endif
sprintf (str0, "%d %x\n", 0, ~0);
sprintf (str1, "%d %x\n", i8, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
sprintf (str1, "%u %x\n", u8, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
sprintf (str1, "%d %x\n", i16, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
sprintf (str1, "%u %x\n", u16, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n", i32, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n", u32, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
#ifdef INT64_MAX
sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n", i64, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
#endif
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n", imax, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n", umax, ~0);
if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));
TESTUMAX(8);
TESTUMAX(16);
TESTUMAX(32);
#ifdef INT64_MAX
TESTUMAX(64);
#endif
#define STR(v) #v
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
if (err_n) {
printf ("pstdint.h is not correct. Please use sizes below to correct it:\n");
}
Q(int)
Q(unsigned)
Q(long int)
Q(short int)
Q(int8_t)
Q(int16_t)
Q(int32_t)
#ifdef INT64_MAX
Q(int64_t)
#endif
#if UINT_MAX < X_SIZE_MAX
printf ("UINT_MAX < X_SIZE_MAX\n");
#else
printf ("UINT_MAX >= X_SIZE_MAX\n");
#endif
printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);
return EXIT_SUCCESS;
}
#endif
-39
View File
@@ -1,39 +0,0 @@
/*
* stdlib.h --
*
* Declares facilities exported by the "stdlib" portion of the C library.
* This file isn't complete in the ANSI-C sense; it only declares things
* that are needed by Tcl. This file is needed even on many systems with
* their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
* all the procedures needed here (such as strtol/strtoul).
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STDLIB
#define _STDLIB
extern void abort(void);
extern double atof(const char *string);
extern int atoi(const char *string);
extern long atol(const char *string);
extern void * calloc(unsigned long numElements, unsigned long size);
extern void exit(int status);
extern void free(void *blockPtr);
extern char * getenv(const char *name);
extern void * malloc(unsigned long numBytes);
extern void qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
const void *element1, const void *element2));
extern void * realloc(void *ptr, unsigned long numBytes);
extern char * realpath(const char *path, char *resolved_path);
extern int mkstemps(char *templ, int suffixlen);
extern int mkstemp(char *templ);
extern char * mkdtemp(char *templ);
extern long strtol(const char *string, char **endPtr, int base);
extern unsigned long strtoul(const char *string, char **endPtr, int base);
#endif /* _STDLIB */
-70
View File
@@ -1,70 +0,0 @@
/*
* strstr.c --
*
* Source code for the "strstr" library routine.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#ifndef NULL
#define NULL 0
#endif
/*
*----------------------------------------------------------------------
*
* strstr --
*
* Locate the first instance of a substring in a string.
*
* Results:
* If string contains substring, the return value is the location of the
* first matching instance of substring in string. If string doesn't
* contain substring, the return value is 0. Matching is done on an exact
* character-for-character basis with no wildcards or special characters.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
char *
strstr(
const char *string, /* String to search. */
const char *substring) /* Substring to try to find in string. */
{
const char *a, *b;
/*
* First scan quickly through the two strings looking for a
* single-character match. When it's found, then compare the rest of the
* substring.
*/
b = substring;
if (*b == 0) {
return (char *)string;
}
for ( ; *string != 0; string += 1) {
if (*string != *b) {
continue;
}
a = string;
while (1) {
if (*b == 0) {
return (char *)string;
}
if (*a++ != *b++) {
break;
}
}
b = substring;
}
return NULL;
}
-77
View File
@@ -1,77 +0,0 @@
/*
* strtol.c --
*
* Source code for the "strtol" library procedure.
*
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
*----------------------------------------------------------------------
*
* strtol --
*
* Convert an ASCII string into an integer.
*
* Results:
* The return value is the integer equivalent of string. If endPtr is
* non-NULL, then *endPtr is filled in with the character after the last
* one that was part of the integer. If string doesn't contain a valid
* integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
long int
strtol(
const char *string, /* String of ASCII digits, possibly preceded
* by white space. For bases greater than 10,
* either lower- or upper-case digits may be
* used. */
char **endPtr, /* Where to store address of terminating
* character, or NULL. */
int base) /* Base for conversion. Must be less than 37.
* If 0, then the base is chosen from the
* leading characters of string: "0x" means
* hex, "0" means octal, anything else means
* decimal. */
{
const char *p;
long result;
/*
* Skip any leading blanks.
*/
p = string;
while (isspace(UCHAR(*p))) {
p += 1;
}
/*
* Check for a sign.
*/
if (*p == '-') {
p += 1;
result = -(strtoul(p, endPtr, base));
} else {
if (*p == '+') {
p += 1;
}
result = strtoul(p, endPtr, base);
}
if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
*endPtr = (char *) string;
}
return result;
}
-214
View File
@@ -1,214 +0,0 @@
/*
* strtoul.c --
*
* Source code for the "strtoul" library procedure.
*
* Copyright (c) 1988 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
* The table below is used to convert from ASCII digits to a numerical
* equivalent. It maps from '0' through 'z' to integers (100 for non-digit
* characters).
*/
static const char cvtIn[] = {
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */
100, 100, 100, 100, 100, 100, 100, /* punctuation */
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35,
100, 100, 100, 100, 100, 100, /* punctuation */
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */
20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
30, 31, 32, 33, 34, 35};
/*
*----------------------------------------------------------------------
*
* strtoul --
*
* Convert an ASCII string into an integer.
*
* Results:
* The return value is the integer equivalent of string. If endPtr is
* non-NULL, then *endPtr is filled in with the character after the last
* one that was part of the integer. If string doesn't contain a valid
* integer value, then zero is returned and *endPtr is set to string.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
unsigned long int
strtoul(
const char *string, /* String of ASCII digits, possibly preceded
* by white space. For bases greater than 10,
* either lower- or upper-case digits may be
* used. */
char **endPtr, /* Where to store address of terminating
* character, or NULL. */
int base) /* Base for conversion. Must be less than 37.
* If 0, then the base is chosen from the
* leading characters of string: "0x" means
* hex, "0" means octal, anything else means
* decimal. */
{
const char *p;
unsigned long int result = 0;
unsigned digit;
int anyDigits = 0;
int negative=0;
int overflow=0;
/*
* Skip any leading blanks.
*/
p = string;
while (isspace(UCHAR(*p))) {
p += 1;
}
if (*p == '-') {
negative = 1;
p += 1;
} else {
if (*p == '+') {
p += 1;
}
}
/*
* If no base was provided, pick one from the leading characters of the
* string.
*/
if (base == 0) {
if (*p == '0') {
p += 1;
if ((*p == 'x') || (*p == 'X')) {
p += 1;
base = 16;
} else {
/*
* Must set anyDigits here, otherwise "0" produces a "no
* digits" error.
*/
anyDigits = 1;
base = 8;
}
} else {
base = 10;
}
} else if (base == 16) {
/*
* Skip a leading "0x" from hex numbers.
*/
if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
p += 2;
}
}
/*
* Sorry this code is so messy, but speed seems important. Do different
* things for base 8, 10, 16, and other.
*/
if (base == 8) {
unsigned long maxres = ULONG_MAX >> 3;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 7) {
break;
}
if (result > maxres) { overflow = 1; }
result = (result << 3);
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base == 10) {
unsigned long maxres = ULONG_MAX / 10;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > 9) {
break;
}
if (result > maxres) { overflow = 1; }
result *= 10;
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base == 16) {
unsigned long maxres = ULONG_MAX >> 4;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
break;
}
digit = cvtIn[digit];
if (digit > 15) {
break;
}
if (result > maxres) { overflow = 1; }
result = (result << 4);
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
} else if (base >= 2 && base <= 36) {
unsigned long maxres = ULONG_MAX / base;
for ( ; ; p += 1) {
digit = *p - '0';
if (digit > ('z' - '0')) {
break;
}
digit = cvtIn[digit];
if (digit >= ( (unsigned) base )) {
break;
}
if (result > maxres) { overflow = 1; }
result *= base;
if (digit > (ULONG_MAX - result)) { overflow = 1; }
result += digit;
anyDigits = 1;
}
}
/*
* See if there were any digits at all.
*/
if (!anyDigits) {
p = string;
}
if (endPtr != 0) {
/* unsafe, but required by the strtoul prototype */
*endPtr = (char *) p;
}
if (overflow) {
errno = ERANGE;
return ULONG_MAX;
}
if (negative) {
return -result;
}
return result;
}
+1 -1
View File
@@ -32,7 +32,7 @@ void
\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
.SH ARGUMENTS
.AS char *size
.AP "unsigned int" size in
.AP "size_t" size in
Size in bytes of the memory block to allocate.
.AP char *ptr in
Pointer to memory block to free or realloc.
+1 -1
View File
@@ -9,7 +9,7 @@
.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult, Tcl_DStringToObj \- manipulate dynamic strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
+13 -14
View File
@@ -218,17 +218,16 @@ used. The return value is a pointer to the value stored in the DString.
be used to specify the profile to be used for the transform. The
\fBTCL_ENCODING_START\fR and \fBTCL_ENCODING_END\fR bits in \fBflags\fR are
ignored as the function assumes the entire source string to be decoded is passed
into the function. On success, the function returns \fBTCL_ERROR\fR with the
converted string stored in \fB*dstPtr\fR. For errors other than conversion
errors, such as invalid flags, the function returns \fBTCL_OK\fR with an error
into the function. On success, the function returns \fBTCL_OK\fR with the
converted string stored in \fB*dstPtr\fR. For errors \fIother than conversion
errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an error
message in \fBinterp\fR if it is not NULL.
.PP
For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one
of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR.
When one of these conversion errors is returned, an error message is
stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message
is stored as the function expects the caller is interested whatever is
decoded to that point and not treating this as an immediate error condition.
is stored as the function expects the caller is interested the decoded data
up to that point and not treating this as an immediate error condition.
The index of the error location is stored in \fB*errorIdxPtr\fR.
.PP
The caller must call \fBTcl_DStringFree\fR to free up the \fB*dstPtr\fR resources
@@ -547,13 +546,13 @@ encoding:
E
init {}
final {}
iso8859-1 \ex1b(B
jis0201 \ex1b(J
jis0208 \ex1b$@
jis0208 \ex1b$B
jis0212 \ex1b$(D
gb2312 \ex1b$A
ksc5601 \ex1b$(C
iso8859-1 \ex1B(B
jis0201 \ex1B(J
jis0208 \ex1B$@
jis0208 \ex1B$B
jis0212 \ex1B$(D
gb2312 \ex1B$A
ksc5601 \ex1B$(C
.CE
.PP
In the file, the first column represents an option and the second column
@@ -565,7 +564,7 @@ marks that encoding. Tcl syntax is used for the values; in the above
example, for instance,
.QW \fB{}\fR
represents the empty string and
.QW \fB\ex1b\fR
.QW \fB\ex1B\fR
represents character 27.
.PP
When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not
+46 -25
View File
@@ -23,6 +23,8 @@ Tcl_Obj *
.sp
\fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
.sp
\fBTcl_BounceRefCount\fR(\fIobjPtr\fR)
.sp
int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
@@ -278,26 +280,27 @@ The string representation is now \fB124\fR
and both representations are again valid.
.SH "STORAGE MANAGEMENT OF VALUES"
.PP
Tcl values are allocated on the heap and are shared as much as possible
to reduce storage requirements.
Reference counting is used to determine when a value is
no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
has \fIrefCount\fR 0, meaning that the object can often be given to a function
like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
of which are common use cases. (The latter two require that the the target
list or dictionary be well-formed, but that is often easy to arrange when the
value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count
when a new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count
when a reference is no longer needed and,
if the value's reference count drops to zero, frees its storage.
Tcl values are allocated on the heap and are shared as much as
possible to reduce storage requirements. Reference counting is used
to determine when a value is no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR, \fBTcl_NewStringObj\fR, or
any Abstract List command or function, has \fIrefCount\fR 0, meaning
that the object can often be given to a function like
\fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
\fBTcl_DictObjPut\fR (as a value) without explicit reference
management, all of which are common use cases. (The latter two require
that the target list or dictionary be well-formed, but that is
often easy to arrange when the value is being initially constructed.)
The macro \fBTcl_IncrRefCount\fR increments the reference count when a
new reference to the value is created.
The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.
If the value's reference count drops to zero, frees
its storage.
The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value.
A value shared by different code or data structures has
\fIrefCount\fR greater than 1.
Incrementing a value's reference count ensures that
it will not be freed too early or have its value change accidentally.
\fIrefCount\fR greater than 1. Incrementing a value's reference count
ensures that it will not be freed too early or have its value change
accidentally.
.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
@@ -311,12 +314,25 @@ the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.
Most command procedures do not have to be concerned about
reference counting since they use a value's value immediately
and do not retain a pointer to the value after they return.
However, if they do retain a pointer to a value in a data structure,
they must be careful to increment its reference count
since the retained pointer is a new reference.
.PP
Most command procedures have not been concerned about reference
counting since they use a value's value immediately and do not retain
a pointer to the value after they return. However, there are some
procedures that may return a new value, with a refCount of 0. In this
situation, it is the caller's responsibility to free the value before
the procedure returns. One way to cover this is to always call
\fBTcl_IncrRefCount\fR before using the value, then call
\fBTcl_DecrRefCount\fR before returning. The other way is to use
\fBTcl_BounceRefCount\fR after the value is no longer needed or
referenced. This macro will free the value if there are no other
references to the value. When retaining a pointer to a value in a data
structure the procedure must be careful to increment its reference
count since the retained pointer is a new reference. Examples of
procedures that return new values are \fBTcl_NewIntObj\fR, and
commands like \fBlseq\fR, which creates an Abstract List, and an
lindex on this list may return a new Obj with a refCount of 0.
.PP
Command procedures that directly modify values
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
@@ -350,6 +366,11 @@ must check whether the variable's value is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
in order to avoid accidentally changing values in other data structures.
.PP
In cases where a value is obtained, used, and not retained, the value
can be freed using \fBTcl_BounceRefCount\fR. This
is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
\fBTcl_DecrRefCount\fR.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
+164 -12
View File
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
@@ -93,14 +93,13 @@ free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four
procedures and
initializing a Tcl_ObjType structure to describe the type.
Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit
other extensions to look up their Tcl_ObjType by name with
the \fBTcl_GetObjType\fR routine.
The \fBTcl_ObjType\fR structure is defined as follows:
Extension writers can define new value types by defining four to eight
procedures and initializing a Tcl_ObjType structure to describe the
type. Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit other
extensions to look up their Tcl_ObjType by name with the
\fBTcl_GetObjType\fR routine. The \fBTcl_ObjType\fR structure is
defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
@@ -110,6 +109,16 @@ typedef struct Tcl_ObjType {
Tcl_UpdateStringProc *\fIupdateStringProc\fR;
Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
size_t \fIversion\fR;
/* List emulation functions - ObjType Version 1 & 2 */
Tcl_ObjTypeLengthProc *lengthProc;
/* List emulation functions - ObjType Version 2 */
Tcl_ObjTypeIndexProc *\fIindexProc\fR;
Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
} \fBTcl_ObjType\fR;
.CE
.SS "THE NAME FIELD"
@@ -206,6 +215,7 @@ The \fIdupIntRepProc\fR member contains the address of a function
called to copy an internal representation from one value to another.
.PP
.CS
typedef void \fBTcl_DupInternalRepProc\fR(
Tcl_Obj *\fIsrcPtr\fR,
Tcl_Obj *\fIdupPtr\fR);
@@ -229,6 +239,7 @@ The \fIfreeIntRepProc\fR member contains the address of a function
that is called when a value is freed.
.PP
.CS
typedef void \fBTcl_FreeInternalRepProc\fR(
Tcl_Obj *\fIobjPtr\fR);
.CE
@@ -256,8 +267,149 @@ immediately, in order to limit stack usage. However, the value will be freed
before the outermost current \fBTcl_DecrRefCount\fR returns.
.SS "THE VERSION FIELD"
.PP
The \fIversion\fR member provides for future extensibility of the structure
and should be set to \fITCL_OBJTYPE_V0\fR.
The \fIversion\fR member provides for future extensibility of the
structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
of ObjType definitions prior to version 9.0. Specifics about versions
will be described further in the sections below.
.SH "ABSTRACT LIST TYPES"
.PP
Additional fields in the Tcl_ObjType descriptor allow for control over
how custom data values can be manipulated using Tcl's List commands
without converting the value to a List type. This requires the custom
type to provide functions that will perform the given operation on the
custom data representation. Not all functions are required. In the
absence of a particular function (set to NULL), the fallback is to
allow the internal List operation to perform the operation, most
likely causing the value type to be converted to a traditional list.
.SS "SCALAR VALUE TYPES"
.PP
For a custom value type that is scalar or atomic in nature, i.e., not
a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
recommended. In this case, List commands will treat the scalar value
as if it where a list of length 1, and not convert the value to a List
type.
.SS "VERSION 2: ABSTRACT LISTS"
.PP
Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
functions described below are provided. This allows for script level
use of the List commands without causing the type of the Tcl_Obj value
to be converted to a list.
.SS "THE LENGTHPROC FIELD"
.PP
The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
C API. The function returns the number of elements in the list. It
is used in every List operation and is required for all Abstract List
implementations.
.CS
typedef Tcl_Size
(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
.CE
.PP
.SS "THE INDEXPROC FIELD"
.PP
The \fBIndexProc\fR function correlates with with the
\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
the element at the specified index.
.CS
typedef int
(Tcl_ObjTypeIndexProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size index,
Tcl_Obj** elemObj);
.CE
.SS "THE SLICEPROC FIELD"
.PP
The \fBSliceProc\fR correlates with the \fBlrange\fR command,
returning a new List or Abstract List for the portion of the original
list specifed.
.CS
typedef int
(Tcl_ObjTypeSliceProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size fromIdx,
Tcl_Size toIdx,
Tcl_Obj **newObjPtr);
.CE
.SS "THE REVERSEPROC FIELD"
.PP
The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
returning a List or Abstract List that has the same elements as the
input Abstract List, with the elements in the reverse order.
.CS
typedef int
(Tcl_ObjTypeReverseProc) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Obj **newObjPtr);
.CE
.SS "THE GETELEMENTS FIELD"
.PP
The \fBGetElements\fR function returns a count and a pointer to an
array of Tcl_Obj values for the entire Abstract List. This is a
correlary to the \fBTcl_ListObjGetElements\fR C API call.
.CS
typedef int
(Tcl_ObjTypeGetElements) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size *objcptr,
Tcl_Obj ***objvptr);
.CE
.SS "THE SETELEMENT FIELD"
.PP
The \fBSetElement\fR function replaces the element within the
specified list at the give index. This function correlates to the
\fBlset\fR command.
.CS
typedef Tcl_Obj*
Tcl_ObjTypeSetElement) (
Tcl_Interp *interp,
Tcl_Obj *listPtr,
Tcl_Size indexCount,
Tcl_Obj *const indexArray[],
Tcl_Obj *valueObj);
.CE
.SS "REPLACEPROC FIELD"
.PP
The \fBReplaceProc\fR returns a new list after modfying the list
replacing the elements to be deleted, and adding the elements to be
inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
.CS
typedef int
(Tcl_ObjTypeReplaceProc) (
Tcl_Interp *interp,
Tcl_Obj *listObj,
Tcl_Size first,
Tcl_Size numToDelete,
Tcl_Size numToInsert,
Tcl_Obj *const insertObjs[]);
.CE
.SS "THE INOPERATORPROC FIELD"
.PP
The \fBInOperProc\fR function determines whether the value is present in the
given list, according to equivalent string comparison of elements. The
\fBboolResult\fR is set to 1 (true) if the value is present, and 0
(false) if it is not present. This function implements the "in" and
"ni" math operators for an abstract list.
.CS
typedef int
(Tcl_ObjTypeInOperatorProc) (
Tcl_Interp *interp,
Tcl_Obj *valueObj,
Tcl_Obj *listObj,
int *boolResult);
.CE
.SH "REFERENCE COUNT MANAGEMENT"
.PP
The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
@@ -276,6 +428,6 @@ modify the reference count of their arguments, but if the values contain
subsidiary values (e.g., the elements of a list or the keys of a dictionary)
then those subsidiary values may have their reference counts modified.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3)
.SH KEYWORDS
internal representation, value, value type, string representation, type conversion
+2 -2
View File
@@ -47,10 +47,10 @@ int
int
\fBTcl_Close\fR(\fIinterp, channel\fR)
.sp
int
Tcl_Size
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
Tcl_Size
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
Tcl_Size
+56 -50
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharToUtfDString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -28,28 +28,28 @@ Tcl_Size
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numUniChars, dsPtr\fR)
.sp
char *
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
\fBTcl_Char16ToUtfDString\fR(\fIutf16, numUtf16, dsPtr\fR)
.sp
char *
\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR)
\fBTcl_WCharToUtfDString\fR(\fIwcharStr, numWChars, dsPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
\fBTcl_UtfToUniCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
.sp
unsigned short *
\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR)
\fBTcl_UtfToChar16DString\fR(\fIsrc, numBytes, dsPtr\fR)
.sp
wchar_t *
\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
\fBTcl_UtfToWCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
.sp
int
\fBTcl_Char16Len\fR(\fIuniStr\fR)
\fBTcl_Char16Len\fR(\fIutf16\fR)
.sp
int
\fBTcl_WCharLen\fR(\fIuniStr\fR)
\fBTcl_WCharLen\fR(\fIwcharStr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
@@ -70,10 +70,10 @@ int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
\fBTcl_UtfCharComplete\fR(\fIsrc, numBytes\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
\fBTcl_NumUtfChars\fR(\fIsrc, numBytes\fR)
.sp
const char *
\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
@@ -115,28 +115,32 @@ Pointer to a UTF-8 string.
.AP "const char" *ct in
Pointer to a UTF-8 string.
.AP "const Tcl_UniChar" *uniStr in
A null-terminated Unicode string.
A sequence of \fBTcl_UniChar\fR units with null-termination optional
depending on function.
.AP "const Tcl_UniChar" *ucs in
A null-terminated Unicode string.
A null-terminated sequence of \fBTcl_UniChar\fR.
.AP "const Tcl_UniChar" *uct in
A null-terminated Unicode string.
A null-terminated sequence of \fBTcl_UniChar\fR.
.AP "const Tcl_UniChar" *uniPattern in
A null-terminated Unicode string.
.AP "const unsigned short" *uStr in
A null-terminated UTF-16 string.
.AP "const wchar_t" *wStr in
A null-terminated wchar_t string.
.AP "const unsigned short" *utf16s in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16t in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16Pattern in
A null-terminated utf-16 string.
.AP Tcl_Size length in
The length of the UTF-8 string in bytes (not UTF-8 characters). If
negative, all bytes up to the first null byte are used.
.AP Tcl_Size uniLength in
The length of the Unicode string in characters.
A null-terminated sequence of \fBTcl_UniChar\fR.
.AP "const unsigned short" *utf16 in
A sequence of UTF-16 units with null-termination optional
depending on function.
.AP "const wchar_t" *wcharStr in
A sequence of \fBwchar_t\fR units with null-termination optional
depending on function.
.AP int numBytes in
The length of the UTF-8 input in bytes. If
negative, the length includes all bytes until the first null byte.
.AP int numUtf16 in
The length of the input in UTF-16 units.
If negative, the length includes all bytes until the first null.
.AP int numUniChars in
The length of the input in Tcl_UniChar units.
If negative, the length includes all bytes until the first null.
.AP int numWChars in
The length of the input in wchar_t units.
If negative, the length includes all bytes until the first null.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "const char" *start in
@@ -186,30 +190,32 @@ not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and
0x00FF and return 1.
.PP
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
The return value is a pointer to the UTF-8 representation of the
Unicode string. Storage for the return value is appended to the
end of the \fBTcl_DString\fR.
\fBTcl_UniCharToUtfDString\fR converts the input in the form of a
sequence of \fBTcl_UniChar\fR code points to UTF-8, appending the result to the
previously initialized output \fBTcl_DString\fR. The return value is a pointer
to the UTF-8 representation of the \fBappended\fR string.
.PP
\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
storing the result in the previously initialized \fBTcl_DString\fR.
In the argument \fIlength\fR, you may either specify the length of
the given UTF-8 string in bytes or
.QW \-1 ,
in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
calculate the length. The return value is a pointer to the Unicode
representation of the UTF-8 string. Storage for the return value
is appended to the end of the \fBTcl_DString\fR. The Unicode string
is terminated with a Unicode null character.
\fBTcl_UtfToUniCharDString\fR converts the input in the form of
a UTF-8 encoded string to a \fBTcl_UniChar\fR sequence
appending the result in the previously initialized \fBTcl_DString\fR.
The return value is a pointer to the appended result which is also
terminated with a \fBTcl_UniChar\fR null character.
.PP
\fBTcl_WCharToUtfDString\fR and \fBTcl_UtfToWCharDString\fR are similar to
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
operate on sequences of \fBwchar_t\fR instead of \fBTcl_UniChar\fR.
.PP
\fBTcl_Char16ToUtfDString\fR and \fBTcl_UtfToChar16DString\fR are similar to
\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
operate on sequences of \fBUTF-16\fR units instead of \fBTcl_UniChar\fR.
.PP
\fBTcl_Char16Len\fR corresponds to \fBstrlen\fR for UTF-16
characters. It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
characters. It accepts a null-terminated UTF-16 sequence and returns
the number of UTF-16 units until the null.
.PP
\fBTcl_WCharLen\fR corresponds to \fBstrlen\fR for wchar_t
characters. It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
characters. It accepts a null-terminated \fBwchar_t\fR sequence and returns
the number of \fBwchar_t\fR units until the null.
.PP
\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
characters. It accepts a null-terminated Unicode string and returns
@@ -245,7 +251,7 @@ differences in case when comparing upper, lower or title case
characters.
.PP
\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
of \fIlength\fR bytes is long enough to be decoded by
of \fInumBytes\fR bytes is long enough to be decoded by
\fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise. This function
does not guarantee that the UTF-8 string is properly formed. This routine
is used by procedures that are operating on a byte at a time and need to
+20 -20
View File
@@ -241,7 +241,7 @@ which returns a binary string equivalent to:
\fB\e254\fR
.CE
.PP
(i.e. \fB\exac\fR) by
(i.e. \fB\exAC\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
@@ -299,7 +299,7 @@ high-to-low order within each byte. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exe0\exe1\exa0\fR
\fB\exE0\exE1\exA0\fR
.CE
.RE
.IP \fBH\fR 5
@@ -326,7 +326,7 @@ remaining bits of the last byte will be zeros. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exab\ex00\exde\exf0\ex98\fR
\fB\exAB\ex00\exDE\exF0\ex98\fR
.CE
.RE
.IP \fBh\fR 5
@@ -341,7 +341,7 @@ low-to-high order within each byte. This is seldom required. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\exba\ex00\exed\ex0f\ex89\fR
\fB\exBA\ex00\exED\ex0F\ex89\fR
.CE
.RE
.IP \fBc\fR 5
@@ -363,7 +363,7 @@ than \fIcount\fR, then the extra elements are ignored. For example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
.CE
.PP
whereas:
@@ -389,7 +389,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
@@ -405,7 +405,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
.CE
.RE
.IP \fBt\fR 5
@@ -429,7 +429,7 @@ example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
@@ -445,7 +445,7 @@ For example,
will return a binary string equivalent to:
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
@@ -510,7 +510,7 @@ on a Windows system running on an Intel Pentium processor,
will return a binary string equivalent to:
.PP
.CS
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
.CE
.RE
.IP \fBr\fR 5
@@ -536,7 +536,7 @@ Windows system running on an Intel Pentium processor,
will return a binary string equivalent to:
.PP
.CS
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
.CE
.RE
.IP \fBq\fR 5
@@ -788,7 +788,7 @@ scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
@@ -839,7 +839,7 @@ example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -853,7 +853,7 @@ order. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -878,7 +878,7 @@ example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
@@ -894,7 +894,7 @@ immediately after the \fBI\fR. For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
@@ -920,7 +920,7 @@ example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
@@ -935,7 +935,7 @@ immediately after the \fBW\fR. For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
@@ -966,7 +966,7 @@ Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
@@ -990,7 +990,7 @@ running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
+3 -3
View File
@@ -152,7 +152,7 @@ If \fIchar\fR is the empty string, there is no special character that marks
the end of the data.
The default value is the empty string. The acceptable range is \ex01 -
\ex7f. A value outside this range results in an error.
\ex7F. A value outside this range results in an error.
.VS "TCL8.7 TIP656"
.TP
\fB\-profile\fR \fIprofile\fR
@@ -245,10 +245,10 @@ files to slow destinations like network sockets.
.PP
\fB\-size\fR limits the number of characters copied.
.PP
If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the
If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the
background, and calls \fIcallback\fR when the copy completes, providing as an
additional argument the number of characters written to \fIoutputChan\fR. If
an error occurres during the background copy, another argument provides message
an error occurs during the background copy, another argument provides message
for the error. \fIinputChan\fR and \fIoutputChan\fR are automatically
configured for non-blocking mode if needed. Background copying only works
correctly if events are being processed, e.g. via \fBvwait\fR or Tk.
+16
View File
@@ -119,6 +119,22 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
volume. This is not a valid UNC path, so the assumption is that the
extra backslashes are superfluous.
.RE
.SH "TILDE SUBSTITUTION"
.PP
Unlike earlier versions of Tcl, Tcl 9 does not do implicit tilde substitution
on file paths with the exception noted below. The commands \fBfile home\fR and
\fBfile tildeexpand\fR may be used to explicitly accomplish the same.
.PP
The exception to the above is initialization of the \fBauto_path\fR variable
and the Tcl module search paths as documented in the manpages for
\fBtclvars\fR and \fBtm\fR. When any path in an environment variable used to
initialize these starts with a tilde, it will be interpreted as if the first
element is replaced with the location of the home directory for the given
user. If the tilde is followed immediately by a separator, the
\fB$HOME\fR environment variable is substituted. Otherwise the characters
between the tilde and the next separator are taken as a user name, which is
used to retrieve the user's home directory for substitution. This works on
POSIX, MacOS X and Windows platforms.
.SH "PORTABILITY ISSUES"
.PP
Not all file systems are case sensitive, so scripts should avoid code
+3
View File
@@ -248,6 +248,9 @@ For example, to print the contents of the \fBtcl_platform\fR array, do:
\fBparray\fR tcl_platform
.CE
.RE
.SS "WORD BOUNDARY HELPERS"
.PP
These procedures are mainly used internally by Tk.
.TP
\fBtcl_endOfWord \fIstr start\fR
.
+62 -33
View File
@@ -20,18 +20,47 @@ lseq \- Build a numeric sequence returned as a list
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
The \fIoperation\fR argument
.QW \fB..\fR
or
.QW \fBto\fR
defines an inclusive range; if it is omitted, the range is exclusive.
The \fBcount\fR option is used to define a count of the number of elements in
the list.
The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
The short form with a
single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
\fIcount\fR values).
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
is used to define a count of the number of elements in the list. A short form
use of the command, with a single count value, will create a range from 0 to
count-1.
The \fBlseq\fR command can produce both increasing and decreasing
sequences. When both \fIstart\fR and \fIend\fR are provided without a
\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
\fIstep\fR vale is included, it's sign should agree with the direction of the
sequence (descending -> negative and ascending -> positive), otherwise an
empty list is returned. For example:
.CS \"
% \fBlseq\fR 1 to 5 ;# increasing
\fI\(-> 1 2 3 4 5
% \fBlseq\fR 5 to 1 ;# decreasing
\fI\(-> 5 4 3 2 1
% \fBlseq\fR 6 to 1 by 2 ;# decreasing, step wrong sign, empty list
% \fBlseq\fR 1 to 5 by 0 ;# all step sizes of 0 produce an empty list
.\"
.CE
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
may also be a valid expression. The expression will be evaluated and the
numeric result will be used. An expression that does not evaluate to a number
will produce an invalid argument error.
.PP
\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
elements, and if \fIcount\fR is not supplied, it is computed as
.CS \"
\fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
.\"
.CE
.PP
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
can also be a valid expression. the \fBlseq\fR command will evaluate the
@@ -43,53 +72,53 @@ value; a non-numeric expression result will result in an error.
.CS
.\"
\fBlseq\fR 3
\fI\(-> 0 1 2\fR
\fI\(-> 0 1 2\fR
\fBlseq\fR 3 0
\fI\(-> 3 2 1 0\fR
\fI\(-> 3 2 1 0\fR
\fBlseq\fR 10 .. 1 by -2
\fI\(-> 10 8 6 4 2\fR
\fI\(-> 10 8 6 4 2\fR
set l [\fBlseq\fR 0 -5]
\fI\(-> 0 -1 -2 -3 -4 -5\fR
\fI\(-> 0 -1 -2 -3 -4 -5\fR
foreach i [\fBlseq\fR [llength $l]] {
puts l($i)=[lindex $l $i]
}
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR
\fI\(-> l(0)=0\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(5)=-5\fR
foreach i [\fBlseq\fR {[llength $l]-1} 0] {
puts l($i)=[lindex $l $i]
}
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR
\fI\(-> l(5)=-5\fR
\fI\(-> l(4)=-4\fR
\fI\(-> l(3)=-3\fR
\fI\(-> l(2)=-2\fR
\fI\(-> l(1)=-1\fR
\fI\(-> l(0)=0\fR
set i 17
\fI\(-> 17\fR
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i < 50)
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
puts "Ok"
} else {
puts "outside :("
}
\fI\(-> Ok\fR
\fI\(-> Ok\fR
set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n),
llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
+4
View File
@@ -30,6 +30,10 @@ the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
Initialization of auto_path from the TCLLIBPATH environment
variable undergoes tilde substitution (see \fBfilename\fR) on each
path. Any tilde substitution that fails because the user is unknown
will be omitted from auto_path.
.RS
.PP
Additional variables relating to package management exist. More
+4
View File
@@ -295,6 +295,10 @@ environment variables:
\fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR
\fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR
.CE
.PP
Paths initialized from the environment variables undergo tilde
substitution (see \fBfilename\fR). Any path whose tilde substitution
fails because the user is unknown will be omitted from search paths.
.SH "SEE ALSO"
package(n), Tcl Improvement Proposal #189
.QW "\fITcl Modules\fR"
+1 -1
View File
@@ -231,7 +231,7 @@ When the trace triggers, three arguments are appended to
.PP
\fIName1\fR gives the name for the variable being accessed.
This is not necessarily the same as the name used in the
\fBtrace variable\fR command: the \fBupvar\fR command allows a
\fBtrace add variable\fR command: the \fBupvar\fR command allows a
procedure to reference a variable under a different name.
If the trace was originally set on an array or array element,
\fIname2\fR provides which index into the array was affected.
+1 -1
View File
@@ -94,7 +94,7 @@ proc \fIsetByUpvar\fR { name value } {
set localVar $value
}
set originalVar 1
trace variable originalVar w \fItraceproc\fR
trace add variable originalVar write \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
+92 -9
View File
@@ -355,8 +355,6 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
struct {long tv_sec;} st_mtim;
struct {long tv_sec;} st_ctim;
} Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
typedef struct stat64 Tcl_StatBuf;
#else
typedef struct stat Tcl_StatBuf;
#endif
@@ -608,6 +606,28 @@ typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);
/* Abstract List functions */
typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr);
typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size index, struct Tcl_Obj** elemObj);
typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size fromIdx, Tcl_Size toIdx,
struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
struct Tcl_Obj **newObjPtr);
typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
Tcl_Size indexCount,
struct Tcl_Obj *const indexArray[],
struct Tcl_Obj *valueObj);
typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
Tcl_Size first, Tcl_Size numToDelete,
Tcl_Size numToInsert,
struct Tcl_Obj *const insertObjs[]);
typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
struct Tcl_Obj *listObj, int *boolResult);
#ifndef TCL_NO_DEPRECATED
# define Tcl_PackageInitProc Tcl_LibraryInitProc
# define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
@@ -636,12 +656,40 @@ typedef struct Tcl_ObjType {
/* Called to convert the object's internal rep
* to this type. Frees the internal rep of the
* old type. Returns TCL_ERROR on failure. */
#if TCL_MAJOR_VERSION > 8
size_t version;
/* List emulation functions - ObjType Version 1 */
Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the
** AbstractList */
Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for
** [lindex $al $index] */
Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for
** [lrange $al $start $end] */
Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for
** [lreverse $al] */
Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
** the list */
Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie
** with the given valueObj. */
Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */
Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list
** operation Determine if the given
** string value matches an element in
** the list */
#endif
} Tcl_ObjType;
#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init
* when existing code that does not init this
* field is compiled with Tcl9 headers */
#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0
#if TCL_MAJOR_VERSION > 8
# define TCL_OBJTYPE_V0 0, \
0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
# define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
# define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \
a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
#else
# define TCL_OBJTYPE_V0 /* just empty */
#endif
/*
* The following structure stores an internal representation (internalrep) for
@@ -694,7 +742,6 @@ typedef struct Tcl_Obj {
Tcl_ObjInternalRep internalRep; /* The internal representation: */
} Tcl_Obj;
/*
*----------------------------------------------------------------------------
* The following definitions support Tcl's namespace facility. Note: the first
@@ -2013,8 +2060,7 @@ typedef struct Tcl_EncodingType {
/*
* The maximum number of bytes that are necessary to represent a single
* Unicode character in UTF-8. The valid values are 3 and 4
* (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
* Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
* then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
* then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
* mode is the default and recommended mode.
@@ -2427,6 +2473,25 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
/*
* Free the Obj by effectively doing:
*
* Tcl_IncrRefCount(objPtr);
* Tcl_DecrRefCount(objPtr);
*
* This will free the obj if there are no references to the obj.
*/
# define Tcl_BounceRefCount(objPtr) \
TclBounceRefCount(objPtr, __FILE__, __LINE__)
static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
{
if (objPtr) {
if ((objPtr)->refCount == 0) {
Tcl_DbDecrRefCount(objPtr, fn, line);
}
}
}
#else
# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
@@ -2446,6 +2511,24 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
((objPtr)->refCount > 1)
/*
* Declare that obj will no longer be used or referenced.
* This will release the obj if there is no referece count,
* otherwise let it be.
*/
# define Tcl_BounceRefCount(objPtr) \
TclBounceRefCount(objPtr);
static inline void TclBounceRefCount(Tcl_Obj* objPtr)
{
if (objPtr) {
if ((objPtr)->refCount == 0) {
Tcl_DecrRefCount(objPtr);
}
}
}
#endif
/*
+435 -312
View File
@@ -10,13 +10,95 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#include "tclInt.h"
#include "tclArithSeries.h"
#include <assert.h>
#include <math.h>
/*
* The structure below defines the arithmetic series Tcl object type by
* means of procedures that can be invoked by generic object code.
*
* The arithmetic series object is a special case of Tcl list representing
* an interval of an arithmetic series in constant space.
*
* The arithmetic series is internally represented with three integers,
* *start*, *end*, and *step*, Where the length is calculated with
* the following algorithm:
*
* if RANGE == 0 THEN
* ERROR
* if RANGE > 0
* LEN is (((END-START)-1)/STEP) + 1
* else if RANGE < 0
* LEN is (((END-START)-1)/STEP) - 1
*
* And where the equivalent's list I-th element is calculated
* as:
*
* LIST[i] = START + (STEP * i)
*
* Zero elements ranges, like in the case of START=10 END=10 STEP=1
* are valid and will be equivalent to the empty list.
*/
/*
* The structure used for the ArithSeries internal representation.
* Note that the len can in theory be always computed by start,end,step
* but it's faster to cache it inside the internal representation.
*/
typedef struct {
Tcl_Size len;
Tcl_Obj **elements;
int isDouble;
Tcl_WideInt start;
Tcl_WideInt end;
Tcl_WideInt step;
} ArithSeries;
typedef struct {
Tcl_Size len;
Tcl_Obj **elements;
int isDouble;
double start;
double end;
double step;
int precision;
} ArithSeriesDbl;
/* -------------------------- ArithSeries object ---------------------------- */
static int TclArithSeriesObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
Tcl_Size index, Tcl_Obj **elemObj);
static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj);
static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj,
Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesObj, Tcl_Obj **newObjPtr);
static int TclArithSeriesGetElements(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
static void DupArithSeriesInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr);
static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr);
static int SetArithSeriesFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int ArithSeriesInOperation(Tcl_Interp *interp, Tcl_Obj *valueObj, Tcl_Obj *arithSeriesObj,
int *boolResult);
static const Tcl_ObjType arithSeriesType = {
"arithseries", /* name */
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
SetArithSeriesFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V2(
ArithSeriesObjLength,
TclArithSeriesObjIndex,
TclArithSeriesObjRange,
TclArithSeriesObjReverse,
TclArithSeriesGetElements,
NULL, // SetElement
NULL, // Replace
ArithSeriesInOperation) // "in" operator
};
/*
* Helper functions
*
@@ -68,10 +150,13 @@ static inline ArithSeries*
ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);
irPtr = TclFetchInternalRep((objPtr), &arithSeriesType);
return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
}
/*
* Compute number of significant factional digits
*/
static inline int
Precision(double d)
{
@@ -81,10 +166,13 @@ Precision(double d)
off = strchr(tmp, '.');
return (off ? strlen(off+1) : 0);
}
/*
* Find longest number of digits after the decimal point.
*/
static inline int
maxPrecision(double start, double end, double step)
{
// Find longest number of digits after the decimal point.
int dp = Precision(step);
int i = Precision(start);
dp = i>dp ? i : dp;
@@ -93,54 +181,7 @@ maxPrecision(double start, double end, double step)
return dp;
}
/*
* Prototypes for procedures defined later in this file:
*/
static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj);
static Tcl_Obj* ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr);
static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
/*
* The structure below defines the arithmetic series Tcl object type by
* means of procedures that can be invoked by generic object code.
*
* The arithmetic series object is a special case of Tcl list representing
* an interval of an arithmetic series in constant space.
*
* The arithmetic series is internally represented with three integers,
* *start*, *end*, and *step*, Where the length is calculated with
* the following algorithm:
*
* if RANGE == 0 THEN
* ERROR
* if RANGE > 0
* LEN is (((END-START)-1)/STEP) + 1
* else if RANGE < 0
* LEN is (((END-START)-1)/STEP) - 1
*
* And where the equivalent's list I-th element is calculated
* as:
*
* LIST[i] = START + (STEP * i)
*
* Zero elements ranges, like in the case of START=10 END=10 STEP=1
* are valid and will be equivalent to the empty list.
*/
const TclObjTypeWithAbstractList tclArithSeriesType = {
{"arithseries", /* name */
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
SetArithSeriesFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
ArithSeriesObjLength
)}
};
static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj, Tcl_Obj **stepObj);
/*
*----------------------------------------------------------------------
@@ -178,17 +219,99 @@ ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
}
static Tcl_WideInt
ArithSeriesLenDbl(double start, double end, double step)
ArithSeriesLenDbl(double start, double end, double step, int precision)
{
Tcl_WideInt len;
double istart, iend, istep, ilen;
if (step == 0) {
return 0;
}
len = ((end-start+step)/step);
return (len < 0) ? -1 : len;
istart = start * pow(10,precision);
iend = end * pow(10,precision);
istep = step * pow(10,precision);
ilen = ((iend-istart+istep)/istep);
return floor(ilen);
}
/*
*----------------------------------------------------------------------
*
* DupArithSeriesInternalRep --
*
* Initialize the internal representation of a arithseries Tcl_Obj to a
* copy of the internal representation of an existing arithseries object.
*
* Results:
* None.
*
* Side effects:
* We set "copyPtr"s internal rep to a pointer to a
* newly allocated ArithSeries structure.
*----------------------------------------------------------------------
*/
static void
DupArithSeriesInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
ArithSeries *srcArithSeriesRepPtr =
(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
/*
* Allocate a new ArithSeries structure. */
if (srcArithSeriesRepPtr->isDouble) {
ArithSeriesDbl *srcArithSeriesDblRepPtr =
(ArithSeriesDbl *)srcArithSeriesRepPtr;
ArithSeriesDbl *copyArithSeriesDblRepPtr =
(ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
copyArithSeriesDblRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
} else {
ArithSeries *copyArithSeriesRepPtr =
(ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
copyArithSeriesRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
}
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &arithSeriesType;
}
/*
*----------------------------------------------------------------------
*
* FreeArithSeriesInternalRep --
*
* Free any allocated memory in the ArithSeries Rep
*
* Results:
* None.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr) /* Free any allocated memory */
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
if (arithSeriesRepPtr) {
if (arithSeriesRepPtr->elements) {
Tcl_WideInt i, len = arithSeriesRepPtr->len;
for (i=0; i<len; i++) {
Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]);
}
Tcl_Free((char*)arithSeriesRepPtr->elements);
arithSeriesRepPtr->elements = NULL;
}
Tcl_Free((char*)arithSeriesRepPtr);
}
}
/*
*----------------------------------------------------------------------
*
@@ -233,7 +356,7 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide
arithSeriesRepPtr->elements = NULL;
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesObj->typePtr = &tclArithSeriesType.objType;
arithSeriesObj->typePtr = &arithSeriesType;
if (length > 0)
Tcl_InvalidateStringRep(arithSeriesObj);
@@ -288,7 +411,7 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
arithSeriesRepPtr->precision = maxPrecision(start,end,step);
arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
arithSeriesObj->typePtr = &tclArithSeriesType.objType;
arithSeriesObj->typePtr = &arithSeriesType;
if (length > 0) {
Tcl_InvalidateStringRep(arithSeriesObj);
@@ -420,7 +543,8 @@ TclNewArithSeriesObj(
assert(dstep!=0);
if (!lenObj) {
if (useDoubles) {
len = ArithSeriesLenDbl(dstart, dend, dstep);
int precision = maxPrecision(dstart,dend,dstep);
len = ArithSeriesLenDbl(dstart, dend, dstep, precision);
} else {
len = ArithSeriesLenInt(start, end, step);
}
@@ -452,44 +576,6 @@ TclNewArithSeriesObj(
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ArithSeriesObjStep --
*
* Return a Tcl_Obj with the step value from the give ArithSeries Obj.
* refcount = 0.
*
* Results:
*
* A Tcl_Obj pointer to the created ArithSeries object.
* A NULL pointer of the range is invalid.
*
* Side Effects:
*
* None.
*----------------------------------------------------------------------
*/
Tcl_Obj *
ArithSeriesObjStep(
Tcl_Obj *arithSeriesObj)
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *stepObj;
if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj.");
}
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (arithSeriesRepPtr->isDouble) {
TclNewDoubleObj(stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
} else {
TclNewIntObj(stepObj, arithSeriesRepPtr->step);
}
return stepObj;
}
/*
*----------------------------------------------------------------------
@@ -498,40 +584,43 @@ ArithSeriesObjStep(
*
* Returns the element with the specified index in the list
* represented by the specified Arithmetic Sequence object.
* If the index is out of range, NULL is returned.
* If the index is out of range, TCL_ERROR is returned,
* otherwise TCL_OK is returned and the integer value of the
* element is stored in *element.
*
* Results:
*
* The element on success, NULL on index out of range.
* TCL_OK on success.
*
* Side Effects:
*
* On success, the integer pointed by *element is modified.
* An empty string ("") is assigned if index is out-of-bounds.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
int
TclArithSeriesObjIndex(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *arithSeriesObj,
Tcl_WideInt index)
TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
Tcl_Obj *arithSeriesObj, /* List obj */
Tcl_Size index, /* index to element of interest */
Tcl_Obj **elemObj) /* Return value */
{
ArithSeries *arithSeriesRepPtr;
ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
}
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) {
return Tcl_NewObj();
}
/* List[i] = Start + (Step * index) */
if (arithSeriesRepPtr->isDouble) {
return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
if (index < 0 || arithSeriesRepPtr->len <= index) {
*elemObj = NULL;
} else {
return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
/* List[i] = Start + (Step * index) */
if (arithSeriesRepPtr->isDouble) {
*elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
} else {
*elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
}
}
return TCL_OK;
}
/*
@@ -557,173 +646,38 @@ Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
arithSeriesObj->internalRep.twoPtrValue.ptr1;
return arithSeriesRepPtr->len;
}
/*
*----------------------------------------------------------------------
*
* FreeArithSeriesInternalRep --
* TclArithSeriesObjStep --
*
* Deallocate the storage associated with an arithseries object's
* internal representation.
* Return a Tcl_Obj with the step value from the give ArithSeries Obj.
* refcount = 0.
*
* Results:
* None.
*
* Side effects:
* Frees arithSeriesObj's ArithSeries* internal representation and
* sets listPtr's internalRep.twoPtrValue.ptr1 to NULL.
* A Tcl_Obj pointer to the created ArithSeries object.
* A NULL pointer of the range is invalid.
*
* Side Effects:
*
* None.
*----------------------------------------------------------------------
*/
static void
FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObj)
int
TclArithSeriesObjStep(
Tcl_Obj *arithSeriesObj,
Tcl_Obj **stepObj)
{
ArithSeries *arithSeriesRepPtr =
(ArithSeries *) arithSeriesObj->internalRep.twoPtrValue.ptr1;
if (arithSeriesRepPtr->elements) {
Tcl_Size i;
Tcl_Obj**elmts = arithSeriesRepPtr->elements;
for(i=0; i<arithSeriesRepPtr->len; i++) {
if (elmts[i]) {
Tcl_DecrRefCount(elmts[i]);
}
}
Tcl_Free((char *) arithSeriesRepPtr->elements);
}
Tcl_Free((char *) arithSeriesRepPtr);
arithSeriesObj->internalRep.twoPtrValue.ptr1 = NULL;
}
/*
*----------------------------------------------------------------------
*
* DupArithSeriesInternalRep --
*
* Initialize the internal representation of a arithseries Tcl_Obj to a
* copy of the internal representation of an existing arithseries object.
*
* Results:
* None.
*
* Side effects:
* We set "copyPtr"s internal rep to a pointer to a
* newly allocated ArithSeries structure.
*----------------------------------------------------------------------
*/
static void
DupArithSeriesInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
ArithSeries *srcArithSeriesRepPtr =
(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
/*
* Allocate a new ArithSeries structure. */
if (srcArithSeriesRepPtr->isDouble) {
ArithSeriesDbl *srcArithSeriesDblRepPtr =
(ArithSeriesDbl *)srcArithSeriesRepPtr;
ArithSeriesDbl *copyArithSeriesDblRepPtr =
(ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
copyArithSeriesDblRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (arithSeriesRepPtr->isDouble) {
*stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
} else {
ArithSeries *copyArithSeriesRepPtr =
(ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
copyArithSeriesRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
*stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step);
}
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclArithSeriesType.objType;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfArithSeries --
*
* Update the string representation for an arithseries object.
* Note: This procedure does not invalidate an existing old string rep
* so storage will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from
* the list-to-string conversion. This string will be empty if the
* list has no elements. The list internal representation
* should not be NULL and we assume it is not NULL.
*
* Notes:
* At the cost of overallocation it's possible to estimate
* the length of the string representation and make this procedure
* much faster. Because the programmer shouldn't expect the
* string conversion of a big arithmetic sequence to be fast
* this version takes more care of space than time.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj)
{
ArithSeries *arithSeriesRepPtr =
(ArithSeries*) arithSeriesObj->internalRep.twoPtrValue.ptr1;
char *elem, *p;
Tcl_Obj *elemObj;
Tcl_Size i;
Tcl_Size length = 0;
Tcl_Size slen;
/*
* Pass 1: estimate space.
*/
if (!arithSeriesRepPtr->isDouble) {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
length += slen;
}
} else {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
char tmp[TCL_DOUBLE_SPACE+2];
tmp[0] = 0;
Tcl_PrintDouble(NULL,d,tmp);
if ((length + strlen(tmp)) > TCL_SIZE_MAX) {
break; // overflow
}
length += strlen(tmp);
}
}
length += arithSeriesRepPtr->len; // Space for each separator
/*
* Pass 2: generate the string repr.
*/
p = Tcl_InitStringRep(arithSeriesObj, NULL, length);
if (p == NULL) {
Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
}
for (i = 0; i < arithSeriesRepPtr->len; i++) {
elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
elem = Tcl_GetStringFromObj(elemObj, &slen);
if (((p - arithSeriesObj->bytes)+slen) > length) {
break;
}
strncpy(p, elem, slen);
p[slen] = ' ';
p += slen+1;
Tcl_DecrRefCount(elemObj);
}
if (length > 0) arithSeriesObj->bytes[length-1] = '\0';
arithSeriesObj->length = length-1;
return TCL_OK;
}
/*
@@ -776,28 +730,33 @@ SetArithSeriesFromAny(
*----------------------------------------------------------------------
*/
Tcl_Obj *
int
TclArithSeriesObjRange(
Tcl_Interp *interp, /* For error message(s) */
Tcl_Obj *arithSeriesObj, /* List object to take a range from. */
Tcl_Size fromIdx, /* Index of first element to include. */
Tcl_Size toIdx) /* Index of last element to include. */
Tcl_Size toIdx, /* Index of last element to include. */
Tcl_Obj **newObjPtr) /* return value */
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
(void)interp; /* silence compiler */
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
if (fromIdx == TCL_INDEX_NONE) {
fromIdx = 0;
}
if (toIdx >= arithSeriesRepPtr->len) {
toIdx = arithSeriesRepPtr->len-1;
}
if (fromIdx > toIdx ||
(toIdx > arithSeriesRepPtr->len-1 &&
fromIdx > arithSeriesRepPtr->len-1)) {
Tcl_Obj *obj;
TclNewObj(obj);
return obj;
fromIdx >= arithSeriesRepPtr->len) {
TclNewObj(*newObjPtr);
return TCL_OK;
}
if (fromIdx < 0) {
@@ -810,31 +769,22 @@ TclArithSeriesObjRange(
toIdx = arithSeriesRepPtr->len-1;
}
startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx);
if (startObj == NULL) {
return NULL;
}
TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
Tcl_IncrRefCount(startObj);
endObj = TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx);
if (endObj == NULL) {
return NULL;
}
TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
Tcl_IncrRefCount(endObj);
stepObj = ArithSeriesObjStep(arithSeriesObj);
TclArithSeriesObjStep(arithSeriesObj, &stepObj);
Tcl_IncrRefCount(stepObj);
if (Tcl_IsShared(arithSeriesObj) ||
((arithSeriesObj->refCount > 1))) {
Tcl_Obj *newSlicePtr;
if (TclNewArithSeriesObj(interp, &newSlicePtr,
arithSeriesRepPtr->isDouble, startObj, endObj,
stepObj, NULL) != TCL_OK) {
newSlicePtr = NULL;
}
int status = TclNewArithSeriesObj(NULL, newObjPtr,
arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL);
Tcl_DecrRefCount(startObj);
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
return newSlicePtr;
return status;
}
/*
@@ -859,7 +809,8 @@ TclArithSeriesObjRange(
arithSeriesDblRepPtr->end = end;
arithSeriesDblRepPtr->step = step;
arithSeriesDblRepPtr->precision = maxPrecision(start, end, step);
arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step);
arithSeriesDblRepPtr->len =
ArithSeriesLenDbl(start, end, step, arithSeriesDblRepPtr->precision);
arithSeriesDblRepPtr->elements = NULL;
} else {
@@ -878,7 +829,8 @@ TclArithSeriesObjRange(
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
return arithSeriesObj;
*newObjPtr = arithSeriesObj;
return TCL_OK;
}
/*
@@ -920,12 +872,13 @@ TclArithSeriesGetElements(
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
{
if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
if (TclHasInternalRep(objPtr,&arithSeriesType)) {
ArithSeries *arithSeriesRepPtr;
Tcl_Obj **objv;
int i, objc;
arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
objc = arithSeriesRepPtr->len;
if (objc > 0) {
if (arithSeriesRepPtr->elements) {
@@ -945,8 +898,8 @@ TclArithSeriesGetElements(
}
arithSeriesRepPtr->elements = objv;
for (i = 0; i < objc; i++) {
objv[i] = TclArithSeriesObjIndex(interp, objPtr, i);
if (objv[i] == NULL) {
int status = TclArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
if (status) {
return TCL_ERROR;
}
Tcl_IncrRefCount(objv[i]);
@@ -974,24 +927,23 @@ TclArithSeriesGetElements(
*
* TclArithSeriesObjReverse --
*
* Reverse the order of the ArithSeries value.
* *arithSeriesObj must be known to be a valid list.
* Reverse the order of the ArithSeries value. The arithSeriesObj is
* assumed to be a valid ArithSeries. The new Obj has the Start and End
* values appropriately swapped and the Step value sign is changed.
*
* Results:
* Returns a pointer to the reordered series.
* This may be a new object or the same object if not shared.
* The result will be an ArithSeries in the reverse order.
*
* Side effects:
* ?The possible conversion of the object referenced by listPtr?
* ?to a list object.?
* The ogiginal obj will be modified and returned if it is not Shared.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
int
TclArithSeriesObjReverse(
Tcl_Interp *interp, /* For error message(s) */
Tcl_Obj *arithSeriesObj) /* List object to reverse. */
Tcl_Obj *arithSeriesObj, /* List object to reverse. */
Tcl_Obj **newObjPtr)
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
@@ -1000,16 +952,22 @@ TclArithSeriesObjReverse(
double dstart, dend, dstep;
int isDouble;
(void)interp;
if (newObjPtr == NULL) {
return TCL_ERROR;
}
arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
isDouble = arithSeriesRepPtr->isDouble;
len = arithSeriesRepPtr->len;
startObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1));
TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
Tcl_IncrRefCount(startObj);
endObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, 0);
TclArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
Tcl_IncrRefCount(endObj);
stepObj = ArithSeriesObjStep(arithSeriesObj);
TclArithSeriesObjStep(arithSeriesObj, &stepObj);
Tcl_IncrRefCount(stepObj);
if (isDouble) {
@@ -1030,8 +988,8 @@ TclArithSeriesObjReverse(
((arithSeriesObj->refCount > 1))) {
Tcl_Obj *lenObj;
TclNewIntObj(lenObj, len);
if (TclNewArithSeriesObj(interp, &resultObj,
isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) {
if (TclNewArithSeriesObj(NULL, &resultObj, isDouble,
startObj, endObj, stepObj, lenObj) != TCL_OK) {
resultObj = NULL;
}
Tcl_DecrRefCount(lenObj);
@@ -1070,9 +1028,174 @@ TclArithSeriesObjReverse(
Tcl_DecrRefCount(endObj);
Tcl_DecrRefCount(stepObj);
return resultObj;
}
*newObjPtr = resultObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfArithSeries --
*
* Update the string representation for an arithseries object.
* Note: This procedure does not invalidate an existing old string rep
* so storage will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from
* the list-to-string conversion. This string will be empty if the
* list has no elements. The list internal representation
* should not be NULL and we assume it is not NULL.
*
* Notes:
* At the cost of overallocation it's possible to estimate
* the length of the string representation and make this procedure
* much faster. Because the programmer shouldn't expect the
* string conversion of a big arithmetic sequence to be fast
* this version takes more care of space than time.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr)
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
char *p;
Tcl_Obj *eleObj;
Tcl_Size i, bytlen = 0;
/*
* Pass 1: estimate space.
*/
if (!arithSeriesRepPtr->isDouble) {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
size_t slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
bytlen += slen;
}
} else {
for (i = 0; i < arithSeriesRepPtr->len; i++) {
double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
char tmp[TCL_DOUBLE_SPACE+2];
tmp[0] = 0;
Tcl_PrintDouble(NULL,d,tmp);
if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) {
break; // overflow
}
bytlen += strlen(tmp);
}
}
bytlen += arithSeriesRepPtr->len; // Space for each separator
/*
* Pass 2: generate the string repr.
*/
p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen);
for (i = 0; i < arithSeriesRepPtr->len; i++) {
if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) {
Tcl_Size slen;
char *str = Tcl_GetStringFromObj(eleObj, &slen);
strcpy(p, str);
p[slen] = ' ';
p += slen+1;
Tcl_DecrRefCount(eleObj);
} // else TODO: report error here?
}
if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0';
arithSeriesObjPtr->length = bytlen-1;
}
/*
*----------------------------------------------------------------------
*
* ArithSeriesInOperator --
*
* Evaluate the "in" operation for expr
*
* This can be done more efficiently in the Arith Series relative to
* doing a linear search as implemented in expr.
*
* Results:
* Boolean true or false (1/0)
*
* Side effects:
* None
*
*----------------------------------------------------------------------
*/
static int
ArithSeriesInOperation(
Tcl_Interp *interp,
Tcl_Obj *valueObj,
Tcl_Obj *arithSeriesObjPtr,
int *boolResult)
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1;
ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
int status;
Tcl_Size index, incr, elen, vlen;
if (arithSeriesRepPtr->isDouble) {
double y;
int test = 0;
incr = 0; // Check index+incr where incr is 0 and 1
status = Tcl_GetDoubleFromObj(interp, valueObj, &y);
if (status != TCL_OK) {
test = 0;
} else {
const char *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
index = (y - dblRepPtr->start) / dblRepPtr->step;
while (incr<2) {
Tcl_Obj *elemObj;
elen = 0;
TclArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj);
const char *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
/* "in" operation defined as a string compare */
test = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
Tcl_BounceRefCount(elemObj);
/* Stop if we have a match */
if (test) {
break;
}
incr++;
}
}
if (boolResult) {
*boolResult = test;
}
} else {
ArithSeries *intRepPtr = arithSeriesRepPtr;
Tcl_WideInt y;
status = Tcl_GetWideIntFromObj(NULL, valueObj, &y);
if (status != TCL_OK) {
if (boolResult) {
*boolResult = 0;
}
} else {
Tcl_Obj *elemObj;
elen = 0;
index = (y - intRepPtr->start) / intRepPtr->step;
TclArithSeriesObjIndex(interp, arithSeriesObjPtr, index, &elemObj);
char const *vstr = Tcl_GetStringFromObj(valueObj, &vlen);
char const *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
if (boolResult) {
*boolResult = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
}
Tcl_BounceRefCount(elemObj);
}
}
return TCL_OK;
}
/*
* Local Variables:
* mode: c
-56
View File
@@ -1,56 +0,0 @@
/*
* tclArithSeries.h --
*
* This file contains the ArithSeries concrete abstract list
* implementation. It implements the inner workings of the lseq command.
*
* Copyright © 2022 Brian S. Griffin.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
/*
* The structure used for the ArithSeries internal representation.
* Note that the len can in theory be always computed by start,end,step
* but it's faster to cache it inside the internal representation.
*/
typedef struct {
Tcl_WideInt len;
Tcl_Obj **elements;
int isDouble;
Tcl_WideInt start;
Tcl_WideInt end;
Tcl_WideInt step;
} ArithSeries;
typedef struct {
Tcl_WideInt len;
Tcl_Obj **elements;
int isDouble;
double start;
double end;
double step;
int precision;
} ArithSeriesDbl;
MODULE_SCOPE Tcl_Obj *TclArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
Tcl_WideInt index);
MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Interp *interp,
Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx);
MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp,
Tcl_Obj *arithSeriesPtr);
MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp,
Tcl_Obj **arithSeriesObj, int useDoubles,
Tcl_Obj *startObj, Tcl_Obj *endObj,
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+1 -1
View File
@@ -224,7 +224,7 @@ typedef struct AssemblyEnv {
* offsets of the labels. */
Tcl_Size cmdLine; /* Current line number within the assembly
* code */
int* clNext; /* Invisible continuation line for
Tcl_Size* clNext; /* Invisible continuation line for
* [info frame] */
BasicBlock* head_bb; /* First basic block in the code */
BasicBlock* curr_bb; /* Current basic block */
+22 -25
View File
@@ -5147,7 +5147,7 @@ TclEvalEx(
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
Tcl_Size line, /* The line the script starts on. */
int *clNextOuter, /* Information about an outer context for */
Tcl_Size *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set only in
* TclSubstTokens(), to properly handle
* [...]-nested commands. The 'outerScript'
@@ -5169,7 +5169,8 @@ TclEvalEx(
const char *p, *next;
const int minObjs = 20;
Tcl_Obj **objv, **objvSpace;
int *expand, *lines, *lineSpace;
int *expand;
Tcl_Size *lines, *lineSpace;
Tcl_Token *tokenPtr;
int expandRequested, code = TCL_OK;
Tcl_Size bytesLeft, commandLength;
@@ -5187,10 +5188,10 @@ TclEvalEx(
Tcl_Obj **stackObjArray = (Tcl_Obj **)
TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
/* TIP #280 Structures for tracking of command
* locations. */
int *clNext = NULL; /* Pointer for the tracking of invisible
Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible
* continuation lines. Initialized only if the
* caller gave us a table of locations to
* track, via scriptCLLocPtr. It always refers
@@ -5314,7 +5315,7 @@ TclEvalEx(
Tcl_Size wordLine = line;
const char *wordStart = parsePtr->commandStart;
int *wordCLNext = clNext;
Tcl_Size *wordCLNext = clNext;
Tcl_Size objectsNeeded = 0;
Tcl_Size numWords = parsePtr->numWords;
@@ -5325,7 +5326,7 @@ TclEvalEx(
if (numWords > minObjs) {
expand = (int *)Tcl_Alloc(numWords * sizeof(int));
objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
}
expandRequested = 0;
objv = objvSpace;
@@ -5351,7 +5352,7 @@ TclEvalEx(
wordStart = tokenPtr->start;
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
? (int)wordLine : -1;
? wordLine : -1;
if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
iPtr->evalFlags |= TCL_EVAL_FILE;
@@ -5417,14 +5418,14 @@ TclEvalEx(
*/
Tcl_Obj **copy = objvSpace;
int *lcopy = lineSpace;
int wordIdx = numWords;
int objIdx = objectsNeeded - 1;
Tcl_Size *lcopy = lineSpace;
Tcl_Size wordIdx = numWords;
Tcl_Size objIdx = objectsNeeded - 1;
if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
objv = objvSpace =
(Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
}
objectsUsed = 0;
@@ -5659,7 +5660,7 @@ TclAdvanceLines(
void
TclAdvanceContinuations(
Tcl_Size *line,
int **clNextPtrPtr,
Tcl_Size **clNextPtrPtr,
int loc)
{
/*
@@ -5837,7 +5838,7 @@ TclArgumentBCEnter(
int objc,
void *codePtr,
CmdFrame *cfPtr,
int cmd,
Tcl_Size cmd,
Tcl_Size pc)
{
ExtCmdLoc *eclPtr;
@@ -6152,11 +6153,7 @@ TclNREvalObjEx(
*/
Tcl_IncrRefCount(objPtr);
listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType.objType);
if (!listPtr) {
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
listPtr = TclListObjCopy(interp, objPtr);
Tcl_IncrRefCount(listPtr);
if (word != INT_MIN) {
@@ -7050,7 +7047,7 @@ ExprCeilFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7090,7 +7087,7 @@ ExprFloorFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7236,7 +7233,7 @@ ExprSqrtFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7290,7 +7287,7 @@ ExprUnaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
d = irPtr->doubleValue;
@@ -7354,7 +7351,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
d1 = irPtr->doubleValue;
@@ -7369,7 +7366,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
if (irPtr) {
d2 = irPtr->doubleValue;
@@ -7530,7 +7527,7 @@ ExprDoubleFunc(
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
if (TclHasInternalRep(objv[1], &tclDoubleType.objType)) {
if (TclHasInternalRep(objv[1], &tclDoubleType)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
+3 -3
View File
@@ -2001,7 +2001,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
if (irPtr == NULL) {
return TCL_ERROR;
}
@@ -2021,7 +2021,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
if (irPtr == NULL) {
return TCL_ERROR;
@@ -2629,7 +2629,7 @@ BinaryEncode64(
}
switch (index) {
case OPT_MAXLEN:
if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
return TCL_ERROR;
}
if (maxlen < 0) {
+1 -1
View File
@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
* that it isn't.
*/
if (TclHasInternalRep(objv[1], &tclBignumType.objType)) {
if (TclHasInternalRep(objv[1], &tclBignumType)) {
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
+50 -52
View File
@@ -17,7 +17,6 @@
#ifdef _WIN32
# include "tclWinInt.h"
#endif
#include "tclArithSeries.h"
/*
* The state structure used by [foreach]. Note that the actual structure has
@@ -552,11 +551,11 @@ EncodingConvertfromObjCmd(
/* NOTE: ds must be freed beyond this point even on error */
switch (result) {
case TCL_OK:
errorLocation = TCL_INDEX_NONE;
break;
errorLocation = TCL_INDEX_NONE;
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
@@ -566,10 +565,10 @@ EncodingConvertfromObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
break;
}
/*
@@ -654,7 +653,7 @@ EncodingConverttoObjCmd(
break;
case TCL_ERROR:
/* Error in parameters. Should not happen. interp will have error */
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
default:
/*
@@ -664,10 +663,10 @@ EncodingConverttoObjCmd(
* what could be decoded and the returned error location.
*/
if (failVarObj == NULL) {
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
break;
break;
}
/*
* TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
@@ -1200,10 +1199,10 @@ FileAttrAccessTimeCmd(
#if defined(_WIN32)
/* We use a value of 0 to indicate the access time not available */
if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get access time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get access time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
}
#endif
@@ -1282,10 +1281,10 @@ FileAttrModifyTimeCmd(
#if defined(_WIN32)
/* We use a value of 0 to indicate the modification time not available */
if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get modification time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not get modification time for file \"%s\"",
TclGetString(objv[1])));
return TCL_ERROR;
}
#endif
if (objc == 3) {
@@ -2325,34 +2324,34 @@ StoreStatData(
unsigned short mode;
if (varName == NULL) {
TclNewObj(result);
Tcl_IncrRefCount(result);
TclNewObj(result);
Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue) \
Tcl_DictObjPut(NULL, result, \
Tcl_NewStringObj((key), -1), \
(objValue));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
mode = (unsigned short) statPtr->st_mode;
DOBJPUT("mode", Tcl_NewWideIntObj(mode));
DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef DOBJPUT
Tcl_SetObjResult(interp, result);
Tcl_DecrRefCount(result);
return TCL_OK;
Tcl_SetObjResult(interp, result);
Tcl_DecrRefCount(result);
return TCL_OK;
}
/*
@@ -2788,9 +2787,8 @@ EachloopCmd(
for (i=0 ; i<numLists ; i++) {
/* List */
/* Variables */
statePtr->vCopyList[i] = TclDuplicatePureObj(
interp, objv[1+i*2], &tclListType.objType);
if (!statePtr->vCopyList[i]) {
statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
if (statePtr->vCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
@@ -2814,20 +2812,19 @@ EachloopCmd(
&statePtr->varcList[i], &statePtr->varvList[i]);
/* Values */
if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) {
/* Special case for Arith Series */
if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
/* Special case for AbstractList */
statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
if (statePtr->aCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
/* Don't compute values here, wait until the last moment */
statePtr->argcList[i] = ABSTRACTLIST_PROC(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
} else {
/* List values */
statePtr->aCopyList[i] = TclDuplicatePureObj(
interp, objv[2+i*2], &tclListType.objType);
if (!statePtr->aCopyList[i]) {
statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
if (statePtr->aCopyList[i] == NULL) {
result = TCL_ERROR;
goto done;
}
@@ -2964,17 +2961,18 @@ ForeachAssignments(
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType);
int isAbstractList =
TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;
for (v=0 ; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
if (isarithseries) {
valuePtr = TclArithSeriesObjIndex(interp, statePtr->aCopyList[i], k);
if (valuePtr == NULL) {
if (isAbstractList) {
if (TclObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (setting %s loop variable \"%s\")",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
"\n (setting %s loop variable \"%s\")",
(statePtr->resultList != NULL ? "lmap" : "foreach"),
TclGetString(statePtr->varvList[i][v])));
return TCL_ERROR;
}
} else {
+199 -209
View File
@@ -19,7 +19,6 @@
#include "tclInt.h"
#include "tclRegexp.h"
#include "tclArithSeries.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>
@@ -2203,7 +2202,7 @@ Tcl_JoinObjCmd(
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Size length, listLen;
int isArithSeries = 0;
int isAbstractList = 0;
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
@@ -2216,14 +2215,17 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
isArithSeries = 1;
listLen = ABSTRACTLIST_PROC(objv[1], lengthProc)(objv[1]);
} else {
if (TclListObjGetElementsM(interp, objv[1], &listLen,
&elemPtrs) != TCL_OK) {
if (TclObjTypeHasProc(objv[1], getElementsProc)) {
listLen = TclObjTypeLength(objv[1]);
isAbstractList = (listLen ? 1 : 0);
if (listLen > 1 &&
TclObjTypeGetElements(interp, objv[1], &listLen, &elemPtrs)
!= TCL_OK) {
return TCL_ERROR;
}
} else if (TclListObjGetElementsM(interp, objv[1], &listLen,
&elemPtrs) != TCL_OK) {
return TCL_ERROR;
}
if (listLen == 0) {
@@ -2232,14 +2234,15 @@ Tcl_JoinObjCmd(
}
if (listLen == 1) {
/* One element; return it */
if (isArithSeries) {
Tcl_Obj *valueObj = TclArithSeriesObjIndex(interp, objv[1], 0);
if (valueObj == NULL) {
if (!isAbstractList) {
Tcl_SetObjResult(interp, elemPtrs[0]);
} else {
Tcl_Obj *elemObj;
if (TclObjTypeIndex(interp, objv[1], 0, &elemObj)
!= TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valueObj);
} else {
Tcl_SetObjResult(interp, elemPtrs[0]);
Tcl_SetObjResult(interp, elemObj);
}
return TCL_OK;
}
@@ -2254,42 +2257,19 @@ Tcl_JoinObjCmd(
Tcl_Size i;
TclNewObj(resObjPtr);
if (isArithSeries) {
Tcl_Obj *valueObj;
for (i = 0; i < listLen; i++) {
if (i > 0) {
for (i = 0; i < listLen; i++) {
if (i > 0) {
/*
* NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
* to shimmer joinObjPtr. If it did, then the case where
* objv[1] and objv[2] are the same value would not be safe.
* Accessing elemPtrs would crash.
*/
/*
* NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
* to shimmer joinObjPtr. If it did, then the case where
* objv[1] and objv[2] are the same value would not be safe.
* Accessing elemPtrs would crash.
*/
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
valueObj = TclArithSeriesObjIndex(interp, objv[1], i);
if (valueObj == NULL) {
return TCL_ERROR;
}
Tcl_AppendObjToObj(resObjPtr, valueObj);
Tcl_DecrRefCount(valueObj);
}
} else {
for (i = 0; i < listLen; i++) {
if (i > 0) {
/*
* NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
* to shimmer joinObjPtr. If it did, then the case where
* objv[1] and objv[2] are the same value would not be safe.
* Accessing elemPtrs would crash.
*/
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
}
Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
}
Tcl_DecrRefCount(joinObjPtr);
@@ -2335,8 +2315,8 @@ Tcl_LassignObjCmd(
return TCL_ERROR;
}
listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
if (!listCopyPtr) {
listCopyPtr = TclListObjCopy(interp, objv[1]);
if (listCopyPtr == NULL) {
return TCL_ERROR;
}
Tcl_IncrRefCount(listCopyPtr); /* Important! fs */
@@ -2505,10 +2485,7 @@ Tcl_LinsertObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
if (!listPtr) {
return TCL_ERROR;
}
listPtr = TclListObjCopy(NULL, listPtr);
copied = 1;
}
@@ -2655,7 +2632,7 @@ Tcl_LpopObjCmd(
Tcl_Size listLen;
int copied = 0, result;
Tcl_Obj *elemPtr, *stored;
Tcl_Obj *listPtr, **elemPtrs;
Tcl_Obj *listPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
@@ -2667,7 +2644,7 @@ Tcl_LpopObjCmd(
return TCL_ERROR;
}
result = TclListObjGetElementsM(interp, listPtr, &listLen, &elemPtrs);
result = TclListObjLengthM(interp, listPtr, &listLen);
if (result != TCL_OK) {
return result;
}
@@ -2686,7 +2663,12 @@ Tcl_LpopObjCmd(
"OUTOFRANGE", NULL);
return TCL_ERROR;
}
elemPtr = elemPtrs[listLen - 1];
result = Tcl_ListObjIndex(interp, listPtr, (listLen-1), &elemPtr);
if (result != TCL_OK) {
return result;
}
Tcl_IncrRefCount(elemPtr);
} else {
elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);
@@ -2705,10 +2687,7 @@ Tcl_LpopObjCmd(
if (objc == 2) {
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
if (!listPtr) {
return TCL_ERROR;
}
listPtr = TclListObjCopy(NULL, listPtr);
copied = 1;
}
result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
@@ -2719,7 +2698,13 @@ Tcl_LpopObjCmd(
return result;
}
} else {
Tcl_Obj *newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
Tcl_Obj *newListPtr;
Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(listPtr, setElementProc);
if (proc) {
newListPtr = proc(interp, listPtr, objc-2, objv+2, NULL);
} else {
newListPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
}
if (newListPtr == NULL) {
if (copied) {
Tcl_DecrRefCount(listPtr);
@@ -2788,11 +2773,11 @@ Tcl_LrangeObjCmd(
return result;
}
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
Tcl_Obj *rangeObj;
rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
if (rangeObj) {
Tcl_SetObjResult(interp, rangeObj);
if (TclObjTypeHasProc(objv[1], sliceProc)) {
Tcl_Obj *resultObj;
int status = TclObjTypeSlice(interp, objv[1], first, last, &resultObj);
if (status == TCL_OK) {
Tcl_SetObjResult(interp, resultObj);
} else {
return TCL_ERROR;
}
@@ -2892,11 +2877,7 @@ Tcl_LremoveObjCmd(
*/
if (Tcl_IsShared(listObj)) {
listObj = TclDuplicatePureObj(interp, listObj, &tclListType.objType);
if (!listObj) {
status = TCL_ERROR;
goto done;
}
listObj = TclListObjCopy(NULL, listObj);
copied = 1;
}
num = 0;
@@ -2981,7 +2962,8 @@ Tcl_LrepeatObjCmd(
Tcl_Obj *const objv[])
/* The argument objects. */
{
Tcl_Size elementCount, i, totalElems;
Tcl_WideInt elementCount, i;
Tcl_Size totalElems;
Tcl_Obj *listPtr, **dataArray = NULL;
/*
@@ -2993,12 +2975,12 @@ Tcl_LrepeatObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
return TCL_ERROR;
}
if (TCL_OK != TclGetSizeIntFromObj(interp, objv[1], &elementCount)) {
if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) {
return TCL_ERROR;
}
if (elementCount < 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount));
"bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
NULL);
return TCL_ERROR;
@@ -3147,10 +3129,7 @@ Tcl_LreplaceObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
if (!listPtr) {
return TCL_ERROR;
}
listPtr = TclListObjCopy(NULL, listPtr);
}
/*
@@ -3208,20 +3187,18 @@ Tcl_LreverseObjCmd(
}
/*
* Handle ArithSeries special case - don't shimmer a series into a list
* just to reverse it.
* Handle AbstractList special case - do not shimmer into a list, if it
* supports a private Reverse function, just to reverse it.
*/
if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
if (resObj) {
Tcl_SetObjResult(interp, resObj);
if (TclObjTypeHasProc(objv[1], reverseProc)) {
Tcl_Obj *resultObj;
if (TclObjTypeReverse(interp, objv[1], &resultObj) == TCL_OK) {
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
} else {
return TCL_ERROR;
}
} /* end ArithSeries */
} /* end Abstract List */
/* True List */
if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
return TCL_ERROR;
}
@@ -3307,14 +3284,14 @@ Tcl_LsearchObjCmd(
const char *bytes, *patternBytes;
int match, result=TCL_OK, bisect;
Tcl_Size i, length = 0, listc, elemLen, start, index;
Tcl_Size groupSize, groupOffset, lower, upper;
Tcl_Size groupOffset, lower, upper;
int allocatedIndexVector = 0;
int isIncreasing;
Tcl_WideInt patWide, objWide, wide;
Tcl_WideInt patWide, objWide, wide, groupSize;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr = NULL;
SortStrCmpFn_t strCmpFn = TclUtfCmp;
Tcl_RegExp regexp = NULL;
static const char *const options[] = {
@@ -3759,9 +3736,14 @@ Tcl_LsearchObjCmd(
lower = start - groupSize;
upper = listc;
itemPtr = NULL;
while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
i = (lower + upper)/2;
i -= i % groupSize;
Tcl_BounceRefCount(itemPtr);
itemPtr = NULL;
if (sortInfo.indexc != 0) {
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
@@ -3860,6 +3842,9 @@ Tcl_LsearchObjCmd(
}
for (i = start; i < listc; i += groupSize) {
match = 0;
Tcl_BounceRefCount(itemPtr);
itemPtr = NULL;
if (sortInfo.indexc != 0) {
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
@@ -3959,6 +3944,7 @@ Tcl_LsearchObjCmd(
*/
if (returnSubindices && (sortInfo.indexc != 0)) {
Tcl_BounceRefCount(itemPtr);
itemPtr = SelectObjFromSublist(listv[i+groupOffset],
&sortInfo);
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
@@ -3966,6 +3952,7 @@ Tcl_LsearchObjCmd(
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
groupSize, &listv[i]);
} else {
Tcl_BounceRefCount(itemPtr);
itemPtr = listv[i];
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
}
@@ -3986,6 +3973,9 @@ Tcl_LsearchObjCmd(
}
}
Tcl_BounceRefCount(itemPtr);
itemPtr = NULL;
/*
* Return everything or a single value.
*/
@@ -4033,6 +4023,9 @@ Tcl_LsearchObjCmd(
*/
done:
/* potential lingering abstract list element */
Tcl_BounceRefCount(itemPtr);
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
@@ -4042,91 +4035,6 @@ Tcl_LsearchObjCmd(
return result;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LsetObjCmd --
*
* This procedure is invoked to process the "lset" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_LsetObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tcl_Obj *listPtr; /* Pointer to the list being altered. */
Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
/*
* Check parameter count.
*/
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"listVar ?index? ?index ...? value");
return TCL_ERROR;
}
/*
* Look up the list variable's value.
*/
listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* Substitute the value in the value. Return either the value or else an
* unshared copy of it.
*/
if (objc == 4) {
finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
} else {
finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
objv[objc-1]);
}
/*
* If substitution has failed, bail out.
*/
if (finalValuePtr == NULL) {
return TCL_ERROR;
}
/*
* Finally, update the variable so that traces fire.
*/
listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(finalValuePtr);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* Return the new value of the variable as the interpreter result.
*/
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -4267,7 +4175,7 @@ Tcl_LseqObjCmd(
Tcl_WideInt values[5];
Tcl_Obj *numValues[5];
Tcl_Obj *numberObj;
int status, keyword, useDoubles = 0;
int status = TCL_ERROR, keyword, useDoubles = 0;
Tcl_Obj *arithSeriesPtr;
SequenceOperators opmode;
SequenceDecoded decoded;
@@ -4337,11 +4245,10 @@ Tcl_LseqObjCmd(
case 0:
Tcl_WrongNumArgs(interp, 1, objv,
"n ??op? n ??by? n??");
status = TCL_ERROR;
goto done;
break;
/* range n */
/* lseq n */
case 1:
start = zero;
elementCount = numValues[0];
@@ -4349,22 +4256,22 @@ Tcl_LseqObjCmd(
step = one;
break;
/* range n n */
/* lseq n n */
case 11:
start = numValues[0];
end = numValues[1];
break;
/* range n n n */
/* lseq n n n */
case 111:
start = numValues[0];
end = numValues[1];
step = numValues[2];
break;
/* range n 'to' n */
/* range n 'count' n */
/* range n 'by' n */
/* lseq n 'to' n */
/* lseq n 'count' n */
/* lseq n 'by' n */
case 121:
opmode = (SequenceOperators)values[1];
switch (opmode) {
@@ -4384,13 +4291,12 @@ Tcl_LseqObjCmd(
step = one;
break;
default:
status = TCL_ERROR;
goto done;
}
break;
/* range n 'to' n n */
/* range n 'count' n n */
/* lseq n 'to' n n */
/* lseq n 'count' n n */
case 1211:
opmode = (SequenceOperators)values[1];
switch (opmode) {
@@ -4407,17 +4313,15 @@ Tcl_LseqObjCmd(
break;
case LSEQ_BY:
/* Error case */
status = TCL_ERROR;
goto done;
break;
default:
status = TCL_ERROR;
goto done;
break;
}
break;
/* range n n 'by' n */
/* lseq n n 'by' n */
case 1121:
start = numValues[0];
end = numValues[1];
@@ -4430,14 +4334,13 @@ Tcl_LseqObjCmd(
case LSEQ_TO:
case LSEQ_COUNT:
default:
status = TCL_ERROR;
goto done;
break;
}
break;
/* range n 'to' n 'by' n */
/* range n 'count' n 'by' n */
/* lseq n 'to' n 'by' n */
/* lseq n 'count' n 'by' n */
case 12121:
start = numValues[0];
opmode = (SequenceOperators)values[3];
@@ -4446,7 +4349,6 @@ Tcl_LseqObjCmd(
step = numValues[4];
break;
default:
status = TCL_ERROR;
goto done;
break;
}
@@ -4462,7 +4364,6 @@ Tcl_LseqObjCmd(
elementCount = numValues[2];
break;
default:
status = TCL_ERROR;
goto done;
break;
}
@@ -4476,7 +4377,6 @@ Tcl_LseqObjCmd(
case 1212:
opmode = (SequenceOperators)values[3]; goto KeywordError; break;
KeywordError:
status = TCL_ERROR;
switch (opmode) {
case LSEQ_DOTS:
case LSEQ_TO:
@@ -4492,14 +4392,12 @@ Tcl_LseqObjCmd(
"missing \"by\" value."));
break;
}
status = TCL_ERROR;
goto done;
break;
/* All other argument errors */
default:
Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??");
status = TCL_ERROR;
goto done;
break;
}
@@ -4527,6 +4425,99 @@ Tcl_LseqObjCmd(
return status;
}
/*
*----------------------------------------------------------------------
*
* Tcl_LsetObjCmd --
*
* This procedure is invoked to process the "lset" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
int
Tcl_LsetObjCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tcl_Obj *listPtr; /* Pointer to the list being altered. */
Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */
/*
* Check parameter count.
*/
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"listVar ?index? ?index ...? value");
return TCL_ERROR;
}
/*
* Look up the list variable's value.
*/
listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* Substitute the value in the value. Return either the value or else an
* unshared copy of it.
*/
if (objc == 4) {
finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
} else {
if (TclObjTypeHasProc(listPtr, setElementProc)) {
finalValuePtr = TclObjTypeSetElement(interp, listPtr,
objc-3, objv+2, objv[objc-1]);
if (finalValuePtr) {
Tcl_IncrRefCount(finalValuePtr);
}
} else {
finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
objv[objc-1]);
}
}
/*
* If substitution has failed, bail out.
*/
if (finalValuePtr == NULL) {
return TCL_ERROR;
}
/*
* Finally, update the variable so that traces fire.
*/
listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(finalValuePtr);
if (listPtr == NULL) {
return TCL_ERROR;
}
/*
* Return the new value of the variable as the interpreter result.
*/
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -4554,8 +4545,8 @@ Tcl_LsortObjCmd(
int indices, nocase = 0, indexc;
int sortMode = SORTMODE_ASCII;
int group, allocatedIndexVector = 0;
Tcl_Size j, idx, groupSize, groupOffset, length;
Tcl_WideInt wide;
Tcl_Size j, idx, groupOffset, length;
Tcl_WideInt wide, groupSize;
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
Tcl_Size i, elmArrSize;
SortElement *elementArray = NULL, *elementPtr;
@@ -4771,7 +4762,7 @@ Tcl_LsortObjCmd(
* 1675116]
*/
listObj = TclDuplicatePureObj(interp ,listObj, &tclListType.objType);
listObj = TclListObjCopy(interp, listObj);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -4796,9 +4787,9 @@ Tcl_LsortObjCmd(
sortInfo.compareCmdPtr = newCommandPtr;
}
if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
sortInfo.resultCode = TclArithSeriesGetElements(interp,
listObj, &length, &listObjPtrs);
if (TclObjTypeHasProc(objv[1], getElementsProc)) {
sortInfo.resultCode =
TclObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
} else {
sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
&length, &listObjPtrs);
@@ -5127,10 +5118,7 @@ Tcl_LeditObjCmd(
}
if (Tcl_IsShared(listPtr)) {
listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
if (!listPtr) {
return TCL_ERROR;
}
listPtr = TclListObjCopy(NULL, listPtr);
createdNewObj = 1;
} else {
createdNewObj = 0;
@@ -5547,7 +5535,7 @@ SelectObjFromSublist(
for (i=0 ; i<infoPtr->indexc ; i++) {
Tcl_Size listLen;
int index;
Tcl_Obj *currentObj;
Tcl_Obj *currentObj, *lastObj=NULL;
if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
@@ -5578,6 +5566,8 @@ SelectObjFromSublist(
return NULL;
}
objPtr = currentObj;
Tcl_BounceRefCount(lastObj);
lastObj = currentObj;
}
return objPtr;
}
+17 -46
View File
@@ -1192,6 +1192,11 @@ Tcl_SplitObjCmd(
return TCL_ERROR;
}
if (splitCharLen == 0) {
Tcl_SetObjResult(interp, TclNewStringListObj(interp, objv[1]));
return TCL_OK;
}
stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
end = stringPtr + stringLen;
TclNewObj(listPtr);
@@ -1200,40 +1205,6 @@ Tcl_SplitObjCmd(
/*
* Do nothing.
*/
} else if (splitCharLen == 0) {
Tcl_HashTable charReuseTable;
Tcl_HashEntry *hPtr;
int isNew;
/*
* Handle the special case of splitting on every character.
*
* Uses a hash table to ensure that each kind of character has only
* one Tcl_Obj instance (multiply-referenced) in the final list. This
* is a *major* win when splitting on a long string (especially in the
* megabyte range!) - DKF
*/
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; stringPtr < end; stringPtr += len) {
len = TclUtfToUCS4(stringPtr, &ch);
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
if (isNew) {
TclNewStringObj(objPtr, stringPtr, len);
/*
* Don't need to fiddle with refcount...
*/
Tcl_SetHashValue(hPtr, objPtr);
} else {
objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
}
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
}
Tcl_DeleteHashTable(&charReuseTable);
} else if (splitCharLen == 1) {
const char *p;
@@ -1612,7 +1583,7 @@ StringIsCmd(
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
if (!TclHasInternalRep(objPtr, &tclBooleanType.objType)
if (!TclHasInternalRep(objPtr, &tclBooleanType)
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
if (strict) {
result = 0;
@@ -1681,9 +1652,9 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
if (TclHasInternalRep(objPtr, &tclDoubleType.objType) ||
TclHasInternalRep(objPtr, &tclIntType.objType) ||
TclHasInternalRep(objPtr, &tclBignumType.objType)) {
if (TclHasInternalRep(objPtr, &tclDoubleType) ||
TclHasInternalRep(objPtr, &tclIntType) ||
TclHasInternalRep(objPtr, &tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1712,8 +1683,8 @@ StringIsCmd(
break;
case STR_IS_INT:
case STR_IS_ENTIER:
if (TclHasInternalRep(objPtr, &tclIntType.objType) ||
TclHasInternalRep(objPtr, &tclBignumType.objType)) {
if (TclHasInternalRep(objPtr, &tclIntType) ||
TclHasInternalRep(objPtr, &tclBignumType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -3848,7 +3819,7 @@ TclNRSwitchObjCmd(
if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
int bline = ctxPtr->line[bidx];
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->nline = objc;
TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
@@ -3862,7 +3833,7 @@ TclNRSwitchObjCmd(
int k;
ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
ctxPtr->nline = objc;
for (k=0; k < objc; k++) {
ctxPtr->line[k] = -1;
@@ -5302,17 +5273,17 @@ TclListLines(
* structure. Assumed to be valid. Assumed to
* contain n elements. */
Tcl_Size line, /* Line the list as a whole starts on. */
int n, /* #elements in lines */
int *lines, /* Array of line numbers, to fill. */
Tcl_Size n, /* #elements in lines */
Tcl_Size *lines, /* Array of line numbers, to fill. */
Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of
* derived continuation data */
{
const char *listStr = TclGetString(listObj);
const char *listHead = listStr;
int i, length = strlen(listStr);
Tcl_Size i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
Tcl_Size *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
+16 -16
View File
@@ -41,12 +41,12 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp,
CompileEnv *envPtr);
static void IssueSwitchChainedTests(Tcl_Interp *interp,
CompileEnv *envPtr, int mode, int noCase,
int numWords, Tcl_Token **bodyToken,
int *bodyLines, int **bodyNext);
Tcl_Size numWords, Tcl_Token **bodyToken,
Tcl_Size *bodyLines, Tcl_Size **bodyNext);
static void IssueSwitchJumpTable(Tcl_Interp *interp,
CompileEnv *envPtr, int numWords,
Tcl_Token **bodyToken, int *bodyLines,
int **bodyContLines);
Tcl_Token **bodyToken, Tcl_Size *bodyLines,
Tcl_Size **bodyContLines);
static int IssueTryClausesInstructions(Tcl_Interp *interp,
CompileEnv *envPtr, Tcl_Token *bodyToken,
int numHandlers, int *matchCodes,
@@ -1800,14 +1800,14 @@ TclCompileSwitchCmd(
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
Tcl_Size *bodyLines; /* Array of line numbers for body list
* items. */
int **bodyContLines; /* Array of continuation line info. */
Tcl_Size **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
int *clNext = envPtr->clNext;
Tcl_Size *clNext = envPtr->clNext;
/*
* Only handle the following versions:
@@ -1964,8 +1964,8 @@ TclCompileSwitchCmd(
}
bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen);
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen);
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * maxLen);
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * maxLen);
bline = mapPtr->loc[eclIndex].line[valueIndex+1];
numWords = 0;
@@ -2025,8 +2025,8 @@ TclCompileSwitchCmd(
*/
bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords);
bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords);
bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * numWords);
bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * numWords);
bodyTokenArray = NULL;
for (i=0 ; i<numWords ; i++) {
/*
@@ -2116,13 +2116,13 @@ IssueSwitchChainedTests(
CompileEnv *envPtr, /* Holds resulting instructions. */
int mode, /* Exact, Glob or Regexp */
int noCase, /* Case-insensitivity flag. */
int numBodyTokens, /* Number of tokens describing things the
Tcl_Size numBodyTokens, /* Number of tokens describing things the
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
int *bodyLines, /* Array of line numbers for body list
Tcl_Size *bodyLines, /* Array of line numbers for body list
* items. */
int **bodyContLines) /* Array of continuation line info. */
Tcl_Size **bodyContLines) /* Array of continuation line info. */
{
enum {Switch_Exact, Switch_Glob, Switch_Regexp};
int foundDefault; /* Flag to indicate whether a "default" clause
@@ -2368,9 +2368,9 @@ IssueSwitchJumpTable(
* switch can match against and bodies to
* execute when the match succeeds. */
Tcl_Token **bodyToken, /* Array of pointers to pattern list items. */
int *bodyLines, /* Array of line numbers for body list
Tcl_Size *bodyLines, /* Array of line numbers for body list
* items. */
int **bodyContLines) /* Array of continuation line info. */
Tcl_Size **bodyContLines) /* Array of continuation line info. */
{
JumptableInfo *jtPtr;
int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
+1 -1
View File
@@ -2111,7 +2111,7 @@ ParseLexeme(
* Example: Inf + luence + () becomes a valid function call.
* [Bug 3401704]
*/
if (TclHasInternalRep(literal, &tclDoubleType.objType)) {
if (TclHasInternalRep(literal, &tclDoubleType)) {
const char *p = start;
while (p < end) {
+25 -22
View File
@@ -701,7 +701,8 @@ static void StartExpanding(CompileEnv *envPtr);
*/
static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset,
Tcl_Token *tokenPtr, const char *cmd,
Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines,
Tcl_Size numWords, Tcl_Size line,
Tcl_Size *clNext, Tcl_Size **lines,
CompileEnv *envPtr);
static void ReleaseCmdWordData(ExtCmdLoc *eclPtr);
@@ -1953,7 +1954,8 @@ CompileCmdCompileProc(
CompileEnv *envPtr)
{
DefineLineInformation;
int unwind = 0, incrOffset = -1;
int unwind = 0;
Tcl_Size incrOffset = -1;
int depth = TclGetStackDepth(envPtr);
/*
@@ -2040,11 +2042,11 @@ CompileCommandTokens(
Command *cmdPtr = NULL;
int code = TCL_ERROR;
int cmdKnown, expand = -1;
int *wlines, wlineat;
int cmdLine = envPtr->line;
int *clNext = envPtr->clNext;
int cmdIdx = envPtr->numCommands;
int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
Tcl_Size *wlines, wlineat;
Tcl_Size cmdLine = envPtr->line;
Tcl_Size *clNext = envPtr->clNext;
Tcl_Size cmdIdx = envPtr->numCommands;
Tcl_Size startCodeOffset = envPtr->codeNext - envPtr->codeStart;
int depth = TclGetStackDepth(envPtr);
assert ((int)parsePtr->numWords > 0);
@@ -2194,7 +2196,7 @@ TclCompileScript(
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
"d exceeds max permitted length %d.",
numBytes, (int)INT_MAX-1));
numBytes, INT_MAX-1));
Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
TclCompileSyntaxError(interp, envPtr);
return;
@@ -2421,19 +2423,20 @@ TclCompileTokens(
Tcl_Interp *interp, /* Used for error and status reporting. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* compile. */
size_t count1, /* Number of tokens to consider at tokenPtr.
size_t count1, /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[4] = "";
int i, numObjsToConcat, adjust;
Tcl_Size i, numObjsToConcat, adjust;
size_t length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
int isLiteral;
Tcl_Size maxNumCL, numCL;
Tcl_Size *clPosition = NULL;
int depth = TclGetStackDepth(envPtr);
int count = count1;
@@ -2463,7 +2466,7 @@ TclCompileTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
}
adjust = 0;
@@ -2503,8 +2506,8 @@ TclCompileTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = (int *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(int));
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(Tcl_Size));
}
clPosition[numCL] = clPos;
numCL ++;
@@ -3330,14 +3333,14 @@ EnterCmdWordData(
const char *cmd,
Tcl_Size numWords,
Tcl_Size line,
int *clNext,
int **wlines,
Tcl_Size *clNext,
Tcl_Size **wlines,
CompileEnv *envPtr)
{
ECL *ePtr;
const char *last;
Tcl_Size wordIdx, wordLine;
int *wwlines, *wordNext;
Tcl_Size *wwlines, *wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
@@ -3356,10 +3359,10 @@ EnterCmdWordData(
ePtr = &eclPtr->loc[eclPtr->nuloc];
ePtr->srcOffset = srcOffset;
ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int));
ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *));
ePtr->line = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
ePtr->next = (Tcl_Size **)Tcl_Alloc(numWords * sizeof(Tcl_Size *));
ePtr->nline = numWords;
wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));
wwlines = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
last = cmd;
wordLine = line;
@@ -3372,7 +3375,7 @@ EnterCmdWordData(
/* See Ticket 4b61afd660 */
wwlines[wordIdx] =
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
? (int)wordLine : -1;
? wordLine : -1;
ePtr->line[wordIdx] = wordLine;
ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
+4 -4
View File
@@ -183,16 +183,16 @@ typedef struct {
typedef struct {
Tcl_Size srcOffset; /* Command location to find the entry. */
Tcl_Size nline; /* Number of words in the command */
int *line; /* Line information for all words in the
Tcl_Size *line; /* Line information for all words in the
* command. */
int **next; /* Transient information used by the compiler
Tcl_Size **next; /* Transient information used by the compiler
* for tracking of hidden continuation
* lines. */
} ECL;
typedef struct {
int type; /* Context type. */
int start; /* Starting line for compiled script. Needed
Tcl_Size start; /* Starting line for compiled script. Needed
* for the extended recompile check in
* tclCompileObj. */
Tcl_Obj *path; /* Path of the sourced file the command is
@@ -392,7 +392,7 @@ typedef struct CompileEnv {
* encountered that have not yet been paired
* with a corresponding
* INST_INVOKE_EXPANDED. */
int *clNext; /* If not NULL, it refers to the next slot in
Tcl_Size *clNext; /* If not NULL, it refers to the next slot in
* clLoc to check for an invisible
* continuation line. */
} CompileEnv;
+13 -8
View File
@@ -4073,10 +4073,6 @@ extern const TclStubs *tclStubsPtr;
tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif
#else
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
@@ -4086,10 +4082,10 @@ extern const TclStubs *tclStubsPtr;
#define Tcl_GetBoolean(interp, src, boolPtr) \
((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetStringFromObj(objPtr, (sizePtr)) : \
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#if defined(TCL_NO_DEPRECATED)
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
#else
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
@@ -4098,6 +4094,15 @@ extern const TclStubs *tclStubsPtr;
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetStringFromObj(objPtr, (sizePtr)) : \
(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
(sizeof(*(sizePtr)) <= sizeof(int) ? \
TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
#endif
#endif
#ifdef TCL_MEM_DEBUG
+172 -6
View File
@@ -61,6 +61,8 @@ static Tcl_ObjCmdProc DictForNRCmd;
static Tcl_ObjCmdProc DictMapNRCmd;
static Tcl_NRPostProc DictForLoopCallback;
static Tcl_NRPostProc DictMapLoopCallback;
static Tcl_ObjTypeLengthProc DictAsListLength;
/* static Tcl_ObjTypeIndexProc DictAsListIndex; Needs rewrite */
/*
* Table of dict subcommand names and implementations.
@@ -143,11 +145,22 @@ typedef struct Dict {
const Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0
FreeDictInternalRep, /* freeIntRepProc */
DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V2( /* Extended type for AbstractLists */
DictAsListLength, /* return "list" length of dict value w/o
* shimmering */
NULL, /* return key or value at "list" index
* location. (keysare at even indicies,
* values at odd indicies) */
NULL,
NULL,
NULL,
NULL,
NULL,
NULL)
};
#define DictSetInternalRep(objPtr, dictRepPtr) \
@@ -603,7 +616,7 @@ SetDictFromAny(
* the conversion from lists to dictionaries.
*/
if (TclHasInternalRep(objPtr, &tclListType.objType)) {
if (TclHasInternalRep(objPtr, &tclListType)) {
Tcl_Size objc, i;
Tcl_Obj **objv;
@@ -3788,6 +3801,159 @@ TclInitDictCmd(
return TclMakeEnsemble(interp, "dict", implementationMap);
}
/*
*----------------------------------------------------------------------
*
* DictAsListLength --
*
* Compute the length of a list as if the dict value were converted to a
* list.
*
* Note: the list length may not match the dict size * 2. This occurs when
* there are duplicate keys in the original string representation.
*
* Side Effects --
*
* The intent is to have no side effects.
*/
static Tcl_Size
DictAsListLength(
Tcl_Obj *objPtr)
{
Tcl_Size estCount, length, llen;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Obj *elemPtr;
/*
* Allocate enough space to hold a (Tcl_Obj *) for each
* (possible) list element.
*/
estCount = TclMaxListLength(nextElem, length, &limit);
estCount += (estCount == 0); /* Smallest list struct holds 1
* element. */
elemPtr = Tcl_NewObj();
llen = 0;
while (nextElem < limit) {
const char *elemStart;
char *check;
Tcl_Size elemSize;
int literal;
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (elemStart == limit) {
break;
}
TclInvalidateStringRep(elemPtr);
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
elemSize);
if (elemSize && check == NULL) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (!literal) {
Tcl_InitStringRep(elemPtr, NULL,
TclCopyAndCollapse(elemSize, elemStart, check));
}
llen++;
}
Tcl_DecrRefCount(elemPtr);
return llen;
}
/*
*----------------------------------------------------------------------
*
* DictAsListIndex --
*
* Return the key or value at the given "list" index, i.e., as if the string
* value where treated as a list. The intent is to support this list
* operation w/o causing the Obj value to shimmer into a List.
*
* Side Effects --
*
* The intent is to have no side effects.
*
*/
#if 0 /* Needs rewrite */
static int
DictAsListIndex(
Tcl_Interp *interp,
struct Tcl_Obj *objPtr,
Tcl_Size index,
Tcl_Obj** elemObjPtr)
{
Tcl_Size /*estCount,*/ length, llen;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
Tcl_Obj *elemPtr;
/*
* Compute limit of the list string
*/
TclMaxListLength(nextElem, length, &limit);
elemPtr = Tcl_NewObj();
llen = 0;
/*
* parse out each element until reaching the "index"th element.
* Sure this is slow, but shimmering is slower.
*/
while (nextElem < limit) {
const char *elemStart;
char *check;
Tcl_Size elemSize;
int literal;
if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
Tcl_DecrRefCount(elemPtr);
return 0;
}
if (elemStart == limit) {
break;
}
TclInvalidateStringRep(elemPtr);
check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
elemSize);
if (elemSize && check == NULL) {
Tcl_DecrRefCount(elemPtr);
if (interp) {
// Need error message here
}
return TCL_ERROR;
}
if (!literal) {
Tcl_InitStringRep(elemPtr, NULL,
TclCopyAndCollapse(elemSize, elemStart, check));
}
if (llen == index) {
*elemObjPtr = elemPtr;
return TCL_OK;
}
llen++;
}
/*
* Index is beyond end of list - return empty
*/
Tcl_InitStringRep(elemPtr, NULL, 0);
*elemObjPtr = elemPtr;
return TCL_OK;
}
#endif
/*
* Local Variables:
* mode: c
+23 -22
View File
@@ -256,7 +256,8 @@ DisassembleByteCodeObj(
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
Tcl_Size i;
Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
@@ -278,7 +279,7 @@ DisassembleByteCodeObj(
*/
Tcl_AppendPrintfToObj(bufferObj,
"ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
"ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n",
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
@@ -289,7 +290,7 @@ DisassembleByteCodeObj(
TclGetString(fileObj), line);
}
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
"\n Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n",
numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
codePtr->numLitObjects, codePtr->numAuxDataItems,
codePtr->maxStackDepth,
@@ -301,8 +302,8 @@ DisassembleByteCodeObj(
#ifdef TCL_COMPILE_STATS
Tcl_AppendPrintfToObj(bufferObj,
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
" Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %"
TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n",
codePtr->structureSize,
offsetof(ByteCode, localCachePtr),
codePtr->numCodeBytes,
@@ -320,10 +321,10 @@ DisassembleByteCodeObj(
if (codePtr->procPtr != NULL) {
Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;
Tcl_AppendPrintfToObj(bufferObj,
" Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
" Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n",
procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
@@ -331,7 +332,7 @@ DisassembleByteCodeObj(
for (i = 0; i < numCompiledLocals; i++) {
Tcl_AppendPrintfToObj(bufferObj,
" slot %d%s%s%s%s%s%s", i,
" slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i,
(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
(localPtr->flags & VAR_ARRAY) ? ", array" : "",
(localPtr->flags & VAR_LINK) ? ", link" : "",
@@ -354,24 +355,24 @@ DisassembleByteCodeObj(
*/
if ((int)codePtr->numExceptRanges > 0) {
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n",
codePtr->numExceptRanges, codePtr->maxExceptDepth);
for (i = 0; i < (int)codePtr->numExceptRanges; i++) {
ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
Tcl_AppendPrintfToObj(bufferObj,
" %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
" %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ",
i, rangePtr->nestingLevel,
(rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
rangePtr->codeOffset,
(rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n",
rangePtr->continueOffset, rangePtr->breakOffset);
break;
case CATCH_EXCEPTION_RANGE:
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n",
rangePtr->catchOffset);
break;
default:
@@ -445,7 +446,7 @@ DisassembleByteCodeObj(
srcLengthNext++;
}
Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d",
((i % 2)? " " : "\n "),
(i+1), codeOffset, (codeOffset + codeLen - 1),
srcOffset, (srcOffset + srcLen - 1));
@@ -504,7 +505,7 @@ DisassembleByteCodeObj(
pc += FormatInstruction(codePtr, pc, bufferObj);
}
Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1);
Tcl_AppendPrintfToObj(bufferObj, " Command %" TCL_SIZE_MODIFIER "u: ", i+1);
PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
TclMin(srcLen, 55));
Tcl_AppendToObj(bufferObj, "\n", -1);
@@ -544,7 +545,7 @@ FormatInstruction(
unsigned char *codeStart = codePtr->codeStart;
unsigned pcOffset = pc - codeStart;
int opnd = 0, i, j, numBytes = 1;
int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
Tcl_Size localCt = procPtr ? procPtr->numCompiledLocals : 0;
CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
char suffixBuffer[128]; /* Additional info to print after main opcode
* and immediates. */
@@ -625,7 +626,7 @@ FormatInstruction(
printLVTindex:
if (localPtr != NULL) {
if (opnd >= localCt) {
Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)",
opnd, localCt);
}
for (j = 0; j < opnd; j++) {
@@ -943,8 +944,8 @@ DisassembleByteCodeAsDicts(
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
int codeOffset, codeLength, sourceOffset, sourceLength, val, line;
Tcl_Size i;
ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
@@ -953,7 +954,7 @@ DisassembleByteCodeAsDicts(
*/
TclNewObj(literals);
for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
for (i=0 ; i<codePtr->numLitObjects ; i++) {
Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
}
@@ -963,7 +964,7 @@ DisassembleByteCodeAsDicts(
TclNewObj(variables);
if (codePtr->procPtr) {
int localCount = codePtr->procPtr->numCompiledLocals;
Tcl_Size localCount = codePtr->procPtr->numCompiledLocals;
CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
@@ -1146,14 +1147,14 @@ DisassembleByteCodeAsDicts(
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u",
"loop", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->breakOffset, rangePtr->continueOffset));
break;
case CATCH_EXCEPTION_RANGE:
Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
"type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
"type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u",
"catch", rangePtr->nestingLevel, rangePtr->codeOffset,
rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
rangePtr->catchOffset));
+33 -24
View File
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
#include <assert.h>
typedef size_t (LengthProc)(const char *src);
@@ -185,6 +186,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;
Tcl_Encoding tclUtf8Encoding = NULL;
/*
* Names of encoding profiles and corresponding integer values.
@@ -571,8 +573,8 @@ TclInitEncodingSubsystem(void)
unsigned size;
unsigned short i;
union {
char c;
short s;
char c;
short s;
} isLe;
int leFlags;
@@ -608,7 +610,7 @@ TclInitEncodingSubsystem(void)
type.freeProc = NULL;
type.nullSize = 1;
type.clientData = INT2PTR(ENCODING_UTF);
Tcl_CreateEncoding(&type);
tclUtf8Encoding = Tcl_CreateEncoding(&type);
type.clientData = NULL;
type.encodingName = "cesu-8";
Tcl_CreateEncoding(&type);
@@ -730,6 +732,8 @@ TclFinalizeEncodingSubsystem(void)
defaultEncoding = NULL;
FreeEncoding(tclIdentityEncoding);
tclIdentityEncoding = NULL;
FreeEncoding(tclUtf8Encoding);
tclUtf8Encoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
@@ -1234,6 +1238,7 @@ Tcl_ExternalToUtfDStringEx(
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
errno = EINVAL;
return TCL_ERROR;
}
@@ -1298,17 +1303,20 @@ Tcl_ExternalToUtfDStringEx(
/* Caller wants error message on failure */
if (result != TCL_OK && interp != NULL) {
char buf[TCL_INTEGER_SPACE];
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
Tcl_SetObjResult(
interp,
Tcl_ObjPrintf("unexpected byte sequence starting at index %"
TCL_Z_MODIFIER "u: '\\x%02X'",
TCL_SIZE_MODIFIER "u: '\\x%02X'",
nBytesProcessed,
UCHAR(srcStart[nBytesProcessed])));
Tcl_SetErrorCode(
interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL);
}
}
if (result != TCL_OK) {
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
}
return result;
}
@@ -1499,7 +1507,7 @@ Tcl_UtfToExternalDString(
* The parameter flags controls the behavior, if any of the bytes in
* the source buffer are invalid or cannot be represented in the
* target encoding. It should be composed by OR-ing the following:
* - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
* - *At most one* of TCL_ENCODING_PROFILE_*
* - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
* to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
*
@@ -1562,6 +1570,7 @@ Tcl_UtfToExternalDStringEx(
"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
errno = EINVAL;
return TCL_ERROR;
}
@@ -1629,11 +1638,11 @@ Tcl_UtfToExternalDStringEx(
int ucs4;
char buf[TCL_INTEGER_SPACE];
TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
Tcl_SetObjResult(
interp,
Tcl_ObjPrintf(
"unexpected character at index %" TCL_Z_MODIFIER
"unexpected character at index %" TCL_SIZE_MODIFIER
"u: 'U+%06X'",
pos,
ucs4));
@@ -1641,6 +1650,9 @@ Tcl_UtfToExternalDStringEx(
buf, NULL);
}
}
if (result != TCL_OK) {
errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
}
return result;
}
@@ -3222,7 +3234,7 @@ UtfToUtf16Proc(
}
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
dstEnd = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
flags |= PTR2INT(clientData);
result = TCL_OK;
@@ -3332,7 +3344,7 @@ UtfToUcs2Proc(
}
dstStart = dst;
dstEnd = dst + dstLen - sizeof(Tcl_UniChar);
dstEnd = dst + dstLen - 2; /* 2 - size of UCS code unit */
result = TCL_OK;
for (numChars = 0; src < srcEnd; numChars++) {
@@ -3476,30 +3488,28 @@ TableToUtfProc(
}
byte = *((unsigned char *) src);
if (prefixBytes[byte]) {
src++;
if (src >= srcEnd) {
if (src >= srcEnd-1) {
/* Prefix byte but nothing after it */
if (!(flags & TCL_ENCODING_END)) {
src--;
/* More data to come */
result = TCL_CONVERT_MULTIBYTE;
break;
} else if (PROFILE_STRICT(flags)) {
src--;
result = TCL_CONVERT_SYNTAX;
break;
} else if (PROFILE_REPLACE(flags)) {
ch = UNICODE_REPLACE_CHAR;
} else {
src--; /* See bug [bdcb5126c0] */
result = TCL_CONVERT_MULTIBYTE;
break;
ch = (Tcl_UniChar)byte;
}
} else {
ch = toUnicode[byte][*((unsigned char *)src)];
ch = toUnicode[byte][*((unsigned char *)++src)];
}
} else {
ch = pageZero[byte];
}
if ((ch == 0) && (byte != 0)) {
/* Prefix+suffix pair is invalid */
if (PROFILE_STRICT(flags)) {
result = TCL_CONVERT_SYNTAX;
break;
@@ -3526,6 +3536,7 @@ TableToUtfProc(
src++;
}
assert(src <= srcEnd);
*srcReadPtr = src - srcStart;
*dstWrotePtr = dst - dstStart;
*dstCharsPtr = numChars;
@@ -4058,12 +4069,10 @@ EscapeToUtfProc(
if ((checked == dataPtr->numSubTables + 2)
|| (flags & TCL_ENCODING_END)) {
if (!PROFILE_STRICT(flags)) {
/*
* Skip the unknown escape sequence. TODO - bug?
* May be replace with UNICODE_REPLACE_CHAR?
*/
src += longest;
unsigned skip = longest > left ? left : longest;
/* Unknown escape sequence */
dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
src += skip;
continue;
}
result = TCL_CONVERT_SYNTAX;
+10 -39
View File
@@ -312,17 +312,7 @@ TclNamespaceEnsembleCmd(
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
if (patchedDict == NULL) {
patchedDict = TclDuplicatePureObj(
interp, objv[1], &tclDictType);
if (!patchedDict) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
}
Tcl_DecrRefCount(newList);
Tcl_DecrRefCount(newCmd);
Tcl_DecrRefCount(patchedDict);
return TCL_ERROR;
}
patchedDict = Tcl_DuplicateObj(objv[1]);
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
@@ -606,14 +596,7 @@ TclNamespaceEnsembleCmd(
}
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
Tcl_Obj *newList = TclDuplicatePureObj(
interp, listObj, &tclListType.objType);
if (!newList) {
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
}
goto freeMapAndError;
}
Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
if (nsPtr->parentPtr) {
@@ -623,11 +606,7 @@ TclNamespaceEnsembleCmd(
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
&newCmd);
if (patchedDict == NULL) {
patchedDict = TclDuplicatePureObj(
interp, objv[1], &tclListType.objType);
if (!patchedDict) {
goto freeMapAndError;
}
patchedDict = Tcl_DuplicateObj(objv[1]);
}
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
@@ -1925,11 +1904,7 @@ NsEnsembleImplementationCmdNR(
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclDuplicatePureObj(
interp, prefixObj, &tclListType.objType);
if (!copyPtr) {
return TCL_ERROR;
}
copyPtr = TclListObjCopy(NULL, prefixObj);
} else {
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
@@ -2329,11 +2304,7 @@ EnsembleUnknownCallback(
* Create the "unknown" command callback to determine what to do.
*/
unknownCmd = TclDuplicatePureObj(
interp, ensemblePtr->unknownHandler, &tclListType.objType);
if (!unknownCmd) {
return TCL_ERROR;
}
unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
TclNewObj(ensObj);
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
@@ -3293,7 +3264,7 @@ TclAttemptCompileProc(
Tcl_Size i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
Tcl_Size savedStackDepth = envPtr->currStackDepth;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
Tcl_Size savedCodeNext = envPtr->codeNext - envPtr->codeStart;
Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
@@ -3356,13 +3327,13 @@ TclAttemptCompileProc(
ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
for (i = 0; i < savedExceptArrayNext; i++) {
while ((int)auxPtr->numBreakTargets > 0
&& auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
while (auxPtr->numBreakTargets > 0
&& (Tcl_Size) auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
>= savedCodeNext) {
auxPtr->numBreakTargets--;
}
while ((int)auxPtr->numContinueTargets > 0
&& auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
while (auxPtr->numContinueTargets > 0
&& (Tcl_Size) auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
>= savedCodeNext) {
auxPtr->numContinueTargets--;
}
+43 -27
View File
@@ -19,20 +19,20 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
#if defined(_WIN32)
# define tenviron _wenviron
# define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
# define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
(const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
# define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
# define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
(const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
# define techar WCHAR
# ifdef USE_PUTENV
# define putenv(env) _wputenv((const wchar_t *)env)
# endif
#else
# define tenviron environ
# define tenviron2utfdstr(tenvstr, len, dstr) \
Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
# define utf2tenvirondstr(str, len, dstr) \
Tcl_UtfToExternalDString(NULL, str, len, dstr)
# define tenviron2utfdstr(str, dsPtr) \
Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
# define utf2tenvirondstr(str, dsPtr) \
Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
# define techar char
#endif
@@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment
* (if changed with tcl-env). */
static struct {
size_t cacheSize; /* Number of env strings in cache. */
Tcl_Size cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
* strings that Tcl has allocated. */
#ifndef USE_PUTENV
@@ -159,7 +159,11 @@ TclSetupEnv(
const char *p1;
char *p2;
p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
p1 = tenviron2utfdstr(tenviron[i], &envString);
if (p1 == NULL) {
/* Ignore what cannot be decoded (should not happen) */
continue;
}
p2 = (char *)strchr(p1, '=');
if (p2 == NULL) {
/*
@@ -301,9 +305,9 @@ TclSetEnv(
* interpreters.
*/
oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
if (strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString);
oldEnv = tenviron2utfdstr(tenviron[index], &envString);
if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) {
Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */
Tcl_MutexUnlock(&envMutex);
return;
}
@@ -324,7 +328,13 @@ TclSetEnv(
memcpy(p, name, nameLength);
p[nameLength] = '=';
memcpy(p+nameLength+1, value, valueLength+1);
p2 = utf2tenvirondstr(p, -1, &envString);
p2 = utf2tenvirondstr(p, &envString);
if (p2 == NULL) {
/* No way to signal error from here :-( but should not happen */
Tcl_Free(p);
Tcl_MutexUnlock(&envMutex);
return;
}
/*
* Copy the native string to heap memory.
@@ -502,7 +512,11 @@ TclUnsetEnv(
string[length] = '\0';
#endif /* _WIN32 */
utf2tenvirondstr(string, -1, &envString);
if (utf2tenvirondstr(string, &envString) == NULL) {
/* Should not happen except memory alloc fail. */
Tcl_MutexUnlock(&envMutex);
return;
}
string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
memcpy(string, Tcl_DStringValue(&envString),
Tcl_DStringLength(&envString) + tNTL);
@@ -577,17 +591,19 @@ TclGetEnv(
if (index != -1) {
Tcl_DString envStr;
result = tenviron2utfdstr(tenviron[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
result = tenviron2utfdstr(tenviron[index], &envStr);
if (result) {
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
@@ -703,7 +719,7 @@ ReplaceString(
const char *oldStr, /* Old environment string. */
char *newStr) /* New environment string. */
{
size_t i;
Tcl_Size i;
/*
* Check to see if the old value was allocated by Tcl. If so, it needs to
@@ -782,7 +798,7 @@ TclFinalizeEnvironment(void)
if (env.cache) {
#ifdef PURIFY
size_t i;
Tcl_Size i;
for (i = 0; i < env.cacheSize; i++) {
Tcl_Free(env.cache[i]);
}
+1 -5
View File
@@ -232,11 +232,7 @@ HandleBgErrors(
* support one handler setting another handler.
*/
Tcl_Obj *copyObj = TclDuplicatePureObj(
interp, assocPtr->cmdPrefix, &tclListType.objType);
if (!copyObj) {
return;
}
Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
errPtr = assocPtr->firstBgPtr;
+181 -124
View File
@@ -19,7 +19,6 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
#include "tclArithSeries.h"
#include <math.h>
#include <assert.h>
@@ -451,11 +450,11 @@ VarHashCreateVar(
*/
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
((TclHasInternalRep((objPtr), &tclIntType.objType)) \
((TclHasInternalRep((objPtr), &tclIntType)) \
? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (void *) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
TclHasInternalRep((objPtr), &tclDoubleType.objType) \
TclHasInternalRep((objPtr), &tclDoubleType) \
? (((isnan((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
@@ -635,7 +634,7 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
int searchMode, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
ByteCode *codePtr, Tcl_Size *lengthPtr,
const unsigned char **pcBeg, int *cmdIdxPtr);
const unsigned char **pcBeg, Tcl_Size *cmdIdxPtr);
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
@@ -674,7 +673,8 @@ static const Tcl_ObjType exprCodeType = {
static const Tcl_ObjType dictIteratorType = {
"dictIterator",
ReleaseDictIterator,
NULL, NULL, NULL, TCL_OBJTYPE_V0
NULL, NULL, NULL,
TCL_OBJTYPE_V0
};
/*
@@ -1850,7 +1850,7 @@ ArgumentBCEnter(
int objc,
Tcl_Obj **objv)
{
int cmd;
Tcl_Size cmd;
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
@@ -2598,13 +2598,16 @@ TEBCresume(
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
DECACHE_STACK_INFO();
objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
TCL_STRING_IN_PLACE);
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
break;
@@ -3374,12 +3377,7 @@ TEBCresume(
goto gotError;
}
if (Tcl_IsShared(objResultPtr)) {
Tcl_Obj *newValue = TclDuplicatePureObj(
interp, objResultPtr, &tclListType.objType);
if (!newValue) {
TRACE_ERROR(interp);
goto gotError;
}
Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
TclDecrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr = newValue;
@@ -3438,11 +3436,7 @@ TEBCresume(
goto gotError;
} else {
if (Tcl_IsShared(objResultPtr)) {
valueToAssign = TclDuplicatePureObj(
interp, objResultPtr, &tclListType.objType);
if (!valueToAssign) {
goto errorInLappendListPtr;
}
valueToAssign = Tcl_DuplicateObj(objResultPtr);
createdNewObj = 1;
} else {
valueToAssign = objResultPtr;
@@ -4668,21 +4662,25 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
/* special case for ArithSeries */
if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
length = ABSTRACTLIST_PROC(valuePtr, lengthProc)(valuePtr);
/* special case for AbstractList */
if (TclObjTypeHasProc(valuePtr,indexProc)) {
DECACHE_STACK_INFO();
length = TclObjTypeLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
objResultPtr = TclArithSeriesObjIndex(interp, valuePtr, index);
if (objResultPtr == NULL) {
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
if (objResultPtr == NULL) {
/* Index is out of range, return empty result. */
TclNewObj(objResultPtr);
}
Tcl_IncrRefCount(objResultPtr); // reference held here
goto lindexDone;
}
@@ -4696,7 +4694,7 @@ TEBCresume(
Tcl_Obj *indexListPtr = value2Ptr;
if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
&& (
!TclHasInternalRep(value2Ptr, &tclListType.objType)
!TclHasInternalRep(value2Ptr, &tclListType)
||
((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
value2Length == 1
@@ -4754,34 +4752,36 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
/* special case for ArithSeries */
if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
length = ABSTRACTLIST_PROC(valuePtr, lengthProc)(valuePtr);
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, length-1);
/* Compute value @ index */
if (index >= 0 && index < length) {
objResultPtr = TclArithSeriesObjIndex(interp, valuePtr, index);
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
} else {
TclNewObj(objResultPtr);
}
pcAdjustment = 5;
goto lindexFastPath2;
}
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
*/
/* special case for AbstractList */
if (TclObjTypeHasProc(valuePtr,indexProc)) {
length = TclObjTypeLength(valuePtr);
/* Decode end-offset index values. */
index = TclIndexDecode(opnd, length-1);
if (index >= 0 && index < length) {
/* Compute value @ index */
DECACHE_STACK_INFO();
if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
} else {
TclNewObj(objResultPtr);
}
pcAdjustment = 5;
goto lindexFastPath2;
}
/* List case */
if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -4854,9 +4854,17 @@ TEBCresume(
* Compute the new variable value.
*/
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
DECACHE_STACK_INFO();
if (TclObjTypeHasProc(valuePtr, setElementProc)) {
objResultPtr = TclObjTypeSetElement(interp,
valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
} else {
objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
}
if (!objResultPtr) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
@@ -4864,7 +4872,7 @@ TEBCresume(
/*
* Set result.
*/
CACHE_STACK_INFO();
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_V(5, numIndices+1, -1);
@@ -4976,16 +4984,21 @@ TEBCresume(
fromIdx = TclIndexDecode(fromIdx, objc - 1);
if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
DECACHE_STACK_INFO();
if (TclObjTypeHasProc(valuePtr, sliceProc)) {
if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
objResultPtr = NULL;
}
} else {
objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
}
if (objResultPtr == NULL) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -4994,42 +5007,60 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
match = 0;
if (length > 0) {
Tcl_Size i = 0;
Tcl_Obj *o;
int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType.objType);
/*
* An empty list doesn't match anything.
*/
s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
do {
if (isArithSeries) {
o = TclArithSeriesObjIndex(NULL, value2Ptr, i);
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
}
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
if (isArithSeries) {
TclDecrRefCount(o);
}
i++;
} while (i < length && match == 0);
}
if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) {
int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
if (status != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
} else {
if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
match = 0;
if (length > 0) {
Tcl_Size i = 0;
Tcl_Obj *o;
int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
/*
* An empty list doesn't match anything.
*/
do {
if (isAbstractList) {
DECACHE_STACK_INFO();
if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
} else {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
}
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
}
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
/* Could be an ephemeral abstract obj */
Tcl_BounceRefCount(o);
i++;
} while (i < length && match == 0);
}
}
if (*pc == INST_LIST_NOT_IN) {
match = !match;
@@ -5892,7 +5923,7 @@ TEBCresume(
* Quickly force large right shifts to 0 or -1.
*/
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(w1))) {
/*
* We assume that INT_MAX is much larger than the
* number of bits in a long. This is a pretty safe
@@ -5960,9 +5991,9 @@ TEBCresume(
* Handle shifts within the native long range.
*/
if (((size_t)shift < CHAR_BIT*sizeof(long))
if (((size_t)shift < CHAR_BIT*sizeof(w1))
&& !((w1>0 ? w1 : ~w1) &
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
-(1UL<<(CHAR_BIT*sizeof(w1) - 1 - shift)))) {
wResult = (Tcl_WideUInt)w1 << shift;
goto wideResultOfArithmetic;
}
@@ -6368,7 +6399,7 @@ TEBCresume(
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
if (TclHasInternalRep(valuePtr, &tclBooleanType.objType)) {
if (TclHasInternalRep(valuePtr, &tclBooleanType)) {
objResultPtr = TCONST(1);
} else {
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
@@ -6429,17 +6460,15 @@ TEBCresume(
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
DECACHE_STACK_INFO();
if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if (Tcl_IsShared(listPtr)) {
objPtr = TclDuplicatePureObj(
interp, listPtr, &tclListType.objType);
if (!objPtr) {
goto gotError;
}
objPtr = TclListObjCopy(NULL, listPtr);
Tcl_IncrRefCount(objPtr);
Tcl_DecrRefCount(listPtr);
OBJ_AT_DEPTH(listTmpDepth) = objPtr;
@@ -6480,7 +6509,7 @@ TEBCresume(
pc += 5 - infoPtr->loopCtTemp;
case INST_FOREACH_STEP:
case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
/*
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
* the next value list element to each loop var.
@@ -6513,13 +6542,23 @@ TEBCresume(
for (i = 0; i < numLists; i++) {
varListPtr = infoPtr->varLists[i];
numVars = varListPtr->numVars;
int hasAbstractList;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
status = TclListObjGetElementsM(
interp, listPtr, &listLen, &elements);
hasAbstractList = TclObjTypeHasProc(listPtr, indexProc) != 0;
DECACHE_STACK_INFO();
if (hasAbstractList) {
status = Tcl_ListObjLength(interp, listPtr, &listLen);
elements = NULL;
} else {
status = TclListObjGetElementsM(
interp, listPtr, &listLen, &elements);
}
if (status != TCL_OK) {
CACHE_STACK_INFO();
goto gotError;
}
CACHE_STACK_INFO();
valIndex = (iterNum * numVars);
@@ -6527,7 +6566,23 @@ TEBCresume(
if (valIndex >= listLen) {
TclNewObj(valuePtr);
} else {
valuePtr = elements[valIndex];
DECACHE_STACK_INFO();
if (elements) {
valuePtr = elements[valIndex];
} else {
status = Tcl_ListObjIndex(
interp, listPtr, valIndex, &valuePtr);
if (status != TCL_OK) {
/* Could happen for abstract lists */
CACHE_STACK_INFO();
goto gotError;
}
if (valuePtr == NULL) {
/* Permitted for Tcl_LOI to return NULL */
TclNewObj(valuePtr);
}
}
CACHE_STACK_INFO();
}
varIndex = varListPtr->varIndexes[j];
@@ -8398,7 +8453,7 @@ ExecuteExtendedBinaryMathOp(
overflowExpon:
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
|| (value2Ptr->typePtr != &tclIntType.objType)
|| (value2Ptr->typePtr != &tclIntType)
|| (Tcl_WideUInt)w2 >= (1<<28)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
@@ -8958,7 +9013,7 @@ ValidatePcAndStackTop(
}
if (checkStack &&
(stackTop > stackUpperBound)) {
size_t numChars;
Tcl_Size numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
@@ -9108,7 +9163,7 @@ TclGetSrcInfoForPc(
ExtCmdLoc *eclPtr;
ECL *locPtr = NULL;
Tcl_Size srcOffset;
int i;
Tcl_Size i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
@@ -9120,7 +9175,7 @@ TclGetSrcInfoForPc(
srcOffset = cfPtr->cmd - codePtr->source;
eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
for (i=0; i < (int)eclPtr->nuloc; i++) {
for (i=0; i < eclPtr->nuloc; i++) {
if (eclPtr->loc[i].srcOffset == srcOffset) {
locPtr = eclPtr->loc+i;
break;
@@ -9160,7 +9215,7 @@ GetSrcInfoForPc(
const unsigned char **pcBeg,/* If non-NULL, the bytecode location
* where the current instruction starts.
* If NULL; no pointer is stored. */
int *cmdIdxPtr) /* If non-NULL, the location where the index
Tcl_Size *cmdIdxPtr) /* If non-NULL, the location where the index
* of the command containing the pc should
* be stored. */
{
@@ -9169,10 +9224,10 @@ GetSrcInfoForPc(
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
int bestCmdIdx = -1;
Tcl_Size bestDist = TCL_SIZE_MAX; /* Distance of pc to best cmd's start pc. */
Tcl_Size bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
Tcl_Size bestSrcLength = -1; /* Initialized to avoid compiler warning. */
Tcl_Size bestCmdIdx = -1;
/* The pc must point within the bytecode */
assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
@@ -9251,7 +9306,7 @@ GetSrcInfoForPc(
* instructions. Stop when crossing pc; keep previous.
*/
curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
curr = ((bestDist == TCL_SIZE_MAX) ? codePtr->codeStart : pc - bestDist);
prev = curr;
while (curr <= pc) {
prev = curr;
@@ -9260,7 +9315,7 @@ GetSrcInfoForPc(
*pcBeg = prev;
}
if (bestDist == INT_MAX) {
if (bestDist == TCL_SIZE_MAX) {
return NULL;
}
@@ -9498,7 +9553,9 @@ EvalStatsCmd(
double numInstructions, currentHeaderBytes;
size_t numCurrentByteCodes, numByteCodeLits;
size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
Tcl_Size i;
size_t ui;
char *litTableStats;
LiteralEntry *entryPtr;
Tcl_Obj *objPtr;
@@ -9634,7 +9691,7 @@ EvalStatsCmd(
strBytesIfUnshared = 0.0;
strBytesSharedMultX = 0.0;
strBytesSharedOnce = 0.0;
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (ui = 0; ui < globalTablePtr->numBuckets; ui++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
@@ -9752,9 +9809,9 @@ EvalStatsCmd(
}
}
sum = 0;
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
for (ui = 0; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->literalCount[ui];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
}
@@ -9785,9 +9842,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->srcCount[ui];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -9809,9 +9866,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
for (ui = minSizeDecade; ui <= maxSizeDecade; i++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->byteCodeCount[ui];
Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -9833,9 +9890,9 @@ EvalStatsCmd(
}
maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->lifetimeCount[i];
for (ui = minSizeDecade; ui <= maxSizeDecade; ui++) {
decadeHigh = (1 << (ui+1)) - 1;
sum += statsPtr->lifetimeCount[ui];
Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
}
+2 -2
View File
@@ -2339,8 +2339,8 @@ Tcl_AllocStatBuf(void)
* Access functions for Tcl_StatBuf --
*
* These functions provide portable read-only access to the portable
* fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
* stat64' or something else related). [TIP #316]
* fields of the Tcl_StatBuf structure (really a 'struct stat'
* or something else related). [TIP #316]
*
* Results:
* The value from the field being retrieved.
+2 -2
View File
@@ -1681,11 +1681,11 @@ Tcl_CreateChannel(
statePtr->inputEncodingState = NULL;
statePtr->inputEncodingFlags = TCL_ENCODING_START;
ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
TCL_ENCODING_PROFILE_TCL8);
TCL_ENCODING_PROFILE_DEFAULT);
statePtr->outputEncodingState = NULL;
statePtr->outputEncodingFlags = TCL_ENCODING_START;
ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
TCL_ENCODING_PROFILE_TCL8);
TCL_ENCODING_PROFILE_DEFAULT);
/*
* Set the channel up initially in AUTO input translation mode to accept
+1 -5
View File
@@ -379,11 +379,7 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
Tcl_Obj *command = TclDuplicatePureObj(
interp, dataPtr->command, &tclListType.objType);
if (!command) {
return TCL_ERROR;
}
Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
Tcl_Interp *eval = dataPtr->interp;
Tcl_Preserve(eval);
+2 -8
View File
@@ -2261,10 +2261,7 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType.objType);
if (!rcPtr->cmd) {
return NULL;
}
rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
Tcl_IncrRefCount(rcPtr->cmd);
rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
while (mn <= (int)METH_WRITE) {
@@ -2401,10 +2398,7 @@ InvokeTclMethod(
* before the channel id.
*/
cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType.objType);
if (!cmd) {
return TCL_ERROR;
}
cmd = TclListObjCopy(NULL, rcPtr->cmd);
Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
Tcl_ListObjAppendElement(NULL, cmd, methObj);
Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);
+5 -5
View File
@@ -1687,7 +1687,7 @@ Tcl_FSEvalFileEx(
use the utf-8 encoding. */
{
Tcl_Size length;
int result = TCL_ERROR;
int result = TCL_ERROR;
Tcl_StatBuf statBuf;
Tcl_Obj *oldScriptFile;
Interp *iPtr;
@@ -1802,7 +1802,7 @@ Tcl_FSEvalFileEx(
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
unsigned limit = 150;
int overflow = (length > limit);
int overflow = ((unsigned)length > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
@@ -1954,12 +1954,12 @@ EvalFileCallback(
Tcl_Size length;
const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
const unsigned int limit = 150;
int overflow = (length > limit);
const unsigned limit = 150;
int overflow = ((unsigned)length > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
(overflow ? limit : (unsigned int)length), pathString,
(overflow ? limit : (unsigned)length), pathString,
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
+11 -11
View File
@@ -37,7 +37,7 @@ static void PrintUsage(Tcl_Interp *interp,
* that can be invoked by generic object code.
*/
static const Tcl_ObjType indexType = {
const Tcl_ObjType tclIndexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
@@ -213,7 +213,7 @@ Tcl_GetIndexFromObjStruct(
*/
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if ((indexRep->tablePtr == tablePtr)
@@ -282,7 +282,7 @@ Tcl_GetIndexFromObjStruct(
*/
if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
@@ -290,7 +290,7 @@ Tcl_GetIndexFromObjStruct(
indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
@@ -385,7 +385,7 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
const char *indexStr = EXPAND_OF(indexRep);
Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
@@ -417,11 +417,11 @@ DupIndex(
Tcl_ObjInternalRep ir;
IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &tclIndexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
ir.twoPtrValue.ptr1 = dupIndexRep;
Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
Tcl_StoreInternalRep(dupPtr, &tclIndexType, &ir);
}
/*
@@ -445,7 +445,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -865,7 +865,7 @@ Tcl_WrongNumArgs(
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
if ((irPtr = TclFetchInternalRep(origObjv[i], &tclIndexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
@@ -912,7 +912,7 @@ Tcl_WrongNumArgs(
*/
const Tcl_ObjInternalRep *irPtr;
if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
if ((irPtr = TclFetchInternalRep(objv[i], &tclIndexType))) {
IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
@@ -1361,7 +1361,7 @@ TclGetCompletionCodeFromObj(
"ok", "error", "return", "break", "continue", NULL
};
if (!TclHasInternalRep(value, &indexType)
if (!TclHasInternalRep(value, &tclIndexType)
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
+143 -58
View File
@@ -66,11 +66,8 @@
#include <ctype.h>
#include <stdarg.h>
#ifdef NO_STDLIB_H
# include "../compat/stdlib.h"
#else
# include <stdlib.h>
#endif
#include <stdlib.h>
#include <stdint.h>
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
@@ -1086,20 +1083,102 @@ typedef struct ActiveInterpTrace {
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
typedef struct { /* For internal core use only */
Tcl_ObjType objType;
struct {
Tcl_Size (*lengthProc)(Tcl_Obj *obj);
} abstractList;
} TclObjTypeWithAbstractList;
#define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \
}, {lengthProc /* For internal core use only */
#define ABSTRACTLIST_PROC(objPtr, proc) (((objPtr)->typePtr \
&& ((objPtr)->typePtr->version > offsetof(TclObjTypeWithAbstractList, abstractList.proc))) ? \
((const TclObjTypeWithAbstractList *)(objPtr)->typePtr)->abstractList.proc : NULL)
#if TCL_MAJOR_VERSION > 8
#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
((objPtr)->typePtr)->proc : NULL)
MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
/*
* Abstract List
*
* This structure provides the functions used in List operations to emulate a
* List for AbstractList types.
*/
static inline Tcl_Size
TclObjTypeLength(Tcl_Obj *objPtr)
{
Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc);
return proc(objPtr);
}
static inline int
TclObjTypeIndex(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size index,
Tcl_Obj **elemObjPtr)
{
Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc);
return proc(interp, objPtr, index, elemObjPtr);
}
static inline int
TclObjTypeSlice(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size fromIdx,
Tcl_Size toIdx,
Tcl_Obj **newObjPtr)
{
Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc);
return proc(interp, objPtr, fromIdx, toIdx, newObjPtr);
}
static inline int
TclObjTypeReverse(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Obj **newObjPtr)
{
Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc);
return proc(interp, objPtr, newObjPtr);
}
static inline int
TclObjTypeGetElements(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size *objCPtr,
Tcl_Obj ***objVPtr)
{
Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc);
return proc(interp, objPtr, objCPtr, objVPtr);
}
static inline Tcl_Obj*
TclObjTypeSetElement(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size indexCount,
Tcl_Obj *const indexArray[],
Tcl_Obj *valueObj)
{
Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc);
return proc(interp, objPtr, indexCount, indexArray, valueObj);
}
static inline int
TclObjTypeReplace(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
Tcl_Size first,
Tcl_Size numToDelete,
Tcl_Size numToInsert,
Tcl_Obj *const insertObjs[])
{
Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
}
static inline int
TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj,
struct Tcl_Obj *listObj, int *boolResult)
{
Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
return proc(interp, valueObj, listObj, boolResult);
}
#endif /* TCL_MAJOR_VERSION > 8 */
/*
* The structure below defines an entry in the assocData hash table which is
* associated with an interpreter. The entry contains a pointer to a function
@@ -1242,7 +1321,7 @@ typedef struct CmdFrame {
int type; /* Values see below. */
int level; /* Number of frames in stack, prevent O(n)
* scan of list. */
int *line; /* Lines the words of the command start on. */
Tcl_Size *line; /* Lines the words of the command start on. */
Tcl_Size nline;
CallFrame *framePtr; /* Procedure activation record, may be
* NULL. */
@@ -1337,7 +1416,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
Tcl_Size num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
* The table is allocated as part of the
* structure, extending behind the nominal end
* of the structure. An entry containing the
@@ -2594,8 +2673,8 @@ typedef struct ListRep {
* (1) No string representation exists which means it will obviously have
* to be generated from the list representation when needed
* (2) The ListStore flags is marked canonical. This is done at the time
* the string representation is generated from the list IF the list
* representation does not have a span (see comments in UpdateStringOfList).
* the string representation is generated from the list under certain
* conditions (see comments in UpdateStringOfList).
* (3) The list representation does not have a span component. This is
* because list Tcl_Obj's with spans are always created from existing lists
* and never from strings (see SetListFromAny) and thus their string
@@ -2613,7 +2692,7 @@ typedef struct ListRep {
* converted to a list.
*/
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
(((listObj_)->typePtr == &tclListType.objType) \
(((listObj_)->typePtr == &tclListType) \
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
TCL_OK) \
: Tcl_ListObjGetElements( \
@@ -2625,12 +2704,12 @@ typedef struct ListRep {
* Tcl_Obj cannot be converted to a list.
*/
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
(((listObj_)->typePtr == &tclListType.objType) \
(((listObj_)->typePtr == &tclListType) \
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
#define TclListObjIsCanonical(listObj_) \
(((listObj_)->typePtr == &tclListType.objType) ? ListObjIsCanonical((listObj_)) : 0)
(((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
/*
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
@@ -2650,27 +2729,27 @@ typedef struct ListRep {
#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType.objType \
|| (objPtr)->typePtr == &tclBooleanType.objType) \
(((objPtr)->typePtr == &tclIntType \
|| (objPtr)->typePtr == &tclBooleanType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType.objType) \
(((objPtr)->typePtr == &tclIntType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: ((objPtr)->typePtr == &tclBooleanType.objType) \
: ((objPtr)->typePtr == &tclBooleanType) \
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType.objType) \
(((objPtr)->typePtr == &tclIntType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType.objType \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2678,13 +2757,13 @@ typedef struct ListRep {
#endif
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType.objType \
(((objPtr)->typePtr == &tclIntType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
((((objPtr)->typePtr == &tclIntType.objType) && ((objPtr)->internalRep.wideValue >= 0) \
((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
&& ((objPtr)->internalRep.wideValue <= endValue)) \
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
@@ -2698,7 +2777,7 @@ typedef struct ListRep {
*/
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType.objType) \
(((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
@@ -2951,6 +3030,7 @@ MODULE_SCOPE TclPlatformType tclPlatform;
*/
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
MODULE_SCOPE Tcl_Encoding tclUtf8Encoding;
MODULE_SCOPE int
TclEncodingProfileNameToId(Tcl_Interp *interp,
const char *profileName,
@@ -2973,13 +3053,13 @@ MODULE_SCOPE void *tclTimeClientData;
* Variables denoting the Tcl object types defined in the core.
*/
MODULE_SCOPE const TclObjTypeWithAbstractList tclBignumType;
MODULE_SCOPE const TclObjTypeWithAbstractList tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const TclObjTypeWithAbstractList tclDoubleType;
MODULE_SCOPE const TclObjTypeWithAbstractList tclIntType;
MODULE_SCOPE const TclObjTypeWithAbstractList tclListType;
MODULE_SCOPE const TclObjTypeWithAbstractList tclArithSeriesType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclIndexType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -3127,7 +3207,7 @@ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr,
const unsigned char *bytes, Tcl_Size len);
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, int **next,
MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
int loc);
MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start,
const char *end);
@@ -3137,7 +3217,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc);
MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
Tcl_Obj *objv[], int objc,
void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc);
void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc);
MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
@@ -3162,9 +3242,9 @@ MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
int *loc);
Tcl_Size *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
int start, int *clNext);
Tcl_Size start, Tcl_Size *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
@@ -3180,8 +3260,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr);
MODULE_SCOPE Tcl_Obj* TclDuplicatePureObj(Tcl_Interp *interp,
Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, Tcl_Size dictLength,
const char **elementPtr, const char **nextPtr,
@@ -3189,7 +3267,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
Tcl_Size numBytes, int flags, Tcl_Size line,
int *clNextOuter, const char *outerScript);
Tcl_Size *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
@@ -3310,8 +3388,9 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
/* TIP #280 */
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
Tcl_Size *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp,
Tcl_Obj *toObj, Tcl_Size elemCount,
Tcl_Obj *const elemObjv[]);
@@ -3359,6 +3438,11 @@ MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj * TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp,
Tcl_Obj* pathPtr);
MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
Tcl_Obj *stepObj, Tcl_Obj *lenObj);
MODULE_SCOPE Tcl_Obj * TclNewStringListObj(Tcl_Interp *interp,
Tcl_Obj *srcStringObj);
MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
Tcl_Size len);
MODULE_SCOPE void TclpAlertNotifier(void *clientData);
@@ -3476,7 +3560,7 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
Tcl_InterpState *statePtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
int *clNextOuter, const char *outerScript);
Tcl_Size *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes,
const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight);
MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes,
@@ -4231,6 +4315,7 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
int *codePtr, Tcl_Obj **msgObjPtr,
Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *, Tcl_Channel chan);
/*
* TIP #508: [array default]
*/
@@ -4886,7 +4971,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
/*
@@ -4918,7 +5003,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_ObjInternalRep ir; \
ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, &tclIntType.objType, &ir); \
Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \
} while (0)
#define TclSetDoubleObj(objPtr, d) \
@@ -4926,7 +5011,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_ObjInternalRep ir; \
ir.doubleValue = (double) d; \
TclInvalidateStringRep(objPtr); \
Tcl_StoreInternalRep(objPtr, &tclDoubleType.objType, &ir); \
Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \
} while (0)
/*
@@ -4937,7 +5022,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
*
* MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
*
*----------------------------------------------------------------
@@ -4951,7 +5036,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
(objPtr)->typePtr = &tclIntType.objType; \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4970,13 +5055,13 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TclSetBignumInternalRep((objPtr), &bignumValue_); \
} else { \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
(objPtr)->typePtr = &tclIntType.objType; \
(objPtr)->typePtr = &tclIntType; \
} \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
#define TclNewIndexObj(objPtr, uw) \
TclNewIntObj(objPtr, uw)
#define TclNewIndexObj(objPtr, w) \
TclNewIntObj(objPtr, w)
#define TclNewDoubleObj(objPtr, d) \
do { \
@@ -4985,7 +5070,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
(objPtr)->typePtr = &tclDoubleType.objType; \
(objPtr)->typePtr = &tclDoubleType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -5246,7 +5331,7 @@ typedef struct NRE_callback {
#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
(ptr = (Tcl_Alloc(sizeof(NRE_callback))))
((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
#define TCLNR_FREE(interp, ptr) Tcl_Free(ptr)
#endif
+4 -4
View File
@@ -167,7 +167,7 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id);
/* 21 */
EXTERN char * TclpInetNtoa(struct in_addr addr);
/* 22 */
@@ -312,7 +312,7 @@ typedef struct TclIntPlatStubs {
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */
int (*tclWinGetPlatformId) (void); /* 9 */
void *(*tclpReaddir) (void *dir); /* 10 */
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
@@ -324,7 +324,7 @@ typedef struct TclIntPlatStubs {
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
void (*reserved23)(void);
@@ -749,7 +749,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */
MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj **attributePtrPtr);
+1 -1
View File
@@ -547,7 +547,7 @@ GetDouble(
return 0;
} else {
#ifdef ACCEPT_NAN
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
if (irPtr != NULL) {
*dblPtr = irPtr->doubleValue;
+260 -204
View File
@@ -12,7 +12,6 @@
#include <assert.h>
#include "tclInt.h"
#include "tclTomMath.h"
#include "tclArithSeries.h"
/*
* TODO - memmove is fast. Measure at what size we should prefer memmove
@@ -69,7 +68,7 @@
/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType.objType))
LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType))
/*
* If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
@@ -119,7 +118,7 @@
/*
* Prototypes for non-inline static functions defined later in this file:
*/
static int MemoryAllocationError(Tcl_Interp *, Tcl_Size size);
static int MemoryAllocationError(Tcl_Interp *, size_t size);
static int ListLimitExceededError(Tcl_Interp *);
static ListStore *ListStoreNew(Tcl_Size objc, Tcl_Obj *const objv[], int flags);
static int ListRepInit(Tcl_Size objc, Tcl_Obj *const objv[], int flags, ListRep *);
@@ -151,15 +150,13 @@ static Tcl_Size ListLength(Tcl_Obj *listPtr);
* The internal representation of a list object is ListRep defined in tcl.h.
*/
const TclObjTypeWithAbstractList tclListType = {
{"list", /* name */
const Tcl_ObjType tclListType = {
"list", /* name */
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
ListLength
)}
TCL_OBJTYPE_V1(ListLength)
};
/* Macros to manipulate the List internal rep */
@@ -205,7 +202,7 @@ const TclObjTypeWithAbstractList tclListType = {
do { \
(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \
(objPtr_)->typePtr = &tclListType.objType; \
(objPtr_)->typePtr = &tclListType; \
} while (0)
#define ListObjOverwriteRep(objPtr_, repPtr_) \
@@ -348,7 +345,7 @@ static inline void
ListRepFreeUnreferenced(const ListRep *repPtr)
{
if (! ListRepIsShared(repPtr) && repPtr->spanPtr) {
/* T:listrep-1.5.1 */
/* T:listrep-1.5.1 */
ListRepUnsharedFreeUnreferenced(repPtr);
}
}
@@ -374,7 +371,7 @@ ObjArrayIncrRefs(
Tcl_Size startIdx, /* Starting index of subarray within objv */
Tcl_Size count) /* Number of elements in the subarray */
{
Tcl_Obj * const *end;
Tcl_Obj *const *end;
LIST_INDEX_ASSERT(startIdx);
LIST_COUNT_ASSERT(count);
objv += startIdx;
@@ -466,15 +463,15 @@ ObjArrayCopy(
static int
MemoryAllocationError(
Tcl_Interp *interp, /* Interpreter for error message. May be NULL */
Tcl_Size size) /* Size of attempted allocation that failed */
size_t size) /* Size of attempted allocation that failed */
{
if (interp != NULL) {
Tcl_SetObjResult(
interp,
Tcl_ObjPrintf(
"list construction failed: unable to alloc %" TCL_LL_MODIFIER
"list construction failed: unable to alloc %" TCL_Z_MODIFIER
"u bytes",
(Tcl_WideInt)size));
size));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
return TCL_ERROR;
@@ -645,8 +642,11 @@ ListRepValidate(const ListRep *repPtr, const char *file, int lineNum)
/* Separate each condition so line number gives exact reason for failure */
INVARIANT(storePtr != NULL);
INVARIANT(storePtr->numAllocated >= 0);
INVARIANT(storePtr->numAllocated <= LIST_MAX);
INVARIANT(storePtr->firstUsed >= 0);
INVARIANT(storePtr->firstUsed < storePtr->numAllocated);
INVARIANT(storePtr->numUsed >= 0);
INVARIANT(storePtr->numUsed <= storePtr->numAllocated);
INVARIANT(storePtr->firstUsed <= (storePtr->numAllocated - storePtr->numUsed));
@@ -757,9 +757,9 @@ ListStoreNew(
}
if (storePtr == NULL) {
if (flags & LISTREP_PANIC_ON_FAIL) {
Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER
"u bytes",
LIST_SIZE(objc));
Tcl_Panic("list creation failed: unable to alloc %" TCL_SIZE_MODIFIER
"d bytes",
LIST_SIZE(objc));
}
return NULL;
}
@@ -836,7 +836,7 @@ ListStoreReallocate (ListStore *storePtr, Tcl_Size needed)
}
return storePtr;
}
/*
*----------------------------------------------------------------------
*
@@ -1013,7 +1013,7 @@ static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr)
count = spanPtr->spanStart - storePtr->firstUsed;
LIST_COUNT_ASSERT(count);
if (count > 0) {
/* T:listrep-1.5.1,6.{1:8} */
/* T:listrep-1.5.1,6.{1:8} */
ObjArrayDecrRefs(storePtr->slots, storePtr->firstUsed, count);
storePtr->firstUsed = spanPtr->spanStart;
LIST_ASSERT(storePtr->numUsed >= count);
@@ -1025,7 +1025,7 @@ static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr)
- (spanPtr->spanStart + spanPtr->spanLength);
LIST_COUNT_ASSERT(count);
if (count > 0) {
/* T:listrep-6.{1:8} */
/* T:listrep-6.{1:8} */
ObjArrayDecrRefs(
storePtr->slots, spanPtr->spanStart + spanPtr->spanLength, count);
LIST_ASSERT(storePtr->numUsed >= count);
@@ -1086,7 +1086,7 @@ Tcl_NewListObj(
TclNewObj(listObj);
if (objc + 1 <= 1) {
if (objc <= 0) {
return listObj;
}
@@ -1142,7 +1142,7 @@ Tcl_DbNewListObj(
TclDbNewObj(listObj, file, line);
if (objc + 1 <= 1) {
if (objc <= 0) {
return listObj;
}
@@ -1251,7 +1251,7 @@ TclListObjGetRep(
* to be returned. */
ListRep *repPtr) /* Location to store descriptor */
{
if (!TclHasInternalRep(listObj, &tclListType.objType)) {
if (!TclHasInternalRep(listObj, &tclListType)) {
int result;
result = SetListFromAny(interp, listObj);
if (result != TCL_OK) {
@@ -1304,7 +1304,7 @@ Tcl_SetListObj(
* not be called with objc == 0!
*/
if (objc + 1 > 1) {
if (objc > 0) {
ListRep listRep;
/* TODO - perhaps ask for extra space? */
ListRepInit(objc, objv, LISTREP_PANIC_ON_FAIL, &listRep);
@@ -1316,6 +1316,50 @@ Tcl_SetListObj(
}
}
/*
*----------------------------------------------------------------------
*
* TclListObjCopy --
*
* Makes a "pure list" copy of a list value. This provides for the C
* level a counterpart of the [lrange $list 0 end] command, while using
* internals details to be as efficient as possible.
*
* Results:
* Normally returns a pointer to a new Tcl_Obj, that contains the same
* list value as *listPtr does. The returned Tcl_Obj has a refCount of
* zero. If *listPtr does not hold a list, NULL is returned, and if
* interp is non-NULL, an error message is recorded there.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclListObjCopy(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj) /* List object for which an element array is
* to be returned. */
{
Tcl_Obj *copyObj;
if (!TclHasInternalRep(listObj, &tclListType)) {
if (TclObjTypeHasProc(listObj, lengthProc)) {
return Tcl_DuplicateObj(listObj);
}
if (SetListFromAny(interp, listObj) != TCL_OK) {
return NULL;
}
}
TclNewObj(copyObj);
TclInvalidateStringRep(copyObj);
DupListInternalRep(listObj, copyObj);
return copyObj;
}
/*
*------------------------------------------------------------------------
*
@@ -1363,7 +1407,7 @@ ListRepRange(
/* Take the opportunity to garbage collect */
/* TODO - we probably do not need the preserveSrcRep here unlike later */
if (!preserveSrcRep) {
/* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
/* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
ListRepFreeUnreferenced(srcRepPtr);
} /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
@@ -1400,7 +1444,7 @@ ListRepRange(
*/
if (rangeStart == 0 && rangeEnd == (numSrcElems-1)) {
/* Option 0 - entire list. This may be used to canonicalize */
/* T:listrep-1.10.1,2.8.1 */
/* T:listrep-1.10.1,2.8.1 */
*rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */
} else if (rangeStart == 0 && (!preserveSrcRep)
&& (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) {
@@ -1410,7 +1454,7 @@ ListRepRange(
numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
/* Assert: Because numSrcElems > rangeEnd earlier */
if (numAfterRangeEnd != 0) {
/* T:listrep-1.{8,9} */
/* T:listrep-1.{8,9} */
ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
}
/* srcRepPtr->storePtr->firstUsed,numAllocated unchanged */
@@ -1426,29 +1470,29 @@ ListRepRange(
if (!preserveSrcRep && srcRepPtr->spanPtr
&& srcRepPtr->spanPtr->refCount <= 1) {
/* If span is not shared reuse it */
/* T:listrep-2.7.3,3.{16,18} */
/* T:listrep-2.7.3,3.{16,18} */
srcRepPtr->spanPtr->spanStart = spanStart;
srcRepPtr->spanPtr->spanLength = rangeLen;
*rangeRepPtr = *srcRepPtr;
} else {
/* Span not present or is shared. */
/* T:listrep-1.5,2.{5,7},4.{7,8} */
/* T:listrep-1.5,2.{5,7},4.{7,8} */
rangeRepPtr->storePtr = srcRepPtr->storePtr;
rangeRepPtr->spanPtr = ListSpanNew(spanStart, rangeLen);
}
/*
* We have potentially created a new internal representation that
* references the same storage as srcRep but not yet incremented its
* reference count. So do NOT call freezombies if preserveSrcRep
* is mandated.
*/
/*
* We have potentially created a new internal representation that
* references the same storage as srcRep but not yet incremented its
* reference count. So do NOT call freezombies if preserveSrcRep
* is mandated.
*/
if (!preserveSrcRep) {
/* T:listrep-1.{5.1,5.2,5.4},2.{5,7},3.{16,18},4.{7,8} */
/* T:listrep-1.{5.1,5.2,5.4},2.{5,7},3.{16,18},4.{7,8} */
ListRepFreeUnreferenced(rangeRepPtr);
}
} else if (preserveSrcRep || ListRepIsShared(srcRepPtr)) {
/* Option 3 - span or modification in place not allowed/desired */
/* T:listrep-2.{4,6} */
/* T:listrep-2.{4,6} */
ListRepElements(srcRepPtr, numSrcElems, srcElems);
/* TODO - allocate extra space? */
ListRepInit(rangeLen,
@@ -1475,14 +1519,14 @@ ListRepRange(
/* Free leading elements outside range */
if (rangeStart != 0) {
/* T:listrep-1.4,3.15 */
/* T:listrep-1.4,3.15 */
ObjArrayDecrRefs(srcElems, 0, rangeStart);
}
/* Ditto for trailing */
numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
/* Assert: Because numSrcElems > rangeEnd earlier */
if (numAfterRangeEnd != 0) {
/* T:listrep-3.17 */
/* T:listrep-3.17 */
ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
}
memmove(&srcRepPtr->storePtr->slots[0],
@@ -1494,7 +1538,7 @@ ListRepRange(
srcRepPtr->storePtr->flags = 0;
if (srcRepPtr->spanPtr) {
/* In case the source has a span, update it for consistency */
/* T:listrep-3.{15,17} */
/* T:listrep-3.{15,17} */
srcRepPtr->spanPtr->spanStart = srcRepPtr->storePtr->firstUsed;
srcRepPtr->spanPtr->spanLength = srcRepPtr->storePtr->numUsed;
}
@@ -1549,7 +1593,7 @@ TclListObjRange(
ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);
if (isShared) {
/* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
/* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
TclNewObj(listObj);
} /* T:listrep-1.{4.3,5.1,5.2} */
ListObjReplaceRepAndInvalidate(listObj, &resultRep);
@@ -1622,12 +1666,12 @@ Tcl_ListObjGetElements(
{
ListRep listRep;
if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
if (TclObjTypeHasProc(objPtr, getElementsProc)) {
return TclObjTypeGetElements(interp, objPtr, objcPtr, objvPtr);
}
if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) {
return TCL_ERROR;
}
if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)
return TCL_ERROR;
ListRepElements(&listRep, *objcPtr, *objvPtr);
return TCL_OK;
}
@@ -1766,15 +1810,15 @@ Tcl_ListObjAppendList(
>= elemCount); /* Total free */
if (numTailFree < elemCount) {
/* Not enough room at back. Move some to front */
/* T:listrep-3.5 */
/* T:listrep-3.5 */
Tcl_Size shiftCount = elemCount - numTailFree;
/* Divide remaining space between front and back */
shiftCount += (listRep.storePtr->numAllocated - finalLen) / 2;
LIST_ASSERT(shiftCount <= listRep.storePtr->firstUsed);
if (shiftCount) {
/* T:listrep-3.5 */
/* T:listrep-3.5 */
ListRepUnsharedShiftDown(&listRep, shiftCount);
}
}
} /* else T:listrep-3.{4,6} */
ObjArrayCopy(&listRep.storePtr->slots[ListRepStart(&listRep)
+ ListRepLength(&listRep)],
@@ -1782,7 +1826,7 @@ Tcl_ListObjAppendList(
elemObjv);
listRep.storePtr->numUsed = finalLen;
if (listRep.spanPtr) {
/* T:listrep-3.{4,5,6} */
/* T:listrep-3.{4,5,6} */
LIST_ASSERT(listRep.spanPtr->spanStart
== listRep.storePtr->firstUsed);
listRep.spanPtr->spanLength = finalLen;
@@ -1812,13 +1856,13 @@ Tcl_ListObjAppendList(
LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen);
if (toLen) {
/* T:listrep-2.{2,9},4.5 */
/* T:listrep-2.{2,9},4.5 */
ObjArrayCopy(ListRepSlotPtr(&listRep, 0), toLen, toObjv);
}
ObjArrayCopy(ListRepSlotPtr(&listRep, toLen), elemCount, elemObjv);
listRep.storePtr->numUsed = finalLen;
if (listRep.spanPtr) {
/* T:listrep-4.5 */
/* T:listrep-4.5 */
LIST_ASSERT(listRep.spanPtr->spanStart == listRep.storePtr->firstUsed);
listRep.spanPtr->spanLength = finalLen;
}
@@ -1914,11 +1958,16 @@ Tcl_ListObjIndex(
return TCL_OK;
}
int hasAbstractList = TclObjTypeHasProc(listObj,indexProc) != 0;
if (hasAbstractList) {
return TclObjTypeIndex(interp, listObj, index, objPtrPtr);
}
if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
!= TCL_OK) {
return TCL_ERROR;
}
if (index < 0 || index >= numElems) {
if ((index < 0) || (index >= numElems)) {
*objPtrPtr = NULL;
} else {
*objPtrPtr = elemObjs[index];
@@ -1964,9 +2013,8 @@ Tcl_ListObjLength(
return TCL_OK;
}
Tcl_Size (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc);
if (lengthProc) {
*lenPtr = lengthProc(listObj);
if (TclObjTypeHasProc(listObj, lengthProc)) {
*lenPtr = TclObjTypeLength(listObj);
return TCL_OK;
}
@@ -2048,6 +2096,11 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (TclObjTypeHasProc(listObj, replaceProc)) {
return TclObjTypeReplace(interp, listObj, first,
numToDelete, numToInsert, insertObjs);
}
if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)
return TCL_ERROR; /* Cannot be converted to a list */
@@ -2062,7 +2115,7 @@ Tcl_ListObjReplace(
if (numToDelete < 0) {
numToDelete = 0;
} else if (first > LIST_MAX - numToDelete /* Handle integer overflow */
|| origListLen < first + numToDelete) {
|| origListLen < first + numToDelete) {
numToDelete = origListLen - first;
}
@@ -2104,23 +2157,23 @@ Tcl_ListObjReplace(
if (numToInsert == 0) {
if (numToDelete == 0) {
/*
* Should force canonical even for no-op. Remember Tcl_Obj unshared
* so OK to invalidate string rep
*/
/* T:listrep-1.10,2.8 */
* Should force canonical even for no-op. Remember Tcl_Obj unshared
* so OK to invalidate string rep
*/
/* T:listrep-1.10,2.8 */
TclInvalidateStringRep(listObj);
return TCL_OK;
}
if (first == 0) {
/* Delete from front, so return tail. */
/* T:listrep-1.{4,5},2.{4,5},3.{15,16},4.7 */
/* T:listrep-1.{4,5},2.{4,5},3.{15,16},4.7 */
ListRep tailRep;
ListRepRange(&listRep, numToDelete, origListLen-1, 0, &tailRep);
ListObjReplaceRepAndInvalidate(listObj, &tailRep);
return TCL_OK;
} else if ((first+numToDelete) >= origListLen) {
/* Delete from tail, so return head */
/* T:listrep-1.{8,9},2.{6,7},3.{17,18},4.8 */
/* T:listrep-1.{8,9},2.{6,7},3.{17,18},4.8 */
ListRep headRep;
ListRepRange(&listRep, 0, first-1, 0, &headRep);
ListObjReplaceRepAndInvalidate(listObj, &headRep);
@@ -2138,7 +2191,7 @@ Tcl_ListObjReplace(
if (numToDelete == 0) {
/* Case (2a) - Append to list. */
if (first == origListLen) {
/* T:listrep-1.11,2.9,3.{5,6},2.2.1 */
/* T:listrep-1.11,2.9,3.{5,6},2.2.1 */
return TclListObjAppendElements(
interp, listObj, numToInsert, insertObjs);
}
@@ -2165,7 +2218,7 @@ Tcl_ListObjReplace(
newLen = listRep.spanPtr->spanLength + numToInsert;
if (listRep.spanPtr && listRep.spanPtr->refCount <= 1) {
/* An unshared span record, re-use it */
/* T:listrep-3.1 */
/* T:listrep-3.1 */
listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
listRep.spanPtr->spanLength = newLen;
} else {
@@ -2173,7 +2226,7 @@ Tcl_ListObjReplace(
if (listRep.storePtr->firstUsed == 0) {
listRep.spanPtr = NULL;
} else {
/* T:listrep-4.3 */
/* T:listrep-4.3 */
listRep.spanPtr =
ListSpanNew(listRep.storePtr->firstUsed, newLen);
}
@@ -2238,24 +2291,24 @@ Tcl_ListObjReplace(
&newRep);
toObjs = ListRepSlotPtr(&newRep, 0);
if (leadSegmentLen > 0) {
/* T:listrep-2.{2,3,13:18},4.{6,9,13:18} */
/* T:listrep-2.{2,3,13:18},4.{6,9,13:18} */
ObjArrayCopy(toObjs, leadSegmentLen, listObjs);
}
if (numToInsert > 0) {
/* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,10:18} */
/* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,10:18} */
ObjArrayCopy(&toObjs[leadSegmentLen],
numToInsert,
insertObjs);
}
if (tailSegmentLen > 0) {
/* T:listrep-2.{1,2,3,10:15},4.{1,2,4,6,9:12,16:18} */
/* T:listrep-2.{1,2,3,10:15},4.{1,2,4,6,9:12,16:18} */
ObjArrayCopy(&toObjs[leadSegmentLen + numToInsert],
tailSegmentLen,
&listObjs[leadSegmentLen+numToDelete]);
}
newRep.storePtr->numUsed = origListLen + lenChange;
if (newRep.spanPtr) {
/* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,9:18} */
/* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,9:18} */
newRep.spanPtr->spanLength = newRep.storePtr->numUsed;
}
LISTREP_CHECK(&newRep);
@@ -2292,7 +2345,7 @@ Tcl_ListObjReplace(
ObjArrayIncrRefs(insertObjs, 0, numToInsert);
}
if (numToDelete) {
/* T:listrep-1.{6,7,12:21},3.{19:41} */
/* T:listrep-1.{6,7,12:21},3.{19:41} */
ObjArrayDecrRefs(listObjs, first, numToDelete);
}
@@ -2323,12 +2376,12 @@ Tcl_ListObjReplace(
*/
if (leadSegmentLen > tailSegmentLen) {
/* Tail segment smaller. Insert after lead, move tail down */
/* T:listrep-1.{7,17,20},3.{21,2229,35} */
/* T:listrep-1.{7,17,20},3.{21,2229,35} */
leadShift = 0;
tailShift = lenChange;
} else {
/* Lead segment smaller. Insert before tail, move lead up */
/* T:listrep-1.{6,13,16},3.{19,20,24,34} */
/* T:listrep-1.{6,13,16},3.{19,20,24,34} */
leadShift = -lenChange;
tailShift = 0;
}
@@ -2349,7 +2402,7 @@ Tcl_ListObjReplace(
if (leadSpace >= lenChange
&& (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) {
/* Move only lead to the front to make more room */
/* T:listrep-3.25,36,38, */
/* T:listrep-3.25,36,38, */
leadShift = -lenChange;
tailShift = 0;
/*
@@ -2370,7 +2423,7 @@ Tcl_ListObjReplace(
LIST_ASSERT(leadShift >= 0 || leadSpace >= -leadShift);
} else if (tailSpace >= lenChange) {
/* Move only tail segment to the back to make more room. */
/* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
/* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
leadShift = 0;
tailShift = lenChange;
/*
@@ -2391,7 +2444,7 @@ Tcl_ListObjReplace(
* Both lead and tail need to be shifted to make room.
* Divide remaining free space equally between front and back.
*/
/* T:listrep-3.{9,13,31,40} */
/* T:listrep-3.{9,13,31,40} */
LIST_ASSERT(leadSpace < lenChange);
LIST_ASSERT(tailSpace < lenChange);
@@ -2424,27 +2477,27 @@ Tcl_ListObjReplace(
if (leadShift > 0) {
/* Will happen when we have to make room at bottom */
if (tailShift != 0 && tailSegmentLen != 0) {
/* T:listrep-1.{1,3,14,18},3.{2,3,26,27} */
/* T:listrep-1.{1,3,14,18},3.{2,3,26,27} */
Tcl_Size tailStart = leadSegmentLen + numToDelete;
memmove(&listObjs[tailStart + tailShift],
&listObjs[tailStart],
tailSegmentLen * sizeof(Tcl_Obj *));
}
if (leadSegmentLen != 0) {
/* T:listrep-1.{3,6,16,18,21},3.{19,20,34} */
/* T:listrep-1.{3,6,16,18,21},3.{19,20,34} */
memmove(&listObjs[leadShift],
&listObjs[0],
leadSegmentLen * sizeof(Tcl_Obj *));
}
} else {
if (leadShift != 0 && leadSegmentLen != 0) {
/* T:listrep-3.{7,9,12,13,31,36,38,40} */
/* T:listrep-3.{7,9,12,13,31,36,38,40} */
memmove(&listObjs[leadShift],
&listObjs[0],
leadSegmentLen * sizeof(Tcl_Obj *));
}
if (tailShift != 0 && tailSegmentLen != 0) {
/* T:listrep-1.{7,17},3.{8:11,13,14,21,22,35,37,39:41} */
/* T:listrep-1.{7,17},3.{8:11,13,14,21,22,35,37,39:41} */
Tcl_Size tailStart = leadSegmentLen + numToDelete;
memmove(&listObjs[tailStart + tailShift],
&listObjs[tailStart],
@@ -2453,7 +2506,7 @@ Tcl_ListObjReplace(
}
if (numToInsert) {
/* Do NOT use ObjArrayCopy here since we have already incr'ed ref counts */
/* T:listrep-1.{1,3,12:21},3.{2,3,7:14,23:41} */
/* T:listrep-1.{1,3,12:21},3.{2,3,7:14,23:41} */
memmove(&listObjs[leadSegmentLen + leadShift],
insertObjs,
numToInsert * sizeof(Tcl_Obj *));
@@ -2465,16 +2518,16 @@ Tcl_ListObjReplace(
if (listRep.spanPtr && listRep.spanPtr->refCount <= 1) {
/* An unshared span record, re-use it, even if not required */
/* T:listrep-3.{2,3,7:14},3.{19:41} */
/* T:listrep-3.{2,3,7:14},3.{19:41} */
listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
} else {
/* Need a new span record */
if (listRep.storePtr->firstUsed == 0) {
/* T:listrep-1.{7,12,15,17,19,20} */
/* T:listrep-1.{7,12,15,17,19,20} */
listRep.spanPtr = NULL;
} else {
/* T:listrep-1.{1,3,6.1,13,14,16,18,21} */
/* T:listrep-1.{1,3,6.1,13,14,16,18,21} */
listRep.spanPtr = ListSpanNew(listRep.storePtr->firstUsed,
listRep.storePtr->numUsed);
}
@@ -2519,7 +2572,6 @@ TclLindexList(
Tcl_Obj *indexListCopy;
Tcl_Obj **indexObjs;
Tcl_Size numIndexObjs;
int status;
/*
* Determine whether argPtr designates a list or a single index. We have
@@ -2527,7 +2579,7 @@ TclLindexList(
* shimmering; if internal rep is already a list do not shimmer it.
* see TIP#22 and TIP#33 for the details.
*/
if (!TclHasInternalRep(argObj, &tclListType.objType)
if (!TclHasInternalRep(argObj, &tclListType)
&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
== TCL_OK) {
/*
@@ -2537,30 +2589,19 @@ TclLindexList(
}
/*
* Make a private copy of the index list argument to keep the internal
* representation of th indices array unchanged while it is in use. This
* is probably unnecessary. It does not appear that any damaging change to
* the internal representation is possible, and no test has been devised to
* show any error when this private copy is not made, But it's cheap, and
* it offers some future-proofing insurance in case the TclLindexFlat
* implementation changes in some unexpected way, or some new form of trace
* or callback permits things to happen that the current implementation
* does not.
* Here we make a private copy of the index list argument to avoid any
* shimmering issues that might invalidate the indices array below while
* we are still using it. This is probably unnecessary. It does not appear
* that any damaging shimmering is possible, and no test has been devised
* to show any error when this private copy is not made. But it's cheap,
* and it offers some future-proofing insurance in case the TclLindexFlat
* implementation changes in some unexpected way, or some new form of
* trace or callback permits things to happen that the current
* implementation does not.
*/
indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType.objType);
if (!indexListCopy) {
/*
* The argument is neither an index nor a well-formed list.
* Report the error via TclLindexFlat.
* TODO - This is as original code. why not directly return an error?
*/
return TclLindexFlat(interp, listObj, 1, &argObj);
}
status = TclListObjGetElementsM(
interp, indexListCopy, &numIndexObjs, &indexObjs);
if (status != TCL_OK) {
Tcl_DecrRefCount(indexListCopy);
indexListCopy = TclListObjCopy(NULL, argObj);
if (indexListCopy == NULL) {
/*
* The argument is neither an index nor a well-formed list.
* Report the error via TclLindexFlat.
@@ -2568,6 +2609,7 @@ TclLindexList(
*/
return TclLindexFlat(interp, listObj, 1, &argObj);
}
TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs);
listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);
Tcl_DecrRefCount(indexListCopy);
return listObj;
@@ -2609,9 +2651,9 @@ TclLindexFlat(
int status;
Tcl_Size i;
/* Handle ArithSeries as special case */
if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
Tcl_Size listLen = ABSTRACTLIST_PROC(listObj, lengthProc)(listObj);
/* Handle AbstractList as special case */
if (TclObjTypeHasProc(listObj,indexProc)) {
Tcl_Size listLen = TclObjTypeLength(listObj);
Tcl_Size index;
Tcl_Obj *elemObj = NULL;
for (i=0 ; i<indexCount && listObj ; i++) {
@@ -2619,12 +2661,14 @@ TclLindexFlat(
&index) == TCL_OK) {
}
if (i==0) {
elemObj = TclArithSeriesObjIndex(NULL, listObj, index);
if (TclObjTypeIndex(interp, listObj, index, &elemObj) != TCL_OK) {
return NULL;
}
} else if (index > 0) {
/* ArithSeries cannot be a list of lists */
// TODO: support nested lists
Tcl_Obj *e2Obj = TclLindexFlat(interp, elemObj, 1, &indexArray[i]);
Tcl_DecrRefCount(elemObj);
TclNewObj(elemObj);
break;
elemObj = e2Obj;
}
}
Tcl_IncrRefCount(elemObj);
@@ -2668,7 +2712,7 @@ TclLindexFlat(
* Must set the internal rep again because it may have been
* changed by TclGetIntForIndexM. See test lindex-8.4.
*/
if (!TclHasInternalRep(listObj, &tclListType.objType)) {
if (!TclHasInternalRep(listObj, &tclListType)) {
status = SetListFromAny(interp, listObj);
if (status != TCL_OK) {
/* The list is not a list at all => error. */
@@ -2740,39 +2784,53 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
if (!TclHasInternalRep(indexArgObj, &tclListType.objType)
&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
== TCL_OK) {
/* indexArgPtr designates a single index. */
/* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
}
if (!TclHasInternalRep(indexArgObj, &tclListType)
&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
== TCL_OK) {
indexListCopy = TclDuplicatePureObj(
interp, indexArgObj, &tclListType.objType);
if (!indexListCopy) {
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
*/
return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
}
if (TCL_OK != TclListObjGetElementsM(
interp, indexListCopy, &indexCount, &indices)) {
Tcl_DecrRefCount(indexListCopy);
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
*/
return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
}
if (TclObjTypeHasProc(listObj, setElementProc)) {
indices = &indexArgObj;
retValueObj =
TclObjTypeSetElement(interp, listObj, 1, indices, valueObj);
if (retValueObj) Tcl_IncrRefCount(retValueObj);
} else {
/* indexArgPtr designates a single index. */
/* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
}
/*
* Let TclLsetFlat perform the actual lset operation.
*/
} else {
retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
Tcl_DecrRefCount(indexListCopy);
indexListCopy = TclListObjCopy(NULL,indexArgObj);
if (!indexListCopy) {
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
*/
retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
} else {
if (TCL_OK != TclListObjGetElementsM(
interp, indexListCopy, &indexCount, &indices)) {
Tcl_DecrRefCount(indexListCopy);
/*
* indexArgPtr designates something that is neither an index nor a
* well formed list. Report the error via TclLsetFlat.
*/
retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
} else {
/*
* Let TclLsetFlat perform the actual lset operation.
*/
retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);
if (indexListCopy) {
Tcl_DecrRefCount(indexListCopy);
}
}
}
}
assert (retValueObj==NULL || retValueObj->typePtr || retValueObj->bytes);
return retValueObj;
}
@@ -2822,7 +2880,7 @@ TclLsetFlat(
Tcl_Obj *valueObj) /* Value arg to 'lset' or NULL to 'lpop'. */
{
Tcl_Size index, len;
int copied = 0, result;
int result;
Tcl_Obj *subListObj, *retValueObj;
Tcl_Obj *pendingInvalidates[10];
Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
@@ -2842,15 +2900,17 @@ TclLsetFlat(
}
/*
* If the list is shared, make a copy to modify (copy-on-write). The string
* representation and internal representation of listObj remains unchanged.
* If the list is shared, make a copy we can modify (copy-on-write). We
* use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
* 1) we have not yet confirmed listObj is actually a list; 2) We make a
* verbatim copy of any existing string rep, and when we combine that with
* the delayed invalidation of string reps of modified Tcl_Obj's
* implemented below, the outcome is that any error condition that causes
* this routine to return NULL, will leave the string rep of listObj and
* all elements to be unchanged.
*/
subListObj = Tcl_IsShared(listObj)
? TclDuplicatePureObj(interp, listObj, &tclListType.objType) : listObj;
if (!subListObj) {
return NULL;
}
subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;
/*
* Anchor the linked list of Tcl_Obj's whose string reps must be
@@ -2862,7 +2922,7 @@ TclLsetFlat(
/* Allocate if static array for pending invalidations is too small */
if (indexCount
> (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) {
> (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) {
pendingInvalidatesPtr =
(Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr));
}
@@ -2901,6 +2961,14 @@ TclLsetFlat(
}
indexArray++;
/*
* Special case 0-length lists. The Tcl indexing function treat
* will return any value beyond length as TCL_SIZE_MAX for this
* case.
*/
if ((index == TCL_SIZE_MAX) && (elemCount == 0)) {
index = 0;
}
if (index < 0 || index > elemCount
|| (valueObj == NULL && index >= elemCount)) {
/* ...the index points outside the sublist. */
@@ -2920,9 +2988,10 @@ TclLsetFlat(
}
/*
* No error conditions. If this is not the last index, determine the
* next sublist for the next pass through the loop, and take steps to
* make sure it is unshared in order to modify it.
* No error conditions. As long as we're not yet on the last index,
* determine the next sublist for the next pass through the loop,
* and take steps to make sure it is an unshared copy, as we intend
* to modify it.
*/
if (--indexCount) {
@@ -2933,12 +3002,7 @@ TclLsetFlat(
subListObj = elemPtrs[index];
}
if (Tcl_IsShared(subListObj)) {
subListObj = TclDuplicatePureObj(
interp, subListObj, &tclListType.objType);
if (!subListObj) {
return NULL;
}
copied = 1;
subListObj = Tcl_DuplicateObj(subListObj);
}
/*
@@ -2956,17 +3020,7 @@ TclLsetFlat(
TclListObjSetElement(NULL, parentList, index, subListObj);
}
if (Tcl_IsShared(subListObj)) {
Tcl_Obj * newSubListObj;
newSubListObj = TclDuplicatePureObj(
interp, subListObj, &tclListType.objType);
if (copied) {
Tcl_DecrRefCount(subListObj);
}
if (newSubListObj) {
subListObj = newSubListObj;
} else {
return NULL;
}
subListObj = Tcl_DuplicateObj(subListObj);
TclListObjSetElement(NULL, parentList, index, subListObj);
}
@@ -3046,13 +3100,13 @@ TclLsetFlat(
len = -1;
TclListObjLengthM(NULL, subListObj, &len);
if (valueObj == NULL) {
/* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */
/* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */
Tcl_ListObjReplace(NULL, subListObj, index, 1, 0, NULL);
} else if (index == len) {
/* T:listrep-1.2.1,2.{2.3,9.3},3.{4,5,6}.3 */
/* T:listrep-1.2.1,2.{2.3,9.3},3.{4,5,6}.3 */
Tcl_ListObjAppendElement(NULL, subListObj, valueObj);
} else {
/* T:listrep-1.{12.1,15.1,19.1},2.{10,13,16}.1 */
/* T:listrep-1.{12.1,15.1,19.1},2.{10,13,16}.1 */
TclListObjSetElement(NULL, subListObj, index, valueObj);
TclInvalidateStringRep(subListObj);
}
@@ -3112,10 +3166,10 @@ TclListObjSetElement(
elemCount = ListRepLength(&listRep);
/* Ensure that the index is in bounds. */
if (index>=elemCount) {
if ((index < 0) || (index >= elemCount)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%" TCL_Z_MODIFIER "u\" out of range", index));
"index \"%" TCL_SIZE_MODIFIER "u\" out of range", index));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
"OUTOFRANGE", NULL);
}
@@ -3131,7 +3185,7 @@ TclListObjSetElement(
/* Replace a shared internal rep with an unshared copy */
if (listRep.storePtr->refCount > 1) {
ListRep newInternalRep;
/* T:listrep-2.{10,13,16}.1 */
/* T:listrep-2.{10,13,16}.1 */
/* TODO - leave extra space? */
ListRepClone(&listRep, &newInternalRep, LISTREP_PANIC_ON_FAIL);
listRep = newInternalRep;
@@ -3289,35 +3343,32 @@ SetListFromAny(
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
} else if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
/*
* Convertion from Arithmetic Series is a special case
* because it can be done an order of magnitude faster
* and may occur frequently.
*/
Tcl_Size j, size = ABSTRACTLIST_PROC(objPtr, lengthProc)(objPtr);
} else if (TclObjTypeHasProc(objPtr,indexProc)) {
Tcl_Size elemCount, i;
/* TODO - leave space in front and/or back? */
if (ListRepInitAttempt(
interp, size > 0 ? size : 1, NULL, &listRep)
!= TCL_OK) {
elemCount = TclObjTypeLength(objPtr);
if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) {
return TCL_ERROR;
}
LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
LIST_ASSERT(listRep.storePtr->firstUsed == 0);
LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0);
listRep.storePtr->numUsed = size;
elemPtrs = listRep.storePtr->slots;
for (j = 0; j < size; j++) {
elemPtrs[j] = TclArithSeriesObjIndex(interp, objPtr, j);
if (elemPtrs[j] == NULL) {
/* Each iteration, store a list element */
for (i = 0; i < elemCount; i++) {
if (TclObjTypeIndex(interp, objPtr, i, elemPtrs) != TCL_OK) {
return TCL_ERROR;
}
Tcl_IncrRefCount(elemPtrs[j]);
Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
}
LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount);
listRep.storePtr->numUsed = elemCount;
} else {
Tcl_Size estCount, length;
const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
@@ -3399,7 +3450,7 @@ fail:
TclFreeInternalRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
objPtr->typePtr = &tclListType.objType;
objPtr->typePtr = &tclListType;
return TCL_OK;
}
@@ -3444,16 +3495,21 @@ UpdateStringOfList(
* Mark the list as being canonical; although it will now have a string
* rep, it is one we derived through proper "canonical" quoting and so
* it's known to be free from nasties relating to [concat] and [eval].
* However, we only do this if this is not a spanned list. Marking the
* storage canonical for a spanned list make ALL lists using the storage
* canonical which is not right. (Consider a list generated from a
* However, we only do this if
*
* (a) the store is not shared as a shared store may be referenced by
* multiple lists with different string reps. (see [a366c6efee]), AND
*
* (b) list does not have a span. Consider a list generated from a
* string and then this function called for a spanned list generated
* from it). On the other hand, a spanned list is always canonical
* from the original list. We cannot mark the list store as canonical as
* that would also make the originating list canonical, which it may not
* be. On the other hand, the spanned list itself is always canonical
* (never generated from a string) so it does not have to be explicitly
* marked as such. The ListObjIsCanonical macro takes this into account.
* See the comments there.
*/
if (listRep.spanPtr == NULL) {
if (listRep.storePtr->refCount < 2 && listRep.spanPtr == NULL) {
LIST_ASSERT(listRep.storePtr->firstUsed == 0);/* Invariant */
listRep.storePtr->flags |= LISTSTORE_CANONICAL;
}
+1 -1
View File
@@ -395,7 +395,7 @@ Tcl_PopCallFrame(
Tcl_Free(framePtr->varTablePtr);
framePtr->varTablePtr = NULL;
}
if (framePtr->numCompiledLocals + 1 > 1) {
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
+2 -2
View File
@@ -588,7 +588,7 @@ TclOOMakeProcInstanceMethod(
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -701,7 +701,7 @@ TclOOMakeProcMethod(
cfPtr->level = -1;
cfPtr->type = context.type;
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = context.line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
+6 -5
View File
@@ -164,12 +164,13 @@ static const char *tclOOSetupScript =
"\t\tmethod -appendifnew -export args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\tset args [lmap a $args {\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
"\t\t\t\tif {$a in $current} continue\n"
"\t\t\t\tset a\n"
"\t\t\t}]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t\t\tif {$a ni $current} {\n"
"\t\t\t\t\tlappend current $a\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\ttailcall my Set $current\n"
"\t\t}\n"
"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
"\t\tmethod -prepend -export args {\n"
+66 -181
View File
@@ -202,9 +202,6 @@ static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int copy, mp_int *bignumValue);
static int SetDuplicatePureObj(Tcl_Interp *interp,
Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr);
/*
* Prototypes for the array hash key methods.
@@ -228,45 +225,37 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
const TclObjTypeWithAbstractList tclBooleanType= {
{"boolean", /* name */
const Tcl_ObjType tclBooleanType= {
"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
TclLengthOne
)}
TclSetBooleanFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V1(TclLengthOne)
};
const TclObjTypeWithAbstractList tclDoubleType= {
{"double", /* name */
const Tcl_ObjType tclDoubleType= {
"double", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
TclLengthOne
)}
TCL_OBJTYPE_V1(TclLengthOne)
};
const TclObjTypeWithAbstractList tclIntType = {
{"int", /* name */
const Tcl_ObjType tclIntType = {
"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
TclLengthOne
)}
TCL_OBJTYPE_V1(TclLengthOne)
};
const TclObjTypeWithAbstractList tclBignumType = {
{"bignum", /* name */
const Tcl_ObjType tclBignumType = {
"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
TclLengthOne
)}
TCL_OBJTYPE_V1(TclLengthOne)
};
/*
@@ -388,15 +377,24 @@ TclInitObjSubsystem(void)
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
Tcl_RegisterObjType(&tclDoubleType.objType);
Tcl_RegisterObjType(&tclDoubleType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType.objType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
Tcl_RegisterObjType(&oldIntType);
#endif
Tcl_RegisterObjType(&oldBooleanType);
#endif
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced = 0;
@@ -554,13 +552,13 @@ ContLineLoc *
TclContinuationsEnter(
Tcl_Obj *objPtr,
Tcl_Size num,
int *loc)
Tcl_Size *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(Tcl_Size));
if (!newEntry) {
/*
@@ -588,7 +586,7 @@ TclContinuationsEnter(
}
clLocPtr->num = num;
memcpy(&clLocPtr->loc, loc, num*sizeof(int));
memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size));
clLocPtr->loc[num] = CLL_END; /* Sentinel */
Tcl_SetHashValue(hPtr, clLocPtr);
@@ -617,12 +615,12 @@ TclContinuationsEnter(
void
TclContinuationsEnterDerived(
Tcl_Obj *objPtr,
int start,
int *clNext)
Tcl_Size start,
Tcl_Size *clNext)
{
Tcl_Size length;
int end, num;
int *wordCLLast = clNext;
Tcl_Size end, num;
Tcl_Size *wordCLLast = clNext;
/*
* We have to handle invisible continuations lines here as well, despite
@@ -665,7 +663,7 @@ TclContinuationsEnterDerived(
num = wordCLLast - clNext;
if (num) {
int i;
Tcl_Size i;
ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
/*
@@ -1528,14 +1526,6 @@ TclObjBeingDeleted(
* Create and return a new object that is a duplicate of the argument
* object.
*
* TclDuplicatePureObj --
* Like Tcl_DuplicateObj, except that it converts the duplicate to the
* specifid typ, does not duplicate the 'bytes'
* field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
* updateStringProc. This can avoid an expensive memory allocation since
* the data in the 'bytes' field of each Tcl_Obj must reside in allocated
* memory.
*
* Results:
* The return value is a pointer to a newly created Tcl_Obj. This object
* has reference count 0 and the same type, if any, as the source object
@@ -1587,111 +1577,6 @@ Tcl_DuplicateObj(
return dupPtr;
}
/*
*----------------------------------------------------------------------
*
* TclDuplicatePureObj --
*
* Duplicates a Tcl_Obj and converts the internal representation of the
* duplicate to the given type, changing neither the 'bytes' field
* nor the internal representation of the original object, and without
* duplicating the bytes field unless necessary, i.e. unless the
* duplicate provides no updateStringProc after conversion. This can
* avoid an expensive memory allocation since the data in the 'bytes'
* field of each Tcl_Obj must reside in allocated memory.
*
* Results:
* A pointer to a newly-created Tcl_Obj or NULL if there was an error.
* This object has reference count 0. Also:
*
*----------------------------------------------------------------------
*/
int SetDuplicatePureObj(
Tcl_Interp *interp,
Tcl_Obj *dupPtr,
Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr)
{
char *bytes = objPtr->bytes;
int status = TCL_OK;
TclInvalidateStringRep(dupPtr);
assert(dupPtr->typePtr == NULL);
if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
} else {
dupPtr->internalRep = objPtr->internalRep;
dupPtr->typePtr = objPtr->typePtr;
}
if (typePtr != NULL && dupPtr->typePtr != typePtr) {
if (bytes) {
dupPtr->bytes = bytes;
dupPtr->length = objPtr->length;
}
/* borrow bytes from original object */
status = Tcl_ConvertToType(interp, dupPtr, typePtr);
if (bytes) {
dupPtr->bytes = NULL;
dupPtr->length = 0;
}
if (status != TCL_OK) {
return status;
}
}
/* tclStringType is treated as a special case because a Tcl_Obj having this
* type can not always update the string representation. This happens, for
* example, when Tcl_GetCharLength() converts the internal representation
* to tclStringType in order to store the number of characters, but does
* not store enough information to generate the string representation.
*
* Perhaps in the future this can be remedied and this special treatment
* removed.
*/
if (bytes && (dupPtr->typePtr == NULL
|| dupPtr->typePtr->updateStringProc == NULL
|| typePtr == &tclStringType
)
) {
if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"insufficient memory to initialize string", -1));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
status = TCL_ERROR;
}
}
return status;
}
Tcl_Obj *
TclDuplicatePureObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
const Tcl_ObjType *typePtr
) /* The object to duplicate. */
{
int status;
Tcl_Obj *dupPtr;
TclNewObj(dupPtr);
status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
if (status == TCL_OK) {
return dupPtr;
} else {
Tcl_DecrRefCount(dupPtr);
return NULL;
}
}
void
TclSetDuplicateObj(
Tcl_Obj *dupPtr,
@@ -2145,11 +2030,11 @@ Tcl_GetBoolFromObj(
return TCL_ERROR;
}
do {
if (objPtr->typePtr == &tclIntType.objType || objPtr->typePtr == &tclBooleanType.objType) {
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
result = (objPtr->internalRep.wideValue != 0);
goto boolEnd;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
/*
* Caution: Don't be tempted to check directly for the "double"
* Tcl_ObjType and then compare the internalrep to 0.0. This isn't
@@ -2166,7 +2051,7 @@ Tcl_GetBoolFromObj(
result = (d != 0.0);
goto boolEnd;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
result = 1;
boolEnd:
if (charPtr != NULL) {
@@ -2234,18 +2119,18 @@ TclSetBooleanFromAny(
*/
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
goto badBoolean;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
}
@@ -2376,13 +2261,13 @@ ParseBoolean(
goodBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclBooleanType.objType;
objPtr->typePtr = &tclBooleanType;
return TCL_OK;
numericBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType.objType;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
@@ -2474,7 +2359,7 @@ Tcl_DbNewDoubleObj(
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
objPtr->typePtr = &tclDoubleType.objType;
objPtr->typePtr = &tclDoubleType;
return objPtr;
}
@@ -2547,7 +2432,7 @@ Tcl_GetDoubleFromObj(
double *dblPtr) /* Place to store resulting double. */
{
do {
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (isnan(objPtr->internalRep.doubleValue)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2560,11 +2445,11 @@ Tcl_GetDoubleFromObj(
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
TclUnpackBignum(objPtr, big);
@@ -2778,12 +2663,12 @@ Tcl_GetLongFromObj(
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#else
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
/*
* We return any integer in the range LONG_MIN to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
@@ -2802,7 +2687,7 @@ Tcl_GetLongFromObj(
goto tooLarge;
}
#endif
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -2811,7 +2696,7 @@ Tcl_GetLongFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
/*
* Must check for those bignum values that can fit in a long, even
* when auto-narrowing is enabled. Only those values in the signed
@@ -3039,11 +2924,11 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3052,7 +2937,7 @@ Tcl_GetWideIntFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideInt, even when auto-narrowing is enabled.
@@ -3124,7 +3009,7 @@ Tcl_GetWideUIntFromObj(
/* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
if (objPtr->internalRep.wideValue < 0) {
wideUIntOutOfRange:
if (interp != NULL) {
@@ -3138,10 +3023,10 @@ Tcl_GetWideUIntFromObj(
*wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
goto wideUIntOutOfRange;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideUInt, even when auto-narrowing is enabled.
@@ -3208,11 +3093,11 @@ TclGetWideBitsFromObj(
Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
{
do {
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3221,7 +3106,7 @@ TclGetWideBitsFromObj(
}
return TCL_ERROR;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
mp_int big;
mp_err err;
@@ -3325,7 +3210,7 @@ DupBignum(
mp_int bignumVal;
mp_int bignumCopy;
copyPtr->typePtr = &tclBignumType.objType;
copyPtr->typePtr = &tclBignumType;
TclUnpackBignum(srcPtr, bignumVal);
if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
Tcl_Panic("initialization failure in DupBignum");
@@ -3495,7 +3380,7 @@ GetBignumFromObj(
mp_int *bignumValue) /* Returned bignum value. */
{
do {
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
if (copy || Tcl_IsShared(objPtr)) {
mp_int temp;
@@ -3520,14 +3405,14 @@ GetBignumFromObj(
}
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
if (mp_init_i64(bignumValue,
objPtr->internalRep.wideValue) != MP_OKAY) {
return TCL_ERROR;
}
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3687,7 +3572,7 @@ TclSetBignumInternalRep(
void *big)
{
mp_int *bignumValue = (mp_int *)big;
objPtr->typePtr = &tclBignumType.objType;
objPtr->typePtr = &tclBignumType;
PACK_BIGNUM(*bignumValue, objPtr);
/*
@@ -3730,7 +3615,7 @@ Tcl_GetNumberFromObj(
int *typePtr)
{
do {
if (objPtr->typePtr == &tclDoubleType.objType) {
if (objPtr->typePtr == &tclDoubleType) {
if (isnan(objPtr->internalRep.doubleValue)) {
*typePtr = TCL_NUMBER_NAN;
} else {
@@ -3739,12 +3624,12 @@ Tcl_GetNumberFromObj(
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->typePtr == &tclIntType) {
*typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType.objType) {
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
sizeof(mp_int));
@@ -4705,7 +4590,7 @@ Tcl_RepresentationCmd(
objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
if (objv[1]->typePtr == &tclDoubleType.objType) {
if (objv[1]->typePtr == &tclDoubleType) {
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
objv[1]->internalRep.doubleValue);
} else {
+11 -12
View File
@@ -1072,7 +1072,7 @@ ParseTokens(
* termination information. */
{
char type;
int originalTokens;
Tcl_Size originalTokens;
int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
@@ -1106,7 +1106,7 @@ ParseTokens(
tokenPtr->size = src - tokenPtr->start;
parsePtr->numTokens++;
} else if (*src == '$') {
int varToken;
Tcl_Size varToken;
if (noSubstVars) {
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -1233,7 +1233,7 @@ ParseTokens(
*/
if (mask & TYPE_SPACE) {
if ((int)parsePtr->numTokens == originalTokens) {
if (parsePtr->numTokens == originalTokens) {
goto finishToken;
}
break;
@@ -1254,7 +1254,7 @@ ParseTokens(
Tcl_Panic("ParseTokens encountered unknown character");
}
}
if ((int)parsePtr->numTokens == originalTokens) {
if (parsePtr->numTokens == originalTokens) {
/*
* There was nothing in this range of text. Add an empty token for the
* empty range, so that there is always at least one token added.
@@ -1651,8 +1651,7 @@ Tcl_ParseBraces(
{
Tcl_Token *tokenPtr;
const char *src;
int startIndex, level;
Tcl_Size length;
Tcl_Size length, startIndex, level;
if (numBytes < 0 && start) {
numBytes = strlen(start);
@@ -1703,7 +1702,7 @@ Tcl_ParseBraces(
*/
if ((src != tokenPtr->start)
|| ((int)parsePtr->numTokens == startIndex)) {
|| (parsePtr->numTokens == startIndex)) {
tokenPtr->size = (src - tokenPtr->start);
parsePtr->numTokens++;
}
@@ -2122,7 +2121,7 @@ TclSubstTokens(
* integer representing the number of tokens
* left to be substituted will be written */
Tcl_Size line, /* The line the script starts on. */
int *clNextOuter, /* Information about an outer context for */
Tcl_Size *clNextOuter, /* Information about an outer context for */
const char *outerScript) /* continuation line data. This is set by
* EvalEx() to properly handle [...]-nested
* commands. The 'outerScript' refers to the
@@ -2145,7 +2144,7 @@ TclSubstTokens(
#define NUM_STATIC_POS 20
int isLiteral;
Tcl_Size i, maxNumCL, numCL, adjust;
int *clPosition = NULL;
Tcl_Size *clPosition = NULL;
Interp *iPtr = (Interp *) interp;
int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
@@ -2180,7 +2179,7 @@ TclSubstTokens(
if (isLiteral) {
maxNumCL = NUM_STATIC_POS;
clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
}
adjust = 0;
@@ -2230,8 +2229,8 @@ TclSubstTokens(
if (numCL >= maxNumCL) {
maxNumCL *= 2;
clPosition = (int *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(int));
clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
maxNumCL * sizeof(Tcl_Size));
}
clPosition[numCL] = clPos;
numCL++;
+4 -4
View File
@@ -73,12 +73,12 @@ EXTERN void Tcl_WinConvertError(unsigned errCode);
/* 0 */
EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
const char *bundleName, int hasResourceFile,
int maxPathLen, char *libraryPath);
Tcl_Size maxPathLen, char *libraryPath);
/* 1 */
EXTERN int Tcl_MacOSXOpenVersionedBundleResources(
Tcl_Interp *interp, const char *bundleName,
const char *bundleVersion,
int hasResourceFile, int maxPathLen,
int hasResourceFile, Tcl_Size maxPathLen,
char *libraryPath);
/* 2 */
EXTERN void Tcl_MacOSXNotifierAddRunLoopMode(
@@ -96,8 +96,8 @@ typedef struct TclPlatStubs {
void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 0 */
int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size maxPathLen, char *libraryPath); /* 1 */
void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;
+8 -8
View File
@@ -268,7 +268,7 @@ Tcl_ProcObjCmd(
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
@@ -495,8 +495,8 @@ TclCreateProc(
if (precompiled) {
if (numArgs > procPtr->numArgs) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
"precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
"procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, "
"precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs,
procPtr->numArgs));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
@@ -590,7 +590,7 @@ TclCreateProc(
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|| (localPtr->defValuePtr != NULL && fieldCount != 2)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is "
"inconsistent with precompiled body", procName, i));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"BYTECODELIES", NULL);
@@ -1067,7 +1067,7 @@ ProcWrongNumArgs(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
@@ -1348,7 +1348,7 @@ InitArgsAndLocals(
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
@@ -2547,7 +2547,7 @@ SetLambdaFromAny(
if (contextPtr->line
&& (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
int buf[2];
Tcl_Size buf[2];
/*
* Move from approximation (line of list cmd word) to actual
@@ -2559,7 +2559,7 @@ SetLambdaFromAny(
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
+1 -1
View File
@@ -1046,7 +1046,7 @@ Tcl_ScanObjCmd(
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
const Tcl_ObjInternalRep *irPtr
= TclFetchInternalRep(objPtr, &tclDoubleType.objType);
= TclFetchInternalRep(objPtr, &tclDoubleType);
if (irPtr) {
dvalue = irPtr->doubleValue;
} else
+6 -6
View File
@@ -555,7 +555,7 @@ TclParseNumber(
/* A dict can never be a (single) number */
return TCL_ERROR;
}
if (TclHasInternalRep(objPtr, &tclListType.objType)) {
if (TclHasInternalRep(objPtr, &tclListType)) {
Tcl_Size length;
/* A list can only be a (single) number if its length == 1 */
TclListObjLengthM(NULL, objPtr, &length);
@@ -1378,7 +1378,7 @@ TclParseNumber(
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType.objType;
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-octalSignificandWide);
@@ -1414,7 +1414,7 @@ TclParseNumber(
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType.objType;
objPtr->typePtr = &tclIntType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-significandWide);
@@ -1446,7 +1446,7 @@ TclParseNumber(
* k = numTrailZeros+exponent-numDigitsAfterDp.
*/
objPtr->typePtr = &tclDoubleType.objType;
objPtr->typePtr = &tclDoubleType;
if (exponentSignum) {
/*
* At this point exponent>=0, so the following calculation
@@ -1497,14 +1497,14 @@ TclParseNumber(
} else {
objPtr->internalRep.doubleValue = HUGE_VAL;
}
objPtr->typePtr = &tclDoubleType.objType;
objPtr->typePtr = &tclDoubleType;
break;
#ifdef IEEE_FLOATING_POINT
case sNAN:
case sNANFINISH:
objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
objPtr->typePtr = &tclDoubleType.objType;
objPtr->typePtr = &tclDoubleType;
break;
#endif
case INITIAL:
+602
View File
@@ -0,0 +1,602 @@
/*
* tclStringList.c --
*
* This file contains the StringList concrete abstract list
* implementation. It implements a view of a string as a list of
* of characters.
*
* Copyright © 2023 Ashok P. Nadkarni
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tcl.h"
#include "tclInt.h"
#include <assert.h>
#include <math.h>
/*
* The structure below defines the StringList Tcl_ObjType. Implementation
* stores the target Tcl_Obj being split in the internal representation of the
* abstract list Tcl_Obj. List operations are then mapped to the corresponding
* string operations. This makes per character processing of the form
* foreach ch [split $str ""] {...}
* less expensive for large strings.
*
* The source string is stored in the internalRep.twpPtrValue.ptr1 field.
* The ptr2 field holds a StringListInfo struct with ancillary information
* as below. If ptr2 is NULL, list covers all elements of source string.
*/
typedef struct StringListInfo {
Tcl_Size startIndex; /* Starting index in source string where this list
begins. Used for fast range operations */
Tcl_Size count; /* Number of elements in list. If negative, count
is entire source string */
int flags;
#define STRINGLIST_REVERSE 0x01 /* If set, reverse element order */
} StringListInfo;
/* -------------------------- StringList object ---------------------------- */
static int StringListObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
Tcl_Size index, Tcl_Obj **elemObj);
static Tcl_Size StringListObjLength(Tcl_Obj *strListObj);
static int StringListObjRange(Tcl_Interp *interp, Tcl_Obj *strListObj,
Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
static int StringListObjReverse(Tcl_Interp *interp, Tcl_Obj *strListObj, Tcl_Obj **newObjPtr);
static void DupStringListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeStringListInternalRep(Tcl_Obj *strListObj);
static void UpdateStringOfStringList(Tcl_Obj *strListObj);
static const Tcl_ObjType stringListType = {
"stringlist", /* name */
FreeStringListInternalRep, /* freeIntRepProc */
DupStringListInternalRep, /* dupIntRepProc */
UpdateStringOfStringList, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V2(
StringListObjLength,
StringListObjIndex,
StringListObjRange,
StringListObjReverse,
NULL, /* GetElements */
NULL, /* SetElement */
NULL, /* Replace */
NULL) /* "in" operator */
};
/* Returns the source for a StringList, NULL if objPtr is not a StringList */
static inline Tcl_Obj *
StringListGetSourceObj(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), &stringListType);
return irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;
}
/*
* Returns the ancillary information about a StringList. May return an
* NULL either because objPtr is not a StringList or because it has no
* ancillary information. Use StringListGetSourceObj to distinguish.
*/
static inline StringListInfo *
StringListGetInfo(Tcl_Obj *objPtr)
{
const Tcl_ObjInternalRep *irPtr;
irPtr = TclFetchInternalRep((objPtr), &stringListType);
return irPtr ? (StringListInfo *)irPtr->twoPtrValue.ptr2 : NULL;
}
/*
*----------------------------------------------------------------------
*
* DupStringListInternalRep --
*
* Initialize the internal representation of a StringList Tcl_Obj to a
* copy of the internal representation of an existing one.
*
* Results:
* None.
*
* Side effects:
* We set "copyPtr"s internal rep to a newly allocated structure.
*----------------------------------------------------------------------
*/
static void
DupStringListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
/* Copy the source string and hold a reference */
Tcl_Obj *srcStringObj = StringListGetSourceObj(srcPtr);
copyPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
/* Copy the ancillary information if there is any. */
StringListInfo *srcInfoPtr = StringListGetInfo(srcPtr);
if (srcInfoPtr) {
StringListInfo *copyInfoPtr;
copyInfoPtr = (StringListInfo *)Tcl_Alloc(sizeof(*copyInfoPtr));
*copyInfoPtr = *srcInfoPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = copyInfoPtr;
} else {
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
copyPtr->typePtr = &stringListType;
}
/*
*----------------------------------------------------------------------
*
* FreeStringListInternalRep --
*
* Free any allocated memory in the StringList Rep
*
* Results:
* None.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
static void
FreeStringListInternalRep(Tcl_Obj *strListObj)
{
Tcl_Obj *srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
if (srcStringObj) {
Tcl_DecrRefCount(srcStringObj);
}
StringListInfo *infoPtr = StringListGetInfo(strListObj);
if (infoPtr) {
Tcl_Free(infoPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclNewStringListObj --
*
* Creates a new StringList object formed by splitting the source string
* object.
*
* Results:
*
* A Tcl_Obj pointer to the created StringList object with ref count 0.
*
* Side Effects:
*
* None.
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclNewStringListObj(
TCL_UNUSED(Tcl_Interp *),
Tcl_Obj *srcStringObj) /* String to split */
{
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_InvalidateStringRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &stringListType;
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* StringListGetExtent
*
* Gets the starting index and length subrange within the source string
* that comprises this list.
*
* Results:
*
* Returns the length of the list.
*
* Side Effects:
*
* The starting index in the source string is stored in startIndexPtr
* if it is not NULL.
*----------------------------------------------------------------------
*/
static Tcl_Size
StringListGetExtent(Tcl_Obj *strListObj, Tcl_Size *startIndexPtr, Tcl_Size *numCharsPtr, int *reversedPtr)
{
Tcl_Obj *srcStringObj;
StringListInfo *infoPtr;
Tcl_Size numChars;
Tcl_Size listLen;
Tcl_Size startIndex;
int reversed;
srcStringObj = StringListGetSourceObj(strListObj);
infoPtr = StringListGetInfo(strListObj);
assert(srcStringObj);
numChars = Tcl_GetCharLength(srcStringObj);
if (infoPtr) {
/* The list is a subrange of the string */
startIndex = infoPtr->startIndex;
if (infoPtr->count >= 0) {
listLen = infoPtr->count;
assert(listLen <= numChars);
}
else {
listLen = numChars - startIndex;
}
reversed = (infoPtr->flags & STRINGLIST_REVERSE) != 0;
} else {
startIndex = 0;
listLen = numChars;
reversed = 0;
}
assert(listLen <= numChars);
assert(startIndex == 0 || startIndex < numChars);
assert(startIndex <= (numChars - listLen));
if (startIndexPtr) {
*startIndexPtr = startIndex;
}
if (numCharsPtr) {
*numCharsPtr = numChars;
}
if (reversedPtr) {
*reversedPtr = reversed;
}
return listLen;
}
/*
*----------------------------------------------------------------------
*
* StringListObjIndex --
*
* Returns the element with the specified index in the list. If index
* is out of range, an empty Tcl_Obj is returned.
*
* Results:
*
* TCL_OK on success.
*
* Side Effects:
*
* On success, the
*
*----------------------------------------------------------------------
*/
int
StringListObjIndex(
TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
Tcl_Obj *strListObj, /* List obj */
Tcl_Size index, /* index to element of interest */
Tcl_Obj **elemObj) /* Return value */
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Obj *srcStringObj;
int reversed;
Tcl_Size strIndex;
if (index < 0) {
goto outOfBounds;
}
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
if (index >= listLen) {
goto outOfBounds;
}
/*
* The index into the string depends on whether the list is only a
* substring of the string and whether it is reversed.
*/
if (reversed) {
strIndex = startIndex + listLen - index - 1;
} else {
strIndex = startIndex + index;
}
char buf[TCL_UTF_MAX];
int utfLen;
assert(strIndex <
Tcl_GetCharLength(srcStringObj));
Tcl_UniChar ch = Tcl_GetUniChar(srcStringObj, strIndex);
utfLen = Tcl_UniCharToUtf(ch, buf);
*elemObj = Tcl_NewStringObj(buf, utfLen);
return TCL_OK;
outOfBounds:
/* TODO - NULL or empty obj? */
*elemObj = Tcl_NewObj();
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringListObjLength
*
* Returns the length of the StringList
*
* Results:
*
* The length of the list.
*
* Side Effects:
*
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Size StringListObjLength(Tcl_Obj *strListObj)
{
return StringListGetExtent(strListObj, NULL, NULL, NULL);
}
/*
*----------------------------------------------------------------------
*
* StringListObjRange --
*
* Makes a slice of an StringList.
*
* Results:
* Returns a pointer to the sliced series.
* This may be a new object or the same object if not shared.
*
* Side effects:
* ?The possible conversion of the object referenced by listPtr?
* ?to a list object.?
*
*----------------------------------------------------------------------
*/
int
StringListObjRange(
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
Tcl_Obj *strListObj, /* List object to take a range from. */
Tcl_Size fromIdx, /* Index of first element to include. */
Tcl_Size toIdx, /* Index of last element to include. */
Tcl_Obj **newObjPtr) /* return value */
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Obj *srcStringObj;
int reversed;
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
if (fromIdx < 0) {
fromIdx = 0;
}
if (toIdx >= listLen) {
toIdx = listLen - 1;
}
if (fromIdx > toIdx ||
fromIdx >= listLen) {
TclNewObj(*newObjPtr);
return TCL_OK;
}
assert(fromIdx >= 0);
assert(toIdx >= fromIdx);
assert(listLen > toIdx);
/*
* We could do a Tcl_Range to allocate a new string but instead
* keep the old one and just add ancillary information specifying
* range and reverse setting.
*/
StringListInfo *infoPtr;
infoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*infoPtr));
infoPtr->count = toIdx - fromIdx + 1;
if (reversed) {
infoPtr->startIndex = startIndex + listLen - toIdx - 1;
infoPtr->flags = STRINGLIST_REVERSE;
} else {
infoPtr->startIndex = startIndex + fromIdx;
infoPtr->flags = 0;
assert(fromIdx < Tcl_GetCharLength(strListObj));
assert(toIdx < Tcl_GetCharLength(strListObj));
}
Tcl_Obj *newObj = Tcl_NewObj();
Tcl_InvalidateStringRep(newObj);
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
newObj->internalRep.twoPtrValue.ptr2 = infoPtr;
newObj->typePtr = &stringListType;
*newObjPtr = newObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* StringListObjReverse --
*
* Reverse the order of the StringList value.
*
* Results:
* The result will be StringList in the reverse order.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
int
StringListObjReverse(
TCL_UNUSED(Tcl_Interp *), /* For error message(s) */
Tcl_Obj *strListObj, /* List object to reverse. */
Tcl_Obj **newObjPtr)
{
Tcl_Obj *srcStringObj, *newObj;
StringListInfo *infoPtr, *newInfoPtr;
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
newObj = Tcl_NewObj();
Tcl_InvalidateStringRep(newObj);
newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
Tcl_IncrRefCount(srcStringObj);
newObj->typePtr = &stringListType;
infoPtr = StringListGetInfo(strListObj);
if (infoPtr) {
if (infoPtr->startIndex == 0 && infoPtr->count < 0 &&
(infoPtr->flags & STRINGLIST_REVERSE)) {
/* No need for ancillary information */
newInfoPtr = NULL;
} else {
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
newInfoPtr->startIndex = infoPtr->startIndex;
newInfoPtr->count = infoPtr->count;
newInfoPtr->flags = infoPtr->flags ^ STRINGLIST_REVERSE;
}
} else {
newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
newInfoPtr->startIndex = 0;
newInfoPtr->count = -1; /* Entire string */
newInfoPtr->flags = STRINGLIST_REVERSE;
}
newObj->internalRep.twoPtrValue.ptr2 = newInfoPtr;
*newObjPtr = newObj;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfStringList --
*
* Update the string representation for an StringList object.
* Note: This procedure does not invalidate an existing old string rep
* so storage will be lost if this has not already been done.
*
* Results:
* None.
*
* Side effects:
* The object's string is set to a valid string that results from
* the list-to-string conversion. This string will be empty if the
* list has no elements. The list internal representation
* should be a StringList when this function is called.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfStringList(Tcl_Obj *strListObj)
{
Tcl_Size listLen;
Tcl_Size startIndex;
Tcl_Size numChars;
Tcl_Obj *srcStringObj;
int reversed;
assert(strListObj->bytes == NULL);
srcStringObj = StringListGetSourceObj(strListObj);
assert(srcStringObj);
listLen =
StringListGetExtent(strListObj, &startIndex, &numChars, &reversed);
if (listLen == 0) {
Tcl_InitStringRep(strListObj, NULL, 0);
return;
}
if (reversed) {
Tcl_Obj *tempObj = TclStringReverse(srcStringObj, TCL_STRING_IN_PLACE);
/* NOTE: TclStringReverse may return same or different Tcl_Obj! */
srcStringObj = tempObj;
startIndex = numChars - (startIndex + listLen) - 1;
}
/* srcStringObj may be original or newly allocated so we have to decrref later */
Tcl_IncrRefCount(srcStringObj);
const char *utf;
const char *utfStart = Tcl_GetString(srcStringObj);
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Tcl_Size i, bytesNeeded;
int utfLen, uniChar;
utfStart = Tcl_UtfAtIndex(utfStart, startIndex);
/* Pass 1: estimate space, gather flags. */
if (listLen <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
/* We know numElems <= LIST_MAX, so this is safe. */
flagPtr = (char *)Tcl_Alloc(listLen);
}
for (i = 0, bytesNeeded = 0, utf = utfStart; i < listLen; ++i) {
flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
bytesNeeded += TclScanElement(utf, utfLen, flagPtr+i);
if (bytesNeeded > TCL_SIZE_MAX - listLen) {
Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
}
utf += utfLen;
}
bytesNeeded += listLen - 1; /* Room for space separators */
/*
* Pass 2: copy into string rep buffer.
*/
char * const dstStart = Tcl_InitStringRep(strListObj, NULL, bytesNeeded);
char *dst;
TclOOM(dstStart, bytesNeeded);
for (i = 0, dst = dstStart, utf = utfStart; i < listLen; ++i) {
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
utfLen = Tcl_UtfToUniChar(utf, &uniChar);
dst += TclConvertElement(utf, utfLen, dst, flagPtr[i]);
*dst++ = ' ';
utf += utfLen;
}
/* Set the string length to what was actually written, the safe choice */
(void) Tcl_InitStringRep(strListObj, NULL, dst - 1 - dstStart);
Tcl_DecrRefCount(srcStringObj);
if (flagPtr != localFlags) {
Tcl_Free(flagPtr);
}
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+2 -1
View File
@@ -102,8 +102,9 @@
static void uniCodePanic() {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, void *))(void *)uniCodePanic
# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
+4 -1
View File
@@ -741,6 +741,10 @@ Tcltest_Init(
}
#endif
if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
/*
* Check for special options used in ../tests/main.test
*/
@@ -8802,4 +8806,3 @@ vamoose:
* indent-tabs-mode: nil
* End:
*/
File diff suppressed because it is too large Load Diff
+65 -6
View File
@@ -891,6 +891,7 @@ TestlistobjCmd(
"replace",
"indexmemcheck",
"getelementsmemcheck",
"index",
NULL
};
enum listobjCmdIndex {
@@ -899,6 +900,7 @@ TestlistobjCmd(
LISTOBJ_REPLACE,
LISTOBJ_INDEXMEMCHECK,
LISTOBJ_GETELEMENTSMEMCHECK,
LISTOBJ_INDEX,
} cmdIndex;
Tcl_Size varIndex; /* Variable number converted to binary */
@@ -974,12 +976,13 @@ TestlistobjCmd(
!= TCL_OK) {
return TCL_ERROR;
}
if (objP->refCount <= 0) {
if (objP->refCount < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Tcl_ListObjIndex returned object with ref count <= 0",
"Tcl_ListObjIndex returned object with ref count < 0",
TCL_INDEX_NONE));
/* Keep looping since we are also looping for leaks */
}
Tcl_BounceRefCount(objP);
}
break;
@@ -1006,6 +1009,26 @@ TestlistobjCmd(
}
}
break;
case LISTOBJ_INDEX:
/*
* Tcl_ListObjIndex semantics differ from lindex for out of bounds.
* Hence this explicit test.
*/
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"varIndex listIndex");
return TCL_ERROR;
}
if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) {
return TCL_ERROR;
} else {
Tcl_Obj *objP;
if (Tcl_ListObjIndex(interp, varPtr[varIndex], first, &objP) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, objP ? objP : Tcl_NewStringObj("null", -1));
}
break;
}
return TCL_OK;
}
@@ -1027,6 +1050,33 @@ TestlistobjCmd(
*----------------------------------------------------------------------
*/
static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
return 100;
}
static int V1TestListObjIndex(
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(Tcl_Obj *),
TCL_UNUSED(Tcl_Size),
Tcl_Obj **objPtr)
{
*objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
return TCL_OK;
}
static const Tcl_ObjType v1TestListType = {
"testlist", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
offsetof(Tcl_ObjType, indexProc), /* This is a V1 objType, which doesn't have an indexProc */
V1TestListObjLength, /* always return 100, doesn't really matter */
V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
NULL, NULL, NULL, NULL, NULL, NULL
};
static int
TestobjCmd(
TCL_UNUSED(void *),
@@ -1039,15 +1089,15 @@ TestobjCmd(
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
const char *subcommands[] = {
"freeallvars", "bug3598580", "types",
"objtype", "newobj", "set",
"freeallvars", "bug3598580", "buge58d7e19e9",
"types", "objtype", "newobj", "set",
"assign", "convert", "duplicate",
"invalidateStringRep", "refcount", "type",
NULL
};
enum testobjCmdIndex {
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_TYPES,
TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_BUGE58D7E19E9,
TESTOBJ_TYPES, TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
TESTOBJ_ASSIGN, TESTOBJ_CONVERT, TESTOBJ_DUPLICATE,
TESTOBJ_INVALIDATESTRINGREP, TESTOBJ_REFCOUNT, TESTOBJ_TYPE,
} cmdIndex;
@@ -1089,6 +1139,15 @@ TestobjCmd(
Tcl_SetObjResult(interp, listObjPtr);
}
return TCL_OK;
case TESTOBJ_BUGE58D7E19E9:
if (objc != 3) {
goto wrongNumArgs;
} else {
Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
listObjPtr->typePtr = &v1TestListType;
Tcl_SetObjResult(interp, listObjPtr);
}
return TCL_OK;
case TESTOBJ_TYPES:
if (objc != 2) {
goto wrongNumArgs;
+1 -7
View File
@@ -1,13 +1,7 @@
#ifndef BN_TCL_H_
#define BN_TCL_H_
#ifdef MP_NO_STDINT
# ifdef HAVE_STDINT_H
# include <stdint.h>
# else
# include "../compat/stdint.h"
# endif
#endif
#include <stdint.h>
#if defined(TCL_NO_TOMMATH_H)
typedef size_t mp_digit;
typedef int mp_sign;
+38 -29
View File
@@ -123,17 +123,15 @@ static int FindElement(Tcl_Interp *interp, const char *string,
* is unregistered, so has no need of a setFromAnyProc either.
*/
static const TclObjTypeWithAbstractList endOffsetType = {
{"end-offset", /* name */
static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
TCL_OBJTYPE_V0_1(
TclLengthOne
)}
TCL_OBJTYPE_V1(TclLengthOne)
};
Tcl_Size
TclLengthOne(
TCL_UNUSED(Tcl_Obj *))
@@ -1574,7 +1572,8 @@ Tcl_Merge(
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Tcl_Size i, bytesNeeded = 0;
Tcl_Size i;
size_t bytesNeeded = 0;
char *result, *dst;
/*
@@ -1583,6 +1582,9 @@ Tcl_Merge(
*/
if (argc <= 0) {
if (argc < 0) {
Tcl_Panic("Tcl_Merge called with negative argc (%" TCL_SIZE_MODIFIER "d)", argc);
}
result = (char *)Tcl_Alloc(1);
result[0] = '\0';
return result;
@@ -1975,7 +1977,8 @@ Tcl_ConcatObj(
Tcl_Size length;
objPtr = objv[i];
if (TclListObjIsCanonical(objPtr)) {
if (TclListObjIsCanonical(objPtr) ||
TclObjTypeHasProc(objPtr,indexProc)) {
continue;
}
(void)Tcl_GetStringFromObj(objPtr, &length);
@@ -1987,7 +1990,8 @@ Tcl_ConcatObj(
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
if (!TclListObjIsCanonical(objPtr)) {
if (!TclListObjIsCanonical(objPtr) &&
!TclObjTypeHasProc(objPtr,indexProc)) {
continue;
}
if (resPtr) {
@@ -2001,14 +2005,12 @@ Tcl_ConcatObj(
!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
/* Abandon ship! */
Tcl_DecrRefCount(resPtr);
Tcl_BounceRefCount(elemPtr); // could be an abstract list element
goto slow;
}
Tcl_BounceRefCount(elemPtr); // could be an an abstract list element
} else {
resPtr = TclDuplicatePureObj(
NULL, objPtr, &tclListType.objType);
if (!resPtr) {
return NULL;
}
resPtr = TclListObjCopy(NULL, objPtr);
}
}
if (!resPtr) {
@@ -2749,8 +2751,7 @@ Tcl_DStringAppendElement(
newSize += 1; /* For terminating nul */
if (newSize > dsPtr->spaceAvl) {
if (dsPtr->string == dsPtr->staticSpace) {
char *newString;
newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
char *newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, dsPtr->length);
dsPtr->string = newString;
} else {
@@ -2763,7 +2764,7 @@ Tcl_DStringAppendElement(
offset = element - dsPtr->string;
}
dsPtr->string =
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
if (offset >= 0) {
element = dsPtr->string + offset;
}
@@ -2936,7 +2937,7 @@ Tcl_DStringGetResult(
* of interp. */
{
Tcl_Obj *obj = Tcl_GetObjResult(interp);
char *bytes = TclGetString(obj);
const char *bytes = TclGetString(obj);
Tcl_DStringFree(dsPtr);
Tcl_DStringAppend(dsPtr, bytes, obj->length);
@@ -3377,6 +3378,9 @@ GetWideForIndex(
if (numType == TCL_NUMBER_INT) {
/* objPtr holds an integer in the signed wide range */
*widePtr = *(Tcl_WideInt *)cd;
if ((*widePtr < 0)) {
*widePtr = (endValue == -1) ? WIDE_MIN : -1;
}
return TCL_OK;
}
if (numType == TCL_NUMBER_BIG) {
@@ -3445,11 +3449,15 @@ Tcl_GetIntForIndex(
if (indexPtr != NULL) {
/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
if (wide >= 0 && wide <= TCL_SIZE_MAX) {
*indexPtr = (Tcl_Size)wide;
*indexPtr = (Tcl_Size)wide; /* A valid index */
} else if (wide > TCL_SIZE_MAX) {
*indexPtr = TCL_SIZE_MAX;
} else {
*indexPtr = TCL_INDEX_NONE;
*indexPtr = TCL_SIZE_MAX; /* Beyond max possible index */
} else if (wide < -1-TCL_SIZE_MAX) {
*indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
} else if ((wide < 0) && (endValue >= 0)) {
*indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
} else {
*indexPtr = (Tcl_Size) wide;
}
}
return TCL_OK;
@@ -3497,7 +3505,7 @@ GetEndOffsetFromObj(
Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */
void *cd;
while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType)) == NULL) {
while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
Tcl_ObjInternalRep ir;
Tcl_Size length;
const char *bytes = Tcl_GetStringFromObj(objPtr, &length);
@@ -3683,21 +3691,22 @@ GetEndOffsetFromObj(
parseOK:
/* Success. Store the new internal rep. */
ir.wideValue = offset;
Tcl_StoreInternalRep(objPtr, &endOffsetType.objType, &ir);
Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
}
offset = irPtr->wideValue;
if (offset == WIDE_MAX) {
/*
* Encodes end+1. This is distinguished from end+n as noted above
* Encodes end+1. This is distinguished from end+n as noted
* in function header.
* NOTE: this may wrap around if the caller passes (as lset does)
* listLen-1 as endValue and and listLen is 0. The -1 will be
* interpreted as FF...FF and adding 1 will result in 0 which
* is what we want. 2's complements shenanigans but it is what
* it is ...
* is what we want. Callers like lset which pass in listLen-1 == -1
* as endValue will have to adjust accordingly.
*/
*widePtr = endValue + 1;
*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
} else if (offset == WIDE_MIN) {
/* -1 - position before first */
*widePtr = -1;
@@ -3835,7 +3844,7 @@ TclIndexEncode(
*/
const Tcl_ObjInternalRep *irPtr =
TclFetchInternalRep(objPtr, &endOffsetType.objType);
TclFetchInternalRep(objPtr, &endOffsetType);
if (irPtr && irPtr->wideValue >= 0) {
/*
+12 -11
View File
@@ -245,7 +245,8 @@ static Tcl_DupInternalRepProc DupParsedVarName;
static const Tcl_ObjType localVarNameType = {
"localVarName",
FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0
FreeLocalVarName, DupLocalVarName, NULL, NULL,
TCL_OBJTYPE_V0
};
#define LocalSetInternalRep(objPtr, index, namePtr) \
@@ -268,7 +269,8 @@ static const Tcl_ObjType localVarNameType = {
static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0
FreeParsedVarName, DupParsedVarName, NULL, NULL,
TCL_OBJTYPE_V0
};
#define ParsedSetInternalRep(objPtr, arrayPtr, elem) \
@@ -376,7 +378,7 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
&& (VarHashRefCount(varPtr) == (unsigned)
&& (VarHashRefCount(varPtr) == (Tcl_Size)
!TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
Tcl_Free(varPtr);
@@ -386,7 +388,7 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
(VarHashRefCount(arrayPtr) == (unsigned)
(VarHashRefCount(arrayPtr) == (Tcl_Size)
!TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
Tcl_Free(arrayPtr);
@@ -841,8 +843,8 @@ TclLookupSimpleVar(
* the variable. */
Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
ResolverScheme *resPtr;
int isNew, i, result;
Tcl_Size varLen;
int isNew, result;
Tcl_Size i, varLen;
const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);
varPtr = NULL;
@@ -967,7 +969,7 @@ TclLookupSimpleVar(
}
}
} else { /* Local var: look in frame varFramePtr. */
int localCt = varFramePtr->numCompiledLocals;
Tcl_Size localCt = varFramePtr->numCompiledLocals;
if (localCt > 0) {
Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
@@ -3097,7 +3099,7 @@ ArrayForNRCmd(
* loop) don't vanish.
*/
varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
varListObj = TclListObjCopy(NULL, objv[1]);
if (!varListObj) {
return TCL_ERROR;
}
@@ -4073,8 +4075,7 @@ ArraySetCmd(
* the loop and return an error.
*/
copyListObj =
TclDuplicatePureObj(interp, arrayElemObj, &tclListType.objType);
copyListObj = TclListObjCopy(NULL, arrayElemObj);
if (!copyListObj) {
return TCL_ERROR;
}
@@ -5421,7 +5422,7 @@ TclDeleteCompiledLocalVars(
* assigned local variables to delete. */
{
Var *varPtr;
size_t numLocals, i;
Tcl_Size numLocals, i;
Tcl_Obj **namePtrPtr;
numLocals = framePtr->numCompiledLocals;
+4 -9
View File
@@ -273,15 +273,11 @@ static struct {
* they are believed to not be UTF-8; only
* written to from Tcl code in a trusted
* interpreter, so not protected by mutex. */
Tcl_Encoding utf8; /* The UTF-8 encoding that we prefer to use
* for the strings (especially filenames)
* embedded in a ZIP. Other encodings are used
* dynamically. */
int idCount; /* Counter for channel names */
Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
} ZipFS = {
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, 0,
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
{0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
};
@@ -743,7 +739,7 @@ DecodeZipEntryText(
while (1) {
int srcRead, dstWrote;
int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
int result = Tcl_ExternalToUtf(NULL, tclUtf8Encoding, src, srcLen, flags,
&state, dst, dstLen, &srcRead, &dstWrote, NULL);
int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
@@ -1860,7 +1856,6 @@ ZipfsSetup(void)
ZipFS.fallbackEntryEncoding = (char *)
Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
ZipFS.initialized = 1;
Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
}
@@ -2541,7 +2536,7 @@ ZipAddFile(
* crazy enough to embed NULs in filenames, they deserve what they get!
*/
zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
zpathExt = Tcl_UtfToExternalDString(tclUtf8Encoding, zpathTcl, -1, &zpathDs);
zpathlen = strlen(zpathExt);
if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3210,7 +3205,7 @@ ZipFSMkZipOrImg(
}
z = (ZipEntry *) Tcl_GetHashValue(hPtr);
name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds);
name = Tcl_UtfToExternalDString(tclUtf8Encoding, z->name, TCL_INDEX_NONE, &ds);
len = Tcl_DStringLength(&ds);
SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
z, len);
+6 -4
View File
@@ -29,6 +29,7 @@ namespace eval tcltest {
# yourself. You don't need tcltest to wrap it for you.
variable version [package provide Tcl]
variable patchLevel [info patchlevel]
variable fullutf [package vsatisfies $version 8.7-]
##### Export the public tcltest procs; several categories
#
@@ -1150,16 +1151,17 @@ proc tcltest::SafeFetch {n1 n2 op} {
# None.
proc tcltest::Asciify {s} {
variable fullutf
set print ""
foreach c [split $s ""] {
if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} {
append print $c
} elseif {$c <= "\xFF"} {
} elseif {$c < "\u0100"} {
append print \\x[format %02X [scan $c %c]]
} elseif {$c <= "\xFFFF"} {
append print \\u[format %04X [scan $c %c]]
} else {
} elseif {$fullutf && ($c >= "\U10000")} {
append print \\U[format %08X [scan $c %c]]
} else {
append print \\u[format %04X [scan $c %c]]
}
}
return $print
+1 -4
View File
@@ -4,10 +4,7 @@
#ifndef BN_H_
#define BN_H_
#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
# include <stdint.h>
#endif
#include <stdint.h>
#include <stddef.h>
#include <limits.h>
+1 -7
View File
@@ -4,13 +4,7 @@
#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_
#ifdef MP_NO_STDINT
#ifdef HAVE_STDINT_H
# include <stdint.h>
#else
# include "../compat/stdint.h"
#endif
#endif
#include <stdint.h>
#include "tclTomMath.h"
#include "tommath_class.h"
+632
View File
@@ -0,0 +1,632 @@
# Exercise AbstractList via the "lstring" command defined in tclTestABSList.c
#
# Copyright © 2022 Brian Griffin
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
}
testConstraint testevalex [llength [info commands testevalex]]
set abstractlisttestvars [info var *]
proc value-cmp {vara varb} {
upvar $vara a
upvar $varb b
set ta [tcl::unsupported::representation $a]
set tb [tcl::unsupported::representation $b]
return [string compare $ta $tb]
}
set str "If you can keep your head when all about you Are losing theirs and blaming it on you,"
set str2 "If you can trust yourself when all men doubt you, But make allowance for their doubting, too."
test abstractlist-1.0 {error cases} -body {
lstring
} \
-returnCodes 1 \
-result {wrong # args: should be "lstring string"}
test abstractlist-1.1 {error cases} -body {
lstring a b c
} -returnCodes 1 \
-result {wrong # args: should be "lstring string"}
test abstractlist-2.0 {no shimmer llength} -body {
set l [lstring $str]
set l-isa [testobj objtype $l]
set len [llength $l]
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${len} ${l-isa2}
} -cleanup {
unset l
} -result {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
test abstractlist-2.1 {no shimmer lindex} {
set l [lstring $str]
set l-isa [testobj objtype $l]
set ele [lindex $l 22]
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${ele} ${l-isa2}
} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
test abstractlist-2.2 {no shimmer lreverse} {
set l [lstring $str]
set l-isa [testobj objtype $l]
set r [lreverse $l]
set r-isa [testobj objtype $r]
set l-isa2 [testobj objtype $l]
list $r ${l-isa} ${r-isa} ${l-isa2}
} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
test abstractlist-2.3 {no shimmer lrange} {
set l [lstring $str]
set l-isa [testobj objtype $l]
set il [lsearch -all [lstring $str] { }]
set l-isa2 [testobj objtype $l]
lappend il [llength $l]
set start 0
set words [lmap i $il {
set w [join [lrange $l $start $i-1] {} ]
set start [expr {$i+1}]
set w
}]
set l-isa3 [testobj objtype $l]
list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
test abstractlist-2.4 {no shimmer foreach} {
set l [lstring $str]
set l-isa [testobj objtype $l]
set word {}
set words {}
foreach c $l {
if {$c eq { }} {
lappend words $word
set word {}
} else {
append word $c
}
}
if {$word ne ""} {
lappend words $word
}
set l-isa2 [testobj objtype $l]
list ${l-isa} ${l-isa2} $words
} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-2.5 {!no shimmer lreplace} {
set l [lstring $str2]
set l-isa [testobj objtype $l]
set m [lreplace $l 78 86 { } f a i l i n g]
set m-isa [testobj objtype $m]
set l-isa1 [testobj objtype $l]
list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring}
test abstractlist-2.6 {no shimmer ledit} {
# "ledit m 9 8 S"
set l [lstring $str2]
set l-isa [testobj objtype $l]
set e [ledit l 68 67 s]
set e-isa [testobj objtype $e]
list ${l-isa} $e ${e-isa}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
test abstractlist-2.7 {no shimmer linsert} -body {
# "ledit m 9 8 S"
set l [lstring $str2]
set l-isa [testobj objtype $l]
set i [linsert $l 11 {*}[split "truly " {}]]
set i-isa [testobj objtype $i]
set res [list ${l-isa} $i ${i-isa}]
set p [lpop i 23]
set p-isa [testobj objtype $p]
set i-isa2 [testobj objtype $i]
lappend res $p ${p-isa} $i ${i-isa2}
} -cleanup {
unset l i l-isa i-isa res p p-isa
} -result {lstring {I f { } y o u { } c a n { } t r u l y { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring y none {I f { } y o u { } c a n { } t r u l y { } t r u s t { } o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
test abstractlist-2.8 {shimmer lassign} {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lassign $l i n c]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring}
test abstractlist-2.9 {no shimmer lremove} {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lremove $l 0 1]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}
test abstractlist-2.10 {shimmer lreverse} {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lreverse $l]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}
test abstractlist-2.11 {shimmer lset} {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set m [lset l 2 k]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}
# lrepeat
test abstractlist-2.12 {shimmer lrepeat} {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set m [lrepeat 3 $l]
set m-isa [testobj objtype $m]
set n [lindex $m 1]
list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}
test abstractlist-2.13 {no shimmer join llength==1} {
set l [lstring G]
set l-isa [testobj objtype $l]
set j [join $l :]
set j-isa [testobj objtype $j]
list ${l-isa} $l ${j-isa} $j
} {lstring G none G}
test abstractlist-2.14 {error case lset multiple indicies} -body {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set m [lset l 2 0 1 k]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
-result {Multiple indicies not supported by lstring.}
# lsort
test abstractlist-3.0 {no shimmer llength} {
set l [lstring -not SLICE $str]
set l-isa [testobj objtype $l]
set len [llength $l]
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${len} ${l-isa2}
} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
test abstractlist-3.1 {no shimmer lindex} {
set l [lstring -not SLICE $str]
set l-isa [testobj objtype $l]
set n 22
set ele [lindex $l $n] ;# exercise INST_LIST_INDEX
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${ele} ${l-isa2}
} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
test abstractlist-3.2 {no shimmer lreverse} {
set l [lstring -not SLICE $str]
set l-isa [testobj objtype $l]
set r [lreverse $l]
set r-isa [testobj objtype $r]
set l-isa2 [testobj objtype $l]
list $r ${l-isa} ${r-isa} ${l-isa2}
} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
test abstractlist-3.3 {shimmer lrange} {
set l [lstring -not SLICE $str]
set l-isa [testobj objtype $l]
set il [lsearch -all [lstring -not SLICE $str] { }]
set l-isa2 [testobj objtype $l]
lappend il [llength $l]
set start 0
set words [lmap i $il {
set w [join [lrange $l $start $i-1] {} ]
set start [expr {$i+1}]
set w
}]
set l-isa3 [testobj objtype $l]; # lrange defaults to list behavior
list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring list {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
test abstractlist-3.4 {no shimmer foreach} {
set l [lstring -not SLICE $str]
set l-isa [testobj objtype $l]
set word {}
set words {}
foreach c $l {
if {$c eq { }} {
lappend words $word
set word {}
} else {
append word $c
}
}
if {$word ne ""} {
lappend words $word
}
set l-isa2 [testobj objtype $l]
list ${l-isa} ${l-isa2} $words
} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-3.5 {!no shimmer lreplace} {
set l [lstring -not SLICE $str2]
set l-isa [testobj objtype $l]
set m [lreplace $l 79 86 f a i l i n g]
set m-isa [testobj objtype $m]
set l-isa1 [testobj objtype $l]
list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring}
test abstractlist-3.6 {no shimmer ledit} {
# "ledit m 9 8 S"
set l [lstring -not SLICE $str2]
set l-isa [testobj objtype $l]
set e [ledit l 68 67 s]
set e-isa [testobj objtype $e]
list ${l-isa} $e ${e-isa}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
test abstractlist-3.7 {no shimmer linsert} {
# "ledit m 9 8 S"
set res {}
set l [lstring -not SLICE $str2]
set l-isa [testobj objtype $l]
set i [linsert $l 35 {*}[split "wo" {}]]
set i-isa [testobj objtype $i]
set res [list ${l-isa} $i ${i-isa}]
set p [lpop i 23]
set p-isa [testobj objtype $p]
set i-isa2 [testobj objtype $i]
lappend res $p ${p-isa} $i ${i-isa2}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring l none {I f { } y o u { } c a n { } t r u s t { } y o u r s e f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
test abstractlist-3.8 {shimmer lassign} {
set l [lstring -not SLICE Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lassign $l i n c] ;# must be using lrange internally
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} list list}
test abstractlist-3.9 {no shimmer lremove} {
set l [lstring -not SLICE Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lremove $l 0 1]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}
test abstractlist-3.10 {shimmer lreverse} {
set l [lstring -not SLICE Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lreverse $l]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}
test abstractlist-3.11 {shimmer lset} {
set l [lstring -not SLICE Inconceivable]
set l-isa [testobj objtype $l]
set four 4
set m [lset l $four-2 k]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}
# lrepeat
test abstractlist-3.12 {shimmer lrepeat} {
set l [lstring -not SLICE Inconceivable]
set l-isa [testobj objtype $l]
set m [lrepeat 3 $l]
set m-isa [testobj objtype $m]
set n [lindex $m 1]
list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}
# lsort
foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} {
testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}]
set options [expr {$not ne "" ? "-not $not" : ""}]
test abstractlist-$not-4.0 {no shimmer llength} {
set l [lstring {*}$options $str]
set l-isa [testobj objtype $l]
set len [llength $l]
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${len} ${l-isa2}
} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring}
test abstractlist-$not-4.1 {no shimmer lindex} {
set l [lstring {*}$options $str]
set l-isa [testobj objtype $l]
set ele [lindex $l 22]
set l-isa2 [testobj objtype $l]
list $l ${l-isa} ${ele} ${l-isa2}
} {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring}
test abstractlist-$not-4.2 {lreverse} ReverseShimmer {
set l [lstring {*}$options $str]
set l-isa [testobj objtype $l]
set r [lreverse $l]
set r-isa [testobj objtype $r]
set l-isa2 [testobj objtype $l]
list $r ${l-isa} ${r-isa} ${l-isa2}
} {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring}
test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer {
set l [lstring {*}$options $str]
set l-isa [testobj objtype $l]
set il [lsearch -all [lstring {*}$options $str] { }]
set l-isa2 [testobj objtype $l]
lappend il [llength $l]
set start 0
set words [lmap i $il {
set w [join [lrange $l $start $i-1] {} ]
set start [expr {$i+1}]
set w
}]
set l-isa3 [testobj objtype $l]
list ${l-isa} $il ${l-isa2} ${l-isa3} $words
} {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
test abstractlist-$not-4.4 {no shimmer foreach} {
set l [lstring {*}$options $str]
set l-isa [testobj objtype $l]
set word {}
set words {}
foreach c $l {
if {$c eq { }} {
lappend words $word
set word {}
} else {
append word $c
}
}
if {$word ne ""} {
lappend words $word
}
set l-isa2 [testobj objtype $l]
list ${l-isa} ${l-isa2} $words
} {lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}}
#
# The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring.
#
test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer {
set l [lstring {*}$options $str2]
set l-isa [testobj objtype $l]
set m [lreplace $l 18 23 { } f a i l ?]
set m-isa [testobj objtype $m]
set l-isa1 [testobj objtype $l]
list ${l-isa} $m ${m-isa} ${l-isa1}
} {lstring {} list lstring}
test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} {
set l [lstring {*}$options $str2]
set l-isa [testobj objtype $l]
set e [ledit l 68 67 s]
set e-isa [testobj objtype $e]
list ${l-isa} $e ${e-isa}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer} {
set l [lstring {*}$options $str2]
set l-isa [testobj objtype $l]
set i [linsert $l 12 {*}[split "almost " {}]]
set i-isa [testobj objtype $i]
set res [list ${l-isa} $i ${i-isa}]
set p [lpop i 23]
set p-isa [testobj objtype $p]
set i-isa2 [testobj objtype $i]
lappend res $p ${p-isa} $i ${i-isa2}
} {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring}
# lassign probably uses lrange internally
test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lassign $l i n c]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring}
test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lremove $l 0 1]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring}
test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set l2 [lreverse $l]
set l-isa2 [testobj objtype $l]
set l2-isa [testobj objtype $l2]
list $l ${l-isa} $l2 ${l-isa2} ${l2-isa}
} {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring}
test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set m [lset l 2 k]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}
test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set m [testevalex {lset l 2 k}]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0}
test abstractlist-$not-4.11e {error case lset multiple indicies} \
-constraints {SetelementShimmer testevalex} -body {
set l [lstring Inconceivable]
set l-isa [testobj objtype $l]
set m [testevalex {lset l 2 0 1 k}]
set m-isa [testobj objtype $m]
list $l ${l-isa} $m ${m-isa} [value-cmp l m]
} -returnCodes 1 \
-result {Multiple indicies not supported by lstring.}
# lrepeat
test abstractlist-$not-4.12 {shimmer lrepeat} -body {
set l [lstring {*}$options Inconceivable]
set l-isa [testobj objtype $l]
set m [lrepeat 3 $l]
set m-isa [testobj objtype $m]
set n [lindex $m 1]
list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n]
} -cleanup {
} -result {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0}
# Disable constraint
testConstraint [format "%sShimmer" [string totitle $not]] 1
}
#
# Test fix for bug in TEBC for STR CONCAT, and LIST INDEX
# instructions.
# This example abstract list (lgen) causes a rescursive call in TEBC,
# stack management was not included for these instructions in TEBC.
#
test abstractlist-lgen-bug {bug in str concat and list operations} -setup {
set lgenfile [makeFile {
# Test TIP 192 - Lazy Lists
set res {}
set cntr 0
# Fatal error here when [source]'d -- It is a refcounting problem...
lappend res Index*2:[lgen 1 expr 2* ]:--
set x [lseq 17]
set y [lgen 17 apply {{index} {expr {$index * 6}}}] ;# expr * 6
foreach i $x n $y {
lappend res "$i -> $n"
}
proc my_expr {offset index} {
expr {$index + $offset}
}
lappend res my_expr(3):[my_expr 3 0]
lappend res [set ss [lgen 15 my_expr 7]]
lappend res s2:[list "Index+7:" $ss ":--"]
lappend res foo:[list "Index-8:" [lgen 15 my_expr -8] ":--"]
set 9 [lgen 15 my_expr 7]
lappend res 9len=[llength $9]
lappend res 9(3)=[lindex $9 3]
lappend res bar:[list "Index+7:" $9 ":--"]
lappend res Index+7:$9:--
lappend res Index+7:[lgen 15 my_expr 7]:--
proc fib {phi n} {
set d [expr {round(pow($phi, $n) / sqrt(5.0))}]
return $d
}
set phi [expr {(1 + sqrt(5.0)) / 2.0}]
lappend res fib:[lmap n [lseq 5] {fib $phi $n}]
set x [lgen 20 fib $phi]
lappend res "First 20 fibbinacci:[lgen 20 fib $phi]"
lappend res "First 20 fibbinacci from x :$x"
unset x
lappend res Good-Bye!
set res
} source.file]
} -body {
set tcl_traceExec 0
set tcl_traceCompile 0
set f $lgenfile
#set script [format "puts ====-%s-====\nsource %s\nputs ====-done-====\n" $f $f]
set script [format "source %s" $f]
#puts stderr "eval $script"
eval $script
} -cleanup {
removeFile source.file
unset res
} -result {Index*2:0:-- {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} my_expr(3):3 {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} {s2:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {foo:Index-8: {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6} :--} 9len=15 9(3)=10 {bar:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {fib:0 1 1 2 3} {First 20 fibbinacci:0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} {First 20 fibbinacci from x :0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} Good-Bye!}
test abstractlist-lgen-bug2 {bug in foreach} -body {
set x [lseq 17]
set y [lgen 17 expr 6*]
lappend res x-[lrange [tcl::unsupported::representation $x] 0 3]
lappend res y-[lrange [tcl::unsupported::representation $y] 0 3]
foreach i $x n $y {
lappend res "$i -> $n"
}
lappend res x-[lrange [tcl::unsupported::representation $x] 0 3]
lappend res y-[lrange [tcl::unsupported::representation $y] 0 3]
} -cleanup {
unset res
} -result {{x-value is a arithseries} {y-value is a lgenseries} {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} {x-value is a arithseries} {y-value is a lgenseries}}
# scalar values
test abstractlist-int {TclLengthOne: anti-shimmer of boolean, int, double, bignum} {
set res {}
foreach i [list [expr {1+0}] [expr {true}] [expr {3.141592}] [expr {round(double(0x7fffffffffffffff))}]] {
lappend res [testobj objtype $i]
lappend res [llength $i]
lappend res [testobj objtype $i]
}
#set w [expr {3.141592}]
#lappend res [testobj objtype $w] [llength $w] [testobj objtype $w]
set res
} {int 1 int boolean 1 boolean double 1 double bignum 1 bignum}
# lsort
# cleanup
::tcltest::cleanupTests
proc my_abstl_cleanup {vars} {
set nowvars [uplevel info vars]
foreach var $nowvars {
if {$var ni $vars} {
uplevel unset $var
lappend clean-list $var
}
}
return ${clean-list}
}
my_abstl_cleanup $abstractlisttestvars
+8 -8
View File
@@ -221,7 +221,7 @@ test append-7.1 {lappend-created var and error in trace on that var} -setup {
catch {rename foo ""}
unset -nocomplain x
} -body {
trace variable x w foo
trace add variable x write foo
proc foo {} {global x; unset x}
catch {lappend x 1}
proc foo {args} {global x; unset x}
@@ -234,37 +234,37 @@ test append-7.2 {lappend var triggers read trace} -setup {
unset -nocomplain myvar
unset -nocomplain ::result
} -body {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar a
return $::result
} -result {myvar {} r}
} -result {myvar {} read}
test append-7.3 {lappend var triggers read trace, array var} -setup {
unset -nocomplain myvar
unset -nocomplain ::result
} -body {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them, and was changed back in 8.4.
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
return $::result
} -result {myvar b r}
} -result {myvar b read}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
unset -nocomplain myvar
unset -nocomplain ::result
} -body {
set myvar(0) 1
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
return $::result
} -result {myvar b r}
} -result {myvar b read}
test append-7.5 {append var does not trigger read trace} -setup {
unset -nocomplain myvar
unset -nocomplain ::result
} -body {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
append myvar a
info exists ::result
+15 -15
View File
@@ -250,7 +250,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} -se
} -body {
proc bar {} {
global x
trace variable x w foo
trace add variable x write foo
proc foo {} {global x; unset x}
catch {lappend x 1}
proc foo {args} {global x; unset x}
@@ -265,19 +265,19 @@ test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
unset -nocomplain ::result
} -body {
proc bar {} {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar a
return $::result
}
bar
} -result {myvar {} r} -constraints {bug-3057639}
} -result {myvar {} read} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
unset -nocomplain ::result
unset -nocomplain ::myvar
} -body {
proc bar {} {
trace variable ::myvar r foo
trace add variable ::myvar read foo
proc foo {args} {append ::result $args}
lappend ::myvar a
return $::result
@@ -290,67 +290,67 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them. Maybe not correct, but been there a while.
proc bar {} {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
return $::result
}
bar
} -result {myvar b r} -constraints {bug-3057639}
} -result {myvar b read} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
unset -nocomplain ::result
} -body {
# The behavior of read triggers on lappend changed in 8.0 to not trigger
# them. Maybe not correct, but been there a while.
proc bar {} {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar(b) a b
return $::result
}
bar
} -result {myvar b r}
} -result {myvar b read}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
unset -nocomplain ::result
} -body {
proc bar {} {
set myvar(0) 1
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
lappend myvar(b) a
return $::result
}
bar
} -result {myvar b r} -constraints {bug-3057639}
} -result {myvar b read} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
unset -nocomplain ::myvar
unset -nocomplain ::result
} -body {
proc bar {} {
trace variable ::myvar r foo
trace add variable ::myvar read foo
proc foo {args} {append ::result $args}
lappend ::myvar(b) a
return $::result
}
bar
} -result {::myvar b r} -constraints {bug-3057639}
} -result {::myvar b read} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
unset -nocomplain ::myvar
unset -nocomplain ::result
} -body {
proc bar {} {
trace variable ::myvar r foo
trace add variable ::myvar read foo
proc foo {args} {append ::result $args}
lappend ::myvar(b) a b
return $::result
}
bar
} -result {::myvar b r}
} -result {::myvar b read}
test appendComp-7.9 {append var does not trigger read trace} -setup {
unset -nocomplain ::result
} -body {
proc bar {} {
trace variable myvar r foo
trace add variable myvar read foo
proc foo {args} {append ::result $args}
append myvar a
info exists ::result
+19 -2
View File
@@ -112,8 +112,10 @@ proc bigPatlenMultiple {limit} {
set ::bigLengths(intmax) 0x7fffffff
set ::bigLengths(uintmax) 0xffffffff
# Some tests are more convenient if operands are multiple of pattern length
if {[testConstraint bigdata]} {
set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)]
set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)]
}
#
# script limits
@@ -275,14 +277,14 @@ bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -bo
} -cleanup {
bigClean
}
bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body {
bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967320 -1 4294967290 1} -body {
list \
[string last 0 $s] \
[string last Y $s] \
[string last 0 $s 0x100000000] \
[string last 1 $s end-0x100000010]
} -setup {
set s [bigString 0x10000000a 2]
set s [bigString 0x10000001a 2]
} -cleanup {
bigClean
}
@@ -1145,6 +1147,21 @@ test puts-bigdata-2 "puts" -setup {
set written
} -result {2345—}
test source-bigdata-1 "source" -setup {
# This test crashes because the frame linenumber tracking
# wraps around at INT_MAX
set fpath [tcltest::makeFile {} source-bigdata-1.tcl]
set fd [open $fpath w]
fconfigure $fd -translation lf
puts -nonewline $fd [string repeat \n 4294967296]
puts $fd {dict get [info frame 0] line}
close $fd
} -constraints {
bigdata knownBug
} -body {
set line [source $fpath]
} -result 4294967297
#
# TODO
# lremove
+2 -2
View File
@@ -2017,10 +2017,10 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
} \xCD\xCC\xCC\x3F
test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} {
binary format R Inf
} \x7f\x80\x00\x00
} \x7F\x80\x00\x00
test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} {
binary format r Inf
} \x00\x00\x80\x7f
} \x00\x00\x80\x7F
test binary-53.22 {Binary float Inf round trip} -body {
binary scan [binary format R Inf] R inf
binary scan [binary format R -Inf] R inf_
+10 -7
View File
@@ -1104,7 +1104,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
} -result [list 15 "123456789012301" 18 0 1 -1 ""]
} -result [list 16 "123456789012301\x82" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
} -constraints {stdio fileevent} -body {
@@ -6877,9 +6877,11 @@ test chan-io-52.10 {TclCopyChannel & encodings} -constraints {fcopy} -body {
# -translation binary is also -encoding binary
chan configure $out -translation binary
chan copy $in $out
file size $path(utf8-fcopy.txt)
} -cleanup {
chan close $in
chan close $out
file size $path(utf8-fcopy.txt)
unset in out
} -returnCodes 1 -match glob -result {error writing "*":\
invalid or incomplete multibyte or wide character}
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
@@ -7279,22 +7281,23 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
}
chan puts stderr SRV
set l {}
set srv [socket -server new 9999]
set srv [socket -server new -myaddr 127.0.0.1 0]
set port [lindex [chan configure $srv -sockname] 2]
chan puts stderr WAITING
chan event stdin readable bye
chan puts OK
puts "OK $port"
vwait forever
}
# wait for OK from server.
chan gets $pipe
lassign [chan gets $pipe] ok port
# Now the two clients.
proc done {sock} {
if {[chan eof $sock]} { chan close $sock ; return }
lappend ::forever [chan gets $sock]
return
}
set a [socket 127.0.0.1 9999]
set b [socket 127.0.0.1 9999]
set a [socket 127.0.0.1 $port]
set b [socket 127.0.0.1 $port]
chan configure $a -translation binary -buffering none
chan configure $b -translation binary -buffering none
chan event $a readable [namespace code "done $a"]
+12 -26
View File
@@ -207,24 +207,6 @@ proc endianUtf {enc} {
return ""
}
# Map arbitrary strings to printable form in ASCII.
proc printable {s} {
set print ""
foreach c [split $s ""] {
set i [scan $c %c]
if {[string is print $c] && ($i <= 127)} {
append print $c
} elseif {$i <= 0xff} {
append print \\x[format %02X $i]
} elseif {$i <= 0xffff} {
append print \\u[format %04X $i]
} else {
append print \\U[format %08X $i]
}
}
return $print
}
#
# Check errors for invalid number of arguments
proc badnumargs {id cmd cmdargs} {
@@ -354,7 +336,7 @@ unknownencodingtest cmdAH-4.3.9 {convertfrom -failindex VAR -profile ABC}
unknownencodingtest cmdAH-4.3.10 {convertfrom -profile strict -failindex ABC}
testconvert cmdAH-4.3.11 {
encoding convertfrom jis0208 \x38\x43
} \u4e4e -setup {
} 乎 -setup {
set system [encoding system]
encoding system iso8859-1
} -cleanup {
@@ -364,7 +346,7 @@ testconvert cmdAH-4.3.11 {
# Verify single arg defaults to system encoding
testconvert cmdAH-4.3.12 {
encoding convertfrom \x38\x43
} \u4e4e -setup {
} 乎 -setup {
set system [encoding system]
encoding system jis0208
} -cleanup {
@@ -516,7 +498,7 @@ unknownencodingtest cmdAH-4.4.8 {convertto nosuchencoding ABC}
unknownencodingtest cmdAH-4.4.9 {convertto -failindex VAR -profile ABC}
unknownencodingtest cmdAH-4.4.10 {convertto -profile strict -failindex ABC}
testconvert cmdAH-4.4.11 {
encoding convertto jis0208 \u4e4e
encoding convertto jis0208 乎
} \x38\x43 -setup {
set system [encoding system]
encoding system iso8859-1
@@ -526,7 +508,7 @@ testconvert cmdAH-4.4.11 {
# Verify single arg defaults to system encoding
testconvert cmdAH-4.4.12 {
encoding convertto \u4e4e
encoding convertto 乎
} \x38\x43 -setup {
set system [encoding system]
encoding system jis0208
@@ -539,7 +521,7 @@ testconvert cmdAH-4.4.12 {
foreach {enc str hex ctrl comment} $encValidStrings {
if {"knownBug" in $ctrl} continue
set bytes [binary decode hex $hex]
set printable [printable $str]
set printable [tcltest::Asciify $str]
set prefix A
set suffix B
set prefix_bytes [encoding convertto $enc A]
@@ -556,7 +538,7 @@ foreach {enc str hex ctrl comment} $encValidStrings {
foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings {
if {"knownBug" in $ctrl} continue
set bytes [binary decode hex $hex]
set printable [printable $str]
set printable [tcltest::Asciify $str]
set prefix A
set suffix B
set prefix_bytes [encoding convertto $enc $prefix]
@@ -605,7 +587,7 @@ foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings {
foreach {enc str hex ctrl comment} $encValidStrings {
if {"knownBug" in $ctrl} continue
set bytes [binary decode hex $hex]
set printable [printable $str]
set printable [tcltest::Asciify $str]
set prefix A
set suffix B
set prefix_bytes [encoding convertto $enc A]
@@ -622,7 +604,7 @@ foreach {enc str hex ctrl comment} $encValidStrings {
foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings {
if {"knownBug" in $ctrl} continue
set bytes [binary decode hex $hex]
set printable [printable $str]
set printable [tcltest::Asciify $str]
set prefix A
set suffix B
set prefixLen [string length [encoding convertto $enc $prefix]]
@@ -1728,6 +1710,8 @@ test cmdAH-24.14.1 {
test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup {
set filename [makeFile "" foo.text]
} -body {
# This test may fail if your system does not have a 64-bit time_t.
# That is to be expected and is not a problem with Tcl.
list [file atime $filename 3155760000] [file atime $filename]
} -cleanup {
removeFile $filename
@@ -1735,6 +1719,8 @@ test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setu
test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -setup {
set filename [makeFile "" foo.text]
} -body {
# This test may fail if your system does not have a 64-bit time_t.
# That is to be expected and is not a problem with Tcl.
list [file mtime $filename 3155760000] [file mtime $filename]
} -cleanup {
file delete -force $filename
+25 -11
View File
@@ -14,6 +14,11 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
catch {
::tcltest::loadTestedCommands
package require -exact tcl::test [info patchlevel]
}
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
@@ -27,6 +32,7 @@ if {[testConstraint memory]} {
expr {$end - $tmp}
}
}
test dict-1.1 {dict command basic syntax} -returnCodes error -body {
dict
@@ -138,8 +144,16 @@ test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
dict get $a(z) d
}}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}
test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6
test dict-3.16 {dict/list shimmering - Bug 3004007} {
set l [list p 1 p 2 q 3]
dict get $l q
list $l [testobj objtype $l]
} {{p 1 p 2 q 3} dict}
test dict-3.17 {dict/list shimmering - Bug 3004007} {
set l [list p 1 p 2 q 3]
dict get $l q
list [llength $l] [testobj objtype $l]
} {6 dict}
test dict-4.1 {dict replace command} {
dict replace {a b c d}
@@ -662,15 +676,15 @@ test dict-14.14 {dict for command: handle representation loss} -body {
set keys {}
set values {}
dict for {k v} $dictVar {
if {[llength $dictVar]} {
if {[string length $dictVar]} {
lappend keys $k
lappend values $v
}
}
list [lsort $keys] [lsort $values]
list [lsort $keys] [lsort $values] [testobj objtype $dictVar]
} -cleanup {
unset dictVar keys values k v
} -result {{a c e g} {b d f h}}
} -result {{a c e g} {b d f h} string}
test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
unset -nocomplain accum
array set accum {}
@@ -1808,27 +1822,27 @@ test dict-24.14 {dict map command: handle representation loss} -setup {
} -body {
set dictVar {a b c d e f g h}
list [dict size [dict map {k v} $dictVar {
if {[llength $dictVar]} {
if {[string length $dictVar]} {
lappend keys $k
lappend values $v
return -level 0 $k
}
}]] [lsort $keys] [lsort $values]
}]] [lsort $keys] [lsort $values] [testobj objtype $dictVar]
} -cleanup {
unset dictVar keys values k v
} -result {4 {a c e g} {b d f h}}
} -result {4 {a c e g} {b d f h} string}
test dict-24.14a {dict map command: handle representation loss} -body {
apply {{} {
set dictVar {a b c d e f g h}
list [dict size [dict map {k v} $dictVar {
if {[llength $dictVar]} {
if {[string length $dictVar]} {
lappend keys $k
lappend values $v
return -level 0 $k
}
}]] [lsort $keys] [lsort $values]
}]] [lsort $keys] [lsort $values] [testobj objtype $dictVar]
}}
} -result {4 {a c e g} {b d f h}}
} -result {4 {a c e g} {b d f h} string}
test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
unset -nocomplain accum
array set accum {}
+70 -52
View File
@@ -232,18 +232,6 @@ test encoding-10.1 {Tcl_UtfToExternal} {
return $x
} "ab\x8C\xC1g"
proc viewable {str} {
set res ""
foreach c [split $str {}] {
if {[string is print $c] && [string is ascii $c]} {
append res $c
} else {
append res "\\u[format %4.4X [scan $c %c]]"
}
}
return "$str ($res)"
}
test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
set system [encoding system]
set path [encoding dirs]
@@ -265,11 +253,11 @@ test encoding-11.4 {LoadEncodingFile: multi-byte} {
encoding convertfrom shiftjis \x8C\xC1
} 乎
test encoding-11.5 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022 乎]
} [viewable "\x1B\$B8C\x1B(B"]
encoding convertto iso2022 乎
} \x1B\$B8C\x1B(B
test encoding-11.5.1 {LoadEncodingFile: escape file} {
viewable [encoding convertto iso2022-jp 乎]
} [viewable "\x1B\$B8C\x1B(B"]
encoding convertto iso2022-jp 乎
} \x1B\$B8C\x1B(B
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
set system [encoding system]
set path [encoding dirs]
@@ -293,17 +281,17 @@ test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding}
encoding system $system
} -result {invalid encoding file "splat"}
test encoding-11.8 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16le 😹]
} {=Ø9Þ (=\u00D89\u00DE)}
encoding convertto utf-16le 😹
} =Ø9Þ
test encoding-11.9 {encoding: extended Unicode UTF-16} {
viewable [encoding convertto utf-16be 😹]
} {Ø=Þ9 (\u00D8=\u00DE9)}
encoding convertto utf-16be 😹
} Ø=Þ9
test encoding-11.10 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32le 😹]
} "9\xF6\x01\x00 (9\\u00F6\\u0001\\u0000)"
encoding convertto utf-32le 😹
} 9\xF6\x01\x00
test encoding-11.11 {encoding: extended Unicode UTF-32} {
viewable [encoding convertto utf-32be 😹]
} "\x00\x01\xF69 (\\u0000\\u0001\\u00F69)"
encoding convertto utf-32be 😹
} \x00\x01\xF69
# OpenEncodingFile is fully tested by the rest of the tests in this file.
test encoding-12.1 {LoadTableEncoding: normal encoding} {
@@ -330,8 +318,8 @@ test encoding-12.5 {LoadTableEncoding: symbol encoding} {
} "ggγ"
test encoding-13.1 {LoadEscapeTable} {
viewable [set x [encoding convertto iso2022 ab乎棙g]]
} [viewable "ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg"]
encoding convertto iso2022 ab乎棙g
} ab\x1B\$B8C\x1B\$\(DD%\x1B(Bg
test encoding-15.1 {UtfToUtfProc} {
encoding convertto utf-8 £
@@ -588,13 +576,13 @@ test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
encoding convertfrom -profile strict utf-16le \x00\xDC
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-16.25 {Utf32ToUtfProc} -body {
test encoding-16.24 {Utf32ToUtfProc} -body {
encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF"
} -result \uFFFD
test {encoding-16.25 strict} {Utf32ToUtfProc} -body {
encoding convertfrom -profile strict utf-32 "\x01\x00\x00\x01"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x01'}
test {encoding-16.25 tcl8} {Utf32ToUtfProc} -body {
encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01"
} -result \uFFFD
@@ -755,14 +743,14 @@ test encoding-24.1 {EscapeFreeProc on open channels} exec {
} {}
test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
# Bug #524674 output
viewable [runInSubprocess {
runInSubprocess {
encoding system cp1252; # Bug #2891556 crash revelator
fconfigure stdout -encoding iso2022-jp
puts ab乎棙g
set env(TCL_FINALIZE_ON_EXIT) 1
exit
}]
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg (ab\\u001B\$B8C\\u001B\$(DD%\\u001B(Bg)"
}
} "ab\x1B\$B8C\x1B\$(DD%\x1B(Bg"
test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
# Bug #219314 - if we don't free escape encodings correctly on channel
# closure, we go boom
@@ -776,12 +764,15 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
set count [gets $f line]
close $f
removeFile iso2022.tcl
list $count [viewable $line]
} [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]
list $count $line
} [list 3 乎乞也]
test encoding-24.4 {Parse valid or invalid utf-8} {
string length [encoding convertfrom utf-8 "\xC0\x80"]
} 1
test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
encoding convertfrom -profile strict utf-8 "\xC0\x80"
} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
encoding convertfrom -profile tcl8 utf-8 \xC0\x80
} \x00
test encoding-24.5 {Parse valid or invalid utf-8} {
string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
} 2
@@ -1085,38 +1076,34 @@ runtests
test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
# Note - buffers are initialized to \xff
# Note - buffers are initialized to \xFF
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result
} -result [list 0 [list nospace {} \xff]]
} -result [list 0 [list nospace {} \xFF]]
test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
# Note - buffers are initialized to \xff
# Note - buffers are initialized to \xFF
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result
} -result [list 0 [list nospace {} {}]]
test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
# Note - buffers are initialized to \xff
# Note - buffers are initialized to \xFF
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result
} -result [list 0 [list nospace {} \x00\x00]]
test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding
} -body {
# Note - buffers are initialized to \xff
# Note - buffers are initialized to \xFF
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
} -result [list 0 [list nospace {} \x00\x00\xff]]
} -result [list 0 [list nospace {} \x00\x00\xFF]]
test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
testencoding ucs2 knownBug
testencoding
} -body {
# The knownBug constraint is because test depends on TCL_UTF_MAX and
# also UtfToUtf16 assumes space required in destination buffer is
# sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4
# Note - buffers are initialized to \xff
list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]
@@ -1159,6 +1146,37 @@ test encoding-30.3 {encoding convertfrom large strings > 4GB} -constraints {
list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertfrom ascii $s]]
} -result {4294967296 1}
test encoding-bug-6a3e2cb0f0-1 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy
test encoding-bug-6a3e2cb0f0-2 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
encoding convertfrom -profile strict iso2022-jp x\x1B\x7Aaby
} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x1B'}
test encoding-bug-6a3e2cb0f0-3 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body {
encoding convertfrom -profile replace iso2022-jp x\x1B\x7Aaby
} -result x\uFFFDy
test encoding-bug-66ffafd309-1-tcl8 {Bug [66ffafd309] - truncated DBCS} -body {
encoding convertfrom -profile tcl8 gb12345 x
} -result x
test encoding-bug-66ffafd309-1-strict {Bug [66ffafd309] - truncated DBCS} -body {
encoding convertfrom -profile strict gb12345 x
} -result {unexpected byte sequence starting at index 0: '\x78'} -returnCodes error
test encoding-bug-66ffafd309-1-replace {Bug [66ffafd309] - truncated DBCS} -body {
encoding convertfrom -profile replace gb12345 x
} -result \uFFFD
test encoding-bug-66ffafd309-2-tcl8 {Bug [66ffafd309] - invalid DBCS} -body {
# Not truncated but invalid
encoding convertfrom -profile tcl8 jis0208 \x78\x79
} -result \x78\x79
test encoding-bug-66ffafd309-2-strict {Bug [66ffafd309] - invalid DBCS} -body {
# Not truncated but invalid
encoding convertfrom -profile strict jis0208 \x78\x79
} -result {unexpected byte sequence starting at index 1: '\x79'} -returnCodes error
test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body {
# Not truncated but invalid
encoding convertfrom -profile replace jis0208 \x78\x79
} -result \uFFFD\uFFFD
# cleanup
namespace delete ::tcl::test::encoding
+9 -9
View File
@@ -32,7 +32,7 @@ set encValidStrings {}; # Reset the table
lappend encValidStrings {*}{
ascii \u0000 00 {} {Lowest ASCII}
ascii \u007F 7F knownBug {Highest ASCII}
ascii \u007F 7F {} {Highest ASCII}
ascii \u007D 7D {} {Brace - just to verify test scripts are escaped correctly}
ascii \u007B 7B {} {Terminating brace - just to verify test scripts are escaped correctly}
@@ -593,11 +593,11 @@ lappend encInvalidBytes {*}{
utf-32le 00D8000000DC0000 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair}
utf-32le 00D8000000DC0000 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair}
utf-32le 00D8000000DC0000 strict {} 0 {} {High-low-surrogate-pair}
utf-32le 00001100 tcl8 \UFFFD -1 {} {Out of range}
utf-32le 00001100 replace \UFFFD -1 {} {Out of range}
utf-32le 00001100 tcl8 \uFFFD -1 {} {Out of range}
utf-32le 00001100 replace \uFFFD -1 {} {Out of range}
utf-32le 00001100 strict {} 0 {} {Out of range}
utf-32le FFFFFFFF tcl8 \UFFFD -1 {} {Out of range}
utf-32le FFFFFFFF replace \UFFFD -1 {} {Out of range}
utf-32le FFFFFFFF tcl8 \uFFFD -1 {} {Out of range}
utf-32le FFFFFFFF replace \uFFFD -1 {} {Out of range}
utf-32le FFFFFFFF strict {} 0 {} {Out of range}
utf-32be 41 tcl8 \uFFFD -1 {solo tail} {Truncated}
@@ -618,11 +618,11 @@ lappend encInvalidBytes {*}{
utf-32be 0000D8000000DC00 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair}
utf-32be 0000D8000000DC00 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair}
utf-32be 0000D8000000DC00 strict {} 0 {} {High-low-surrogate-pair}
utf-32be 00110000 tcl8 \UFFFD -1 {} {Out of range}
utf-32be 00110000 replace \UFFFD -1 {} {Out of range}
utf-32be 00110000 tcl8 \uFFFD -1 {} {Out of range}
utf-32be 00110000 replace \uFFFD -1 {} {Out of range}
utf-32be 00110000 strict {} 0 {} {Out of range}
utf-32be FFFFFFFF tcl8 \UFFFD -1 {} {Out of range}
utf-32be FFFFFFFF replace \UFFFD -1 {} {Out of range}
utf-32be FFFFFFFF tcl8 \uFFFD -1 {} {Out of range}
utf-32be FFFFFFFF replace \uFFFD -1 {} {Out of range}
utf-32be FFFFFFFF strict {} 0 {} {Out of range}
}
+2 -1
View File
@@ -777,7 +777,7 @@ test expr-20.2 {double invocation of variable traces} -body {
set var "$counter + [concat $extraargs]"
}
}
trace variable exprtracevar r [list exprtraceproc 10]
trace add variable exprtracevar read [list exprtraceproc 10]
list [catch {expr "$exprtracevar + 20"} a] $a \
[catch {expr "$exprtracevar + 20"} b] $b \
[unset exprtracevar exprtracecounter]
@@ -1426,6 +1426,7 @@ test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000
test expr-24.11 {INST_LSHIFT: Bug 84a5355235} {expr -549755813888>>32} -128
# List membership tests
test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1
+1 -1
View File
@@ -1265,7 +1265,7 @@ test if-10.6 {double invocation of variable traces} -body {
set var "$counter + [concat $extraargs]"
}
}
trace variable iftracevar r [list iftraceproc 10]
trace add variable iftracevar read [list iftraceproc 10]
list [catch {if "$iftracevar + 20" {}} a] $a \
[catch {if "$iftracevar + 20" {}} b] $b
} -cleanup {
+1 -1
View File
@@ -63,7 +63,7 @@ test incr-old-2.5 {incr errors} {
test incr-old-2.6 {incr errors} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
trace add var x write readonly
list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
+13 -5
View File
@@ -20,6 +20,7 @@ testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testgetintforindex [llength [info commands testgetintforindex]]
testConstraint testparseargs [llength [info commands testparseargs]]
testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]
testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}]
test indexObj-1.1 {exact match} testindexobj {
testindexobj 1 1 xyz abc def xyz alm
@@ -200,19 +201,26 @@ test indexObj-8.9 {Tcl_GetIntForIndex end} testgetintforindex {
} 2147483647
test indexObj-8.10 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -1
} -1
} -2
test indexObj-8.11 {Tcl_GetIntForIndex end-1} testgetintforindex {
testgetintforindex end-1 -2
} -1
} -3
test indexObj-8.12 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -1
} -1
test indexObj-8.13 {Tcl_GetIntForIndex end} testgetintforindex {
testgetintforindex end -2
} -1
test indexObj-8.14 {Tcl_GetIntForIndex end+1} testgetintforindex {
} -2
test indexObj-8.14 {Tcl_GetIntForIndex end+1} -constraints {
testgetintforindex has64BitLengths
} -body {
testgetintforindex end+1 -1
} 0
} -result 9223372036854775807
test indexObj-8.14.32bits {Tcl_GetIntForIndex end+1} -constraints {
testgetintforindex has32BitLengths
} -body {
testgetintforindex end+1 -1
} -result 2147483647
test indexObj-8.15 {Tcl_GetIntForIndex end+1} testgetintforindex {
testgetintforindex end+1 -2
} -1
+1 -1
View File
@@ -170,7 +170,7 @@ foreach arg [subst -nocommands -novariables {
auto_reset
} -body {
namespace eval junk [list array set $arg [list 1 2 3 4]]
trace variable ::junk::$arg r \
trace add variable ::junk::$arg read \
"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
catch {parray ::junk::$arg}
set first $::errorInfo

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