Compare commits

...
Author SHA1 Message Date
dkf ffa8d1d461 Disable test that fails in CI environments 2020-11-16 09:24:33 +00:00
dkf eff08da703 Rethinking how to do a build matrix on several platforms 2020-11-15 15:48:43 +00:00
dkf 807ed7b13c Added MSYS/gcc build for Windows, renamed Linux build step 2020-11-15 09:17:41 +00:00
dkf 3ef704b39c Updated README 2020-11-15 08:38:14 +00:00
dkf 346721f3f0 Fix minor errors 2020-11-15 08:35:49 +00:00
dkf b3e4fc2a04 Fixed some tests, added trial macOS build 2020-11-14 12:25:38 +00:00
dkf a22953bb77 Back to powershell 2020-11-14 09:31:49 +00:00
dkf 20664f1fa1 Cleaning up the actions and trying to make them behave more usefully on Windows. 2020-11-10 09:26:10 +00:00
dkf 33955d6933 Copied build control files for Github Actions from 8.7 2020-11-09 09:13:57 +00:00
jan.nijtmans 4404292972 Add MSVC "StaticPackage" build to travis. Fix another bug in winDde.test which didn't account for statically loaded dde package. 2020-11-06 17:17:41 +00:00
jan.nijtmans 82ffc550db Merge jn-module-names. Sorry Don, but this is 100% compatible! 2020-11-06 16:11:58 +00:00
jan.nijtmans 3c53be5e75 Correct casing of "packageName" argument in Tcl_StaticPackage() call and "load" command (which - actually - is not a packageName at all ...)
UPDATE: I am moving this to a feature branch.  Changing the arguments passed to Tcl_StaticPackage will be an incompatible break for any scripts currently searching the [info loaded] list for "dde" or "registry".  Not a change we should put in a patchlevel without at least a ticket to record the explanation and a (POTENTIAL INCOMPATIBILITY) warning.
2020-11-06 13:32:39 +00:00
jan.nijtmans f163c24b4c Simplify testcases using "incr" 2020-10-30 13:56:15 +00:00
jan.nijtmans 076a7e2839 Add "{}" around many "expr" commands in testcases. Also in doc/expr.n 2020-10-30 13:27:52 +00:00
jan.nijtmans 9efaa4d7f1 Fix implib filenames (adapted from Mingw2's 006-proper-implib-name.mingw.patch)
3 new testcases
2020-10-29 10:04:24 +00:00
jan.nijtmans dc84eca339 3 new testcases 2020-10-29 09:42:42 +00:00
jan.nijtmans f15717bcda Update TZ info to tzdata2020d. 2020-10-29 09:25:55 +00:00
jan.nijtmans ff316586bc Fix implib filenames (adapted from Mingw2's 006-proper-implib-name.mingw.patch) 2020-10-29 08:56:17 +00:00
jan.nijtmans 109828f090 Slight tweak to previous commit: Move definition of __USE_MINGW_ANSI_STDIO to the Makefile 2020-10-29 07:47:08 +00:00
jan.nijtmans 37d6f90099 Revert changes in previous commit to clock.n and lassign.n 2020-10-26 22:58:22 +00:00
José Ignacio Marín b0654427ca Update TZ info to tzdata2020d. 2020-10-26 20:32:16 +00:00
jan.nijtmans 34d3750e3c Fix [48898ab5f6a0d957]: Too few is better than not enough? (Inconsistent error messages) 2020-10-26 15:07:03 +00:00
jan.nijtmans 1c788e178d Fix warning: /home/jboss/workspace/tcl8.7/generic/tclIO.c:9997:27: warning: writing 1 byte into a region of size 0 [-Wstringop-overflow=]
9997 |   RemovePoint(nextPtr)[0] = '\r';
      |                           ^
2020-10-23 15:36:16 +00:00
jan.nijtmans cac264cd19 Merge 8.5 (rename internal TCL_I_MODIFIER -> TCL_Z_MODIFIER) 2020-10-22 09:56:19 +00:00
jan.nijtmans c41f605368 (cherry-pick): Fix [c975939973]: Usage of gnu_printf in latest mingw-w64.
Change (internal, windows-only) TCL_I_MODIFIER to TCL_Z_MODIFIER, since that's how it's called in Tcl 8.7 and up
2020-10-22 09:23:49 +00:00
culler fb10e693b2 When building a subframework for macOS use a build directory in the staging directory. 2020-10-21 18:02:31 +00:00
jan.nijtmans fd9662ee1c Fix [c975939973]: Usage of gnu_printf in latest mingw-w64 2020-10-21 07:48:31 +00:00
José Ignacio Marín 7f986a59bf Update TZ info to tzdata2020c. 2020-10-20 20:35:59 +00:00
culler ad823f4eb1 Add a make variable to GNUmakefile for building the Tcl.framework for use as a subframework 2020-10-19 19:22:39 +00:00
jan.nijtmans 40c3ec35ee Improve comment in install-sh, regarding Tcl-specific change 2020-10-19 07:25:23 +00:00
jan.nijtmans 0b669eacf8 Fix [cb458261c3]: Strip comme il faut (without really doing 'il faut' ....). Update 'install-sh' to latest upstream version, but re-add this commit: [b269db5d3e97b67c] 2020-10-19 07:21:45 +00:00
jan.nijtmans 71b64b8e1c Still troubles with GIT on Travis 2020-10-16 16:21:29 +00:00
jan.nijtmans 546165585c Remove use of CFG_ENCODING from rules.vc/makefile.vc: It will become obsolete with TIP #587. In stead, move the default handling to tclPkgConfig.c for now 2020-10-15 13:05:20 +00:00
jan.nijtmans 59a788a6c4 Fix [53d5155335]: Typo in interp.n 2020-10-15 11:02:21 +00:00
jan.nijtmans f3ae2684eb Something strange going on on Travis with (long-gone) safe-stock86.test 2020-10-15 09:19:29 +00:00
jan.nijtmans 3fc1392c92 More usage of TclNewObj() in stead of Tcl_NewObj() and TclNewIntObj() in stead of Tcl_NewIntObj() 2020-10-13 14:59:43 +00:00
jan.nijtmans 81e7623b78 Fix warning, doing a static build on Windows 2020-10-13 08:48:22 +00:00
José Ignacio Marín 579cd0b138 Update TZ info to tzdata2020b. 2020-10-10 20:34:58 +00:00
jan.nijtmans 208927f009 Merge 8.5 2020-10-09 07:42:21 +00:00
jan.nijtmans e250b6f551 (cherry-pick): Fix [014ade1d44]: Misleading error message when using "-path" multiple times with "glob".
Also fix a few (harmless) -Wundef warnings
2020-10-09 07:10:22 +00:00
jan.nijtmans 4a3369807b Eliminate warnings when compiling with -Wundef 2020-10-08 12:11:11 +00:00
jan.nijtmans 5039e7ce17 Fix [014ade1d44]: Misleading error message when using "-path" multiple times with "glob" 2020-10-08 09:13:57 +00:00
jan.nijtmans 5c9a145403 Merge 8.5 2020-10-08 09:07:54 +00:00
jan.nijtmans e53cbf77bf xcode12 -> xcode12.2. Prevent build warning about generic/tclStubInit.c 2020-10-07 16:34:57 +00:00
jan.nijtmans a9405cc253 (cherry-pick): HAVE_TM_GMTOFF detection doesn't work if CFLAGS contains -Werror. Here's the fix. 2020-10-06 13:28:24 +00:00
jan.nijtmans 1f4f47ccf5 (slightly) better error-message for invalid http -headers option. This works for plain 8.6 too 2020-09-30 14:49:15 +00:00
oehhar accd2800ec Ticket [0063cbcada]: check http::geturl -headers parameter to be a dict 2020-09-29 16:16:27 +00:00
oehhar 2b01204e41 Remove wrong copy of test case http-3.2 2020-09-29 16:12:12 +00:00
oehhar 43e27f10a5 Ticket [0063cbcada]: check http::geturl -headers parameter to be a dict. 2020-09-29 08:15:32 +00:00
jan.nijtmans 38b30033c8 Update internal zlib channel type from TCL_CHANNEL_VERSION_3 to TCL_CHANNEL_VERSION_5. Not actually a change, since supported procs are the same. So all internal channels have the same type 2020-09-28 15:00:02 +00:00
jan.nijtmans f6bf85fb67 Make Tcl compile warning-free using -Wshadow 2020-09-28 10:13:51 +00:00
jan.nijtmans 866a79313b Merge 8.5 2020-09-26 18:32:06 +00:00
jan.nijtmans 636e4d4826 Tweak xcode labels for Travis build 2020-09-26 18:25:56 +00:00
jan.nijtmans e6b8f92493 Build Travis with Xcode 12 and 12u (Universal Apps) 2020-09-25 15:17:06 +00:00
jan.nijtmans 67f864dc65 It's "utf-8", not "utf8" or "UTF8" 2020-09-25 14:24:24 +00:00
jan.nijtmans 00a4f18c38 When sourcing script files (even when simulating that through open|read), always set -eofchar \032 just like the source command does.
Possible security issue: this could make it possible to evaluate hidden content at the end of pkgIndex files.
2020-09-25 11:15:48 +00:00
jan.nijtmans 8f0b94f037 Merge 8.5 2020-09-25 11:13:11 +00:00
jan.nijtmans 9d34b872ce When sourcing script files (even when simulating that through open|read), always set -eofchar \032 just like the source command does.
Possible security issue: this could make it possible to evaluate hidden content at the end of pkgIndex files.
2020-09-25 11:09:08 +00:00
jan.nijtmans e4fcd7152b Add gcc-10 build to Travis 2020-09-24 06:41:04 +00:00
jan.nijtmans 3ee0402bd5 Let's see if we can recover from an occasional hickup like happened here: [https://travis-ci.org/github/tcltk/tcl/jobs/729226819] 2020-09-23 05:57:35 +00:00
jan.nijtmans 9e43cbb973 Improve TclInvalidateStringRep() macro such that (objPtr) is only evaluated once. Addation brackets in TclHasStringRep() macro 2020-09-20 21:32:35 +00:00
dgp 7a56ff406f Silence compiler warning -- fix safety of macro. 2020-09-20 15:53:37 +00:00
pooryorick 107d130ce3 Make the check to avoid generating a string representation in [uplevel] a little less intrusive. 2020-09-20 10:38:41 +00:00
jan.nijtmans e42885732a Merge 8.5 2020-09-20 10:21:07 +00:00
jan.nijtmans 1a94f57ab6 Backport many (formatting) changes in tools/*. Nothing functional.
testest.tcl: Use more uppercase hex.
2020-09-20 10:14:44 +00:00
pooryorick ac45c8d851 Fix for [b9ecf3ce98], [uplevel] unnecessarily generates string representation. 2020-09-19 14:33:24 +00:00
jan.nijtmans e14285c3a1 Tcl 8.6 should not be tested with "package prefer latest" any more: All included packages are supposed to be stable. Not to be merged to 8.7 (which still contains unstable packages) 2020-09-17 08:37:09 +00:00
jan.nijtmans 76e4a71917 Fix [835c93c000]: TIP #525 only implemented for non-singleproc case 2020-09-17 07:58:14 +00:00
jan.nijtmans 23520a7648 Fix [835c93c000]: TIP #525 only implemented for non-singleproc case 2020-09-17 07:47:24 +00:00
jan.nijtmans 1dc3124160 Proposed solution for [835c93c000]: TIP #525 only implemented for non-singleproc case 2020-09-16 12:17:54 +00:00
jan.nijtmans 52f93c85fd Unbreak winFCmd-1.38 testcase on Windows 2020-09-14 12:58:26 +00:00
jan.nijtmans fa3cf75311 Add .bmp to .gitattributes. Simplify .fossil-settings/binary-glob 2020-09-14 12:48:10 +00:00
jan.nijtmans 262b6297ea Eliminate many "register" keywords (which do nothing with modern compilers)
Eliminate many unnecessary type-casts to (unsigned)
2020-09-14 12:31:56 +00:00
jan.nijtmans f0ec68f072 Prevent the usage of the term safe/unsafe child. Suggested by Keith Nash. Thanks!
More usage of $index<0 in stead of $index==-1 consistantly
2020-09-14 09:22:18 +00:00
jan.nijtmans 6e44927248 Folow-up to previous commit: ExecStack is a FLEXARRAY too 2020-09-11 13:43:49 +00:00
jan.nijtmans 7f62b76887 Fix [https://core.tcl-lang.org/tk/tktview?name=3bc0f44ef3|3bc0f44ef3]: UBSan complains about body.chars[] usage.
(Yes, I know, this one is for Tk, but Tcl was using the same construct too ....)
2020-09-11 12:31:48 +00:00
jan.nijtmans 0715d88019 Use $index<0 in stead of $index==-1 consistantly 2020-09-11 08:09:20 +00:00
jan.nijtmans 2592b1e93b Don't use sizeof() for structs containing a flexible array as last element. Lesson from [https://core.tcl-lang.org/tk/info/3bc0f44ef3|3bc0f44ef3]. Use TclOffset in stead. 2020-09-10 10:28:46 +00:00
jan.nijtmans f4d0f6366c Rename safe-stock86.test to safe-stock.test 2020-09-09 06:37:45 +00:00
jan.nijtmans 60fde1d90f Fix "make install" on MacOSX: interp: make-manpage-section: ignoring .VS "TIP 581" after .TP 2020-09-07 15:11:19 +00:00
jan.nijtmans a7f1b76ad2 Backport genStubs.tcl from 8.7. This adds support for MP_WUR, not actually used by Tcl. But could be used in (libtommath-related) extensions 2020-09-07 11:56:51 +00:00
jan.nijtmans 66dd14a480 TIP #581: Last possible master/slave -> parent/child changes, without affecting anything serious 2020-09-05 20:45:04 +00:00
jan.nijtmans f2963d15d0 Let all test-cases load the "tcltest" package the same way. Depend on tcltest 2.5, since we never test with earlier tcltest versions 2020-09-04 15:48:08 +00:00
jan.nijtmans a4abf50c23 TIP #581: Mainly documentation and some testcases 2020-09-04 07:28:20 +00:00
jan.nijtmans d85664964a Merge 8.5
Mark io-46.1 and io-50.5 as "notOSX", since they sometimes fail in Travis
2020-09-02 12:51:01 +00:00
jan.nijtmans 264c84606b Upgrade Travis build from xcode 11.5 to 11.7 2020-09-02 11:46:35 +00:00
jan.nijtmans 724de352e3 Many more internal master/slave -> parent/child renamings 2020-09-01 09:15:11 +00:00
jan.nijtmans 6b0b7154f1 Eliminate eol-spacing 2020-09-01 09:11:28 +00:00
jan.nijtmans 6c69cf8504 opt package: Change comment. 0.4.7 -> 0.4.8.
More Master -> Parent and Slave -> Child changes in (internal) library and test-cases
2020-08-31 13:12:01 +00:00
jan.nijtmans 30fd8c842c Implement TIP #581: Master/Slave 2020-08-31 09:23:59 +00:00
kjnash 213447740b Merge safe-bugfixes-8-6 2020-08-28 19:24:14 +00:00
kjnash 5bb0947953 Merge 8.6 2020-08-28 19:13:13 +00:00
kjnash 01b6b4918f Merge bug-c2dc1da315-for-8-6 2020-08-28 19:10:08 +00:00
kjnash db4a945f2e Merge http-bug-cb0373bb33-again-for-8-6 2020-08-28 18:54:34 +00:00
kjnash e3707dae62 Merge 8.6 2020-08-28 18:34:48 +00:00
kjnash 643301e722 Merge 8.6 2020-08-28 18:19:11 +00:00
sebres 30c146de54 merge 8.5 2020-08-28 15:02:25 +00:00
sebres be42098b82 tests/regexp.test: more tests for -indices by multi-byte utf-8 (considering -start position now) 2020-08-28 15:01:23 +00:00
sebres 6149b214e8 merge 8.5 2020-08-28 14:05:53 +00:00
sebres 4af0efa4cb tests/regexp.test: added missing test that cover indices if running on string containing multi-byte utf-8 chars (de/ru, byte offsets != char offsets) 2020-08-28 14:02:50 +00:00
kjnash 953e3ea899 Update safe.test for new error message. 2020-08-28 01:03:23 +00:00
kjnash 3b1ca15e07 Provide error message if failed load does not. 2020-08-27 15:50:24 +00:00
kjnash c1d3ca8bae Merge 8.6 2020-08-27 15:15:55 +00:00
kjnash ffe530a1b2 Merge 8.6 2020-08-27 15:12:35 +00:00
kjnash df56e0e1df Merge 8.6 2020-08-26 19:43:56 +00:00
jan.nijtmans 43d2fdc86c Testcase chan-io-50.1 still fails sometimes on MacOSX. So put same measures in place as in io-50.1. See: [f586089a2b] 2020-08-26 14:52:42 +00:00
kjnash 1d040a5bae Merge 8.6 2020-08-25 20:10:11 +00:00
jan.nijtmans 82df9bf8f8 Merge 8.5 2020-08-25 10:15:07 +00:00
jan.nijtmans 0d23451993 Keep gcc-5 and gcc-6 builds on "bionic", because "focal" doesn't have these 2020-08-25 09:42:37 +00:00
kjnash 171bea3624 Try another Travis build 2020-08-24 14:35:37 +00:00
kjnash 06a30a3a2a Fix for http bug c2dc1da315. Add tests. Add detail about -handler to http(n). Bump version to 2.9.5. 2020-08-24 14:28:22 +00:00
kjnash 120f367646 Create new branch named "bug-c2dc1da315-for-8-6" 2020-08-24 12:01:12 +00:00
jan.nijtmans 5f4ef0229d Backport improvemenets in .gitignore .fossil-settings/ignore-glob and win/nmakehlp.c 2020-08-24 10:19:49 +00:00
jan.nijtmans b2d5b24a70 Upgrade Travis build from bionic to focal 2020-08-24 07:57:04 +00:00
kjnash dc1ca56b6a Merge 8.6 2020-08-22 04:09:14 +00:00
kjnash d753cbc088 Merge 8.6 2020-08-22 04:04:05 +00:00
jan.nijtmans 749efa7f84 Merge-mark (for triggering another Travis build) 2020-08-21 14:22:37 +00:00
dgp 1971f6ab14 merge mark 2020-08-21 14:00:53 +00:00
dgp 591c90cd3e Suppress tests that fail starting with OSX Mojave. 2020-08-21 13:59:13 +00:00
jan.nijtmans 40b259956c Merge 8.6 2020-08-19 15:37:08 +00:00
culler 6560454489 And remove the other $ and do the test slightly differently. Inability to test locally is a challenge. 2020-08-17 16:28:28 +00:00
culler 270c9b99d6 Add the missing $. 2020-08-17 16:21:05 +00:00
culler e1968256d8 Try to make io-50.6 more robust on the Travis macOS VM 2020-08-17 15:53:04 +00:00
jan.nijtmans 840355939d Testcase event-1.1 (still) fails occasionally on macOS 2020-08-13 07:21:34 +00:00
jan.nijtmans 52549ae747 Fix [e87000d8425ab86a]: crash for "fconfigure stdout" in Win32.
Even though the crash cannot happen in Tcl 8.6, the function Tcl_BadChannelOption() was to blame, so better fix that in 8.6 too.
2020-08-12 10:25:49 +00:00
kjnash cc21b0be2a Bugfixes to the earlier fix of bug cb0373bb33, which broke HTTP/1.0 transactions in which the server indicates neither a Content-Length nor that it will close the socket on completion ("Connection: close"). The HTTP/1.1 rule is that the response header "Connection", if absent, must default to "keep-alive"; but this rule does not apply to HTTP/1.0. Add test http11-3.4 and bump version to 2.9.4. 2020-08-12 09:20:56 +00:00
jan.nijtmans 330e4967ab Fix value of CMD_DEAD flag 2020-08-12 07:10:57 +00:00
jan.nijtmans 39db46fbe1 Merge 8.5 2020-08-12 06:38:22 +00:00
jan.nijtmans 998409ea9b Update .travis.yml: remove deprecated "sudo" and rename "matrix" to "jobs"
Fix travis build for Windows/Debug
2020-08-12 06:36:31 +00:00
kjnash dddf36c195 Create new branch named "http-bug-cb0373bb33-again-for-8-6" 2020-08-12 03:46:38 +00:00
kjnash 4b9763f5f7 Merge 8.6 2020-08-11 18:30:03 +00:00
jan.nijtmans c07c2bb91c Revert unintended ckalloc -> Tcl_Alloc change from previous commit 2020-08-11 13:15:37 +00:00
jan.nijtmans 30710a3cbd Code cleanup: less of use "register" keyword, and better use of typecasts 2020-08-11 12:44:21 +00:00
jan.nijtmans d73c6dbd81 Eliminate many unnecessary type-casts, mostly (size_t) when value is already size_t or int 2020-08-11 05:39:08 +00:00
pooryorick 36d06e1e0b Fix mistake in [7eed2baf73] 2020-08-10 19:33:18 +00:00
pooryorick e29e808f57 Fix for [29e8848eb976], imported alias in a deletion trace. 2020-08-10 18:05:10 +00:00
sebres 6c0be70d2b amend to [8054e19451]: clean up timeout timer event (avoid timing issues on further tests) 2020-08-10 16:54:46 +00:00
sebres 9d14ed87d0 merge point (no functional changes, 8.6 already has proper implementation of TclCreateSocketAddress) 2020-08-10 16:25:14 +00:00
sebres f397a9ac9d create server socket with AI_PASSIVE flag (used for bind) 2020-08-10 16:16:46 +00:00
sebres 3cd49200d7 windows: replace gethostbyname with getaddrinfo (gethostbyname can hang sporadically, closes [7cf7cce423]);
corresponding to MS (https://docs.microsoft.com/en-us/windows/win32/api/winsock/nf-winsock-gethostbyname):
Developers creating Windows Sockets 2 applications are urged to use the getaddrinfo function instead of gethostbyname
2020-08-10 16:16:36 +00:00
jan.nijtmans fd3f2b486c Remove use of (always enabled) "openpipe" constraint.
Add "testservicemode" constraint.
Change a single "chan close" into a "close" in a test-case
2020-08-10 14:57:19 +00:00
culler 4f513496d8 Fix [f586089a2b]: removing the call to Tcl_ServiceAll from Tcl_WaitForEvent on macOS exposed race conditions in some io, chanio and event tests. 2020-08-10 12:49:19 +00:00
culler 823d13656d More places where vwait needs to be used instead of update. 2020-08-10 01:27:37 +00:00
culler 5ed72038da use vwait in chanio tests too. 2020-08-09 14:33:43 +00:00
culler 1cadacd498 One more vwait. 2020-08-08 21:37:18 +00:00
culler 4b765a3aff Add and use testservicemode command; replace update by vwait 2020-08-08 21:27:06 +00:00
culler bb9b5e7606 Fix the expected result for chanio-50.6 2020-08-07 13:15:31 +00:00
culler f460900f9f Experiment with io-50.1 on Travis 2020-08-07 13:12:21 +00:00
culler 9557127009 Experiment with chan-io-50.6 on Travis 2020-08-06 13:09:22 +00:00
jan.nijtmans a2db4b22d0 Merge 8.6 2020-08-03 22:45:03 +00:00
jan.nijtmans 35d0992797 doc fix 2020-08-03 22:42:50 +00:00
jan.nijtmans 0f06b1b667 Merge 8.6 2020-08-03 15:46:27 +00:00
jan.nijtmans d40f0fe1b3 Merge 8.6 2020-08-03 15:43:45 +00:00
jan.nijtmans ca51d20173 Testcase cleanup: transform *io-50.* testcases to new test syntax 2020-08-03 15:23:42 +00:00
jan.nijtmans c1c4367262 Merge 8.6 2020-07-26 17:00:51 +00:00
jan.nijtmans 493182df76 Fix [cb0373bb33]: The http::geturl -keepalive option does not work as described in the man page. 2020-07-26 16:21:36 +00:00
jan.nijtmans 34aa927a14 Merge 8.6 2020-07-25 16:13:03 +00:00
jan.nijtmans e14cd07627 Fix [20dccf1200]: htons-related test fails on Mac OSX Catalina (10.15)
Also, let http-related tests check if really http 2.9 is present
2020-07-25 15:56:10 +00:00
kjnash 7c4cabaaae Fix for bug cb0373bb33. In HTTP/1.1 the response header "Connection", if absent, must default to "keep-alive". Add test http11-1.13 and bump version to 2.9.3. 2020-07-24 20:32:20 +00:00
kjnash c92e694158 Create new branch named "bug-cb0373bb33-for-8-6" 2020-07-24 18:46:38 +00:00
culler 0d231a3919 Check if reverting from os_unfair_lock to OSSpinLock has any effect. 2020-07-23 13:32:03 +00:00
kjnash 0e59966ac5 Improvements to removal of stale package data - bugfix for 1f63efa537 and 319e438f7f 2020-07-23 13:26:02 +00:00
kjnash 7f6ef9991b Whitespace changes only. 2020-07-22 19:07:30 +00:00
jan.nijtmans 7fba80338f Convert test-cases to do proper setup/cleanup 2020-07-22 15:28:39 +00:00
kjnash 720183a9af In ::safe::interpFindInAccessPath, ::safe::interpAddToAccessPath, add a check that the interpreter belongs to the Safe Base. Add comments on why this is not done for ::safe::interpDelete. 2020-07-21 17:34:03 +00:00
kjnash 14cfbc651c Adapt Safe Base for interpreter names with namespace separators. Add a test and revise safe(n). Fixes bug [693851]. 2020-07-21 17:25:03 +00:00
jan.nijtmans 55bf49d15f Re-enable event-1.1, io-50.? and chan-io-50.? test-cases, trying to get a hand at the problem [f586089a2b] 2020-07-21 13:22:08 +00:00
jan.nijtmans 5016da417f Merge 8.6 2020-07-21 13:00:27 +00:00
jan.nijtmans f472165a3d Mark chan-io-50.? and event-1.1 as nonPortable (for now): Those sometimes fail in the Travis environment, but in practice this doesn't seem to be a real problem. 2020-07-21 12:26:05 +00:00
jan.nijtmans cab7f268d6 Merge 8.6 2020-07-21 08:19:59 +00:00
kjnash 204434e4d4 Use suitable -errorcode in safe::AliasSource if file does not exist or is unreadable. Fixes bug f3ba57600d. 2020-07-21 03:59:35 +00:00
kjnash e6a9f22409 File tests/safe.test - rearrange tests - move tests of command/package loading that use Tcl files to new file tests/safe-stock86.test; renumber tests 9.8+ and add test 9.8 to replace old 5.1; move tests 7.0* to 5.*. 2020-07-20 22:32:28 +00:00
jan.nijtmans 99d517e3cb Use "Global" in stead of "Master" internally, where "Master" is not used in the Master-Slave paradigm and where this makes sense. 2020-07-20 14:25:11 +00:00
jan.nijtmans a03c2cb1c2 Merge 8.6 2020-07-20 09:02:03 +00:00
jan.nijtmans bbe2ea1d0e Merge 8.5.
Mark testcases io-50.* nonPortable: they fail too often in travis builds.
2020-07-20 08:24:16 +00:00
jan.nijtmans a15ea81906 Backport changes in tcltest package from higher Tcl versions.
Rename (internal, undocumented) tcltest::loadIntoSlaveInterpreter into tcltest::loadIntoChildInterpreter
tcltest 2.5.1 -> 2.5.3
2020-07-20 07:33:42 +00:00
kjnash f48f2735de Merge 8.6 2020-07-18 19:08:19 +00:00
kjnash a541a7be4c Remove an old fix for ~ expansion in safe::AliasGlob that is now fixed by other means 2020-07-18 18:51:53 +00:00
kjnash d12eb85c8f Simplify case analysis in safe::AliasGlob 2020-07-18 18:06:30 +00:00
kjnash 201d01f9da Add explanatory comments to safe::AliasGlob 2020-07-18 17:51:27 +00:00
culler 4bca76be3b macOS: Remove Tcl_ServiceAll from Tcl_WaitForEvent and use os_unfair_lock if it is available. 2020-07-18 16:02:55 +00:00
kjnash 6310c709d3 Update comments about safe interpreters in library/tm.tcl and library/package.tcl so they agree with code 2020-07-18 13:22:31 +00:00
kjnash 690f2c2839 Bugfix argument combination -- and -directory in ::safe::AliasGlob. 2020-07-18 13:18:48 +00:00
kjnash a300508fee Remove unused code for *.tm from ::safe::AliasGlob. 2020-07-18 13:09:25 +00:00
kjnash 2a52ff28dd Remove code block in ::safe::AliasGlob that no longer serves a useful purpose. 2020-07-18 12:53:53 +00:00
kjnash 651f71edfd Tidying tests/safe.test 2020-07-18 04:12:08 +00:00
jan.nijtmans 56e784cb1b Doc/internal variable tweaks 2020-07-17 11:11:47 +00:00
jan.nijtmans 9598926f42 New TIP #581 implementation 2020-07-17 10:42:29 +00:00
kjnash 711c236648 Merge 8.6 2020-07-16 16:32:06 +00:00
sebres 3cb9dde39e merge 8.5 2020-07-16 15:36:08 +00:00
sebres 565b9dca95 cherry pick [df5f1e8652]: Fix [5bbd044812]: Fix index underflow. 2020-07-16 15:34:57 +00:00
jan.nijtmans 8bd505ac83 Fix [5bbd044812]: Fix index underflow. 2020-07-16 13:42:57 +00:00
kjnash 634e9464b5 Merge 8.6 2020-07-16 10:26:31 +00:00
kjnash 79214905a2 Bugfix tests/safe.test. Harden tests safe-9.20 to safe-9.24 against indeterminate order of glob matches. Audit use of glob and tcl::tm in modified tests for cases with multiple matches. Simplify test comparison patterns. 2020-07-15 23:11:46 +00:00
kjnash 69fdd85b74 Bugfix in library/safe.tcl - AliasGlob passes -join to glob inappropriately; pass new test safe-13.7a 2020-07-15 17:03:47 +00:00
kjnash c14dbae8ad Bugfix in library/safe.tcl - when deleting a safe interpreter, delete its sub-interpreters cleanly; pass revised test safe-7.3 2020-07-15 13:22:54 +00:00
kjnash 4e07591402 Merge safe-bugfixes-8-6 2020-07-14 15:13:28 +00:00
kjnash ea2a934216 Merge 8.6 2020-07-14 14:57:07 +00:00
kjnash a26b107bd3 Merge safe-bugfixes-8-6 2020-07-13 15:04:34 +00:00
kjnash 26cf086c2c Comments only. 2020-07-13 14:57:44 +00:00
kjnash 7169e0abe0 Add tests to tests/safe.test 2020-07-13 14:55:28 +00:00
kjnash 6d32ec4c20 Merge safe-bugfixes-8-6 2020-07-13 13:30:11 +00:00
kjnash 4c326aa381 Bugfix in library/safe.tcl - when auto_reset, also reload module data; pass test safe-9.24 2020-07-13 12:52:53 +00:00
kjnash 12ba446acb Bugfix in library/tm.tcl - in a safe interp ::tcl::tm::UnknownHandler should always use the freshest "package ifneeded"; pass test safe-9.23 2020-07-13 12:37:16 +00:00
kjnash f0a97b5c71 Bugfix in library/safe.tcl - interpConfigure use revised value of tcl::tm::list; pass tests safe-9.21, safe-9.22 2020-07-13 12:32:08 +00:00
kjnash cca23e5286 Bugfix in library/safe.tcl - only add tm roots to tcl::tm::list; pass test safe-9.20 2020-07-13 12:25:10 +00:00
kjnash af4b36c13d Bugfix in library/safe.tcl - remove impossible error message in safe::interpFindInAccessPath; pass test safe-9.12 2020-07-13 12:13:07 +00:00
kjnash 9c9af976ae Bugfix in library/safe.tcl - when auto_reset, also reload pkgIndex.tcl data; pass tests safe-9.10, safe-9.11 2020-07-13 12:09:47 +00:00
kjnash c256107a5c Bugfix in library/safe.tcl for doreset (auto_reset); pass test safe-9.9 2020-07-13 11:49:46 +00:00
kjnash 2c1750c78f Add new tests to tests/safe.test. 2020-07-13 11:43:52 +00:00
kjnash 0d59960edf Add example files for use in tests/safe.test; add tests of the files themselves. 2020-07-13 11:22:37 +00:00
kjnash 7f5a85dcea Create new branch named "safe-bugfixes-8-6" 2020-07-13 10:39:22 +00:00
sebres 932835c1eb doc/clock.n: clearer form explaininng format groups on output 2020-06-30 11:59:48 +00:00
338 changed files with 6952 additions and 4604 deletions
+10 -7
View File
@@ -1,9 +1,12 @@
compat/zlib/win32/zdll.lib
compat/zlib/win32/zlib1.dll
compat/zlib/win64/zdll.lib
compat/zlib/win64/zlib1.dll
compat/zlib/win64/libz.dll.a
compat/zlib/zlib.3.pdf
*.a
*.bmp
*.dll
*.exe
*.gif
*.png
*.gz
*.jpg
*.lib
*.pdf
*.png
*.xlsx
*.zip
+2 -1
View File
@@ -32,7 +32,7 @@ libtommath/pretty.build
libtommath/tommath.src
libtommath/*.log
libtommath/*.pdf
libtommath/gen.pl
libtommath/*.pl
libtommath/*.sh
libtommath/doc/*
libtommath/tombc/*
@@ -64,4 +64,5 @@ win/*.manifest
win/pkgs/*
win/coffbase.txt
win/tcl.hpj
win/nmakehlp.out
win/nmhlp-out.txt
+1
View File
@@ -27,6 +27,7 @@
# Denote all files that are truly binary and should not be modified.
*.a binary
*.bmp binary
*.dll binary
*.exe binary
*.gif binary
+45
View File
@@ -0,0 +1,45 @@
name: Linux Build and Test
on: [push]
jobs:
gcc:
runs-on: ubuntu-latest
strategy:
matrix:
symbols:
- "no"
- "mem"
- "all"
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Configure (symbols=${{ matrix.symbols }})
run: |
mkdir "${HOME}/install dir"
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-symbols=${{ matrix.symbols }}
- name: Prepare
run: touch tclStubInit.c tclOOStubInit.c
working-directory: generic
- name: Build
run: |
make all
- name: Build Test Harness
run: |
make tcltest
- name: Run Tests
run: |
make test
- name: Test-Drive Installation
run: |
make install
- name: Create Distribution Package
run: |
make dist
- name: Convert Documentation to HTML
run: |
make html-tcl
+61
View File
@@ -0,0 +1,61 @@
name: macOS Build and Test
on: [push]
jobs:
with-Xcode:
runs-on: macos-latest
defaults:
run:
shell: bash
working-directory: macosx
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Prepare
run: touch tclStubInit.c tclOOStubInit.c
working-directory: generic
- name: Build
run: make all
- name: Run Tests
run: make test styles=develop
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
Unix-like:
runs-on: macos-latest
strategy:
matrix:
symbols:
- "no"
- "mem"
dtrace:
- "no"
- "yes"
defaults:
run:
shell: bash
working-directory: unix
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c
mkdir "$HOME/install dir"
working-directory: generic
- name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
# Note that macOS is always a 64 bit platform
run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
- name: Build
run: |
make all tcltest
- name: Run Tests
run: |
make test
env:
ERROR_ON_FAILURES: 1
MAC_CI: 1
- name: Trial Installation
run: |
make install
+71
View File
@@ -0,0 +1,71 @@
name: Windows Build and Test
on: [push]
jobs:
MSVC:
runs-on: windows-latest
defaults:
run:
shell: powershell
working-directory: win
# Using powershell means we need to explicitly stop on failure
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Init MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Build
run: |
&nmake -f makefile.vc all
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
- name: Build Test Harness
run: |
&nmake -f makefile.vc tcltest
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
- name: Run Tests
run: |
&nmake -f makefile.vc test
if ($lastexitcode -ne 0) {
throw "nmake exit code: $lastexitcode"
}
env:
ERROR_ON_FAILURES: 1
MSYS-gcc:
runs-on: windows-latest
defaults:
run:
shell: bash
working-directory: win
strategy:
matrix:
symbols:
- "no"
- "mem"
- "all"
# Using powershell means we need to explicitly stop on failure
steps:
- name: Checkout
uses: actions/checkout@v2
- name: Install MSYS2 and Make
run: choco install msys2 make
- name: Prepare
run: |
touch tclStubInit.c tclOOStubInit.c
mkdir "${HOME}/install dir"
working-directory: generic
- name: Configure (symbols=${{ matrix.symbols }})
run: |
./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
env:
CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
- name: Build
run: make all
- name: Build Test Harness
run: make tcltest
- name: Run Tests
run: make test
env:
ERROR_ON_FAILURES: 1
+54 -49
View File
@@ -1,7 +1,8 @@
sudo: false
language: c
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- binutils-mingw-w64-i686
- binutils-mingw-w64-x86-64
@@ -10,77 +11,59 @@ addons:
- gcc-mingw-w64-i686
- gcc-mingw-w64-x86-64
- gcc-multilib
homebrew:
packages:
- libtommath
update: true
matrix:
jobs:
include:
# Testing on Linux with various compilers
# Testing on Linux GCC
- name: "Linux/GCC/Shared"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- name: "Linux/GCC/Shared: UTF_MAX=4"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT=CFLAGS=-DTCL_UTF_MAX=4
- name: "Linux/GCC/Shared: UTF_MAX=6"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
- name: "Linux/GCC/Static"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/GCC/Debug"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols"
- name: "Linux/GCC/Mem-Debug"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols=mem"
# Older versions of GCC...
- name: "Linux/GCC 7/Shared"
# Newer/Older versions of GCC
- name: "Linux/GCC 10/Shared"
os: linux
dist: bionic
compiler: gcc-7
dist: focal
compiler: gcc-10
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-7
env:
- BUILD_DIR=unix
- name: "Linux/GCC 6/Shared"
os: linux
dist: bionic
compiler: gcc-6
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-6
- g++-10
env:
- BUILD_DIR=unix
- name: "Linux/GCC 5/Shared"
@@ -89,44 +72,42 @@ matrix:
compiler: gcc-5
addons:
apt:
sources:
- ubuntu-toolchain-r-test
packages:
- g++-5
env:
- BUILD_DIR=unix
# Clang
# Testing on Linux Clang
- name: "Linux/Clang/Shared"
os: linux
dist: bionic
dist: focal
compiler: clang
env:
- BUILD_DIR=unix
- name: "Linux/Clang/Static"
os: linux
dist: bionic
dist: focal
compiler: clang
env:
- CFGOPT="--disable-shared"
- BUILD_DIR=unix
- name: "Linux/Clang/Debug"
os: linux
dist: bionic
dist: focal
compiler: clang
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols"
- name: "Linux/Clang/Mem-Debug"
os: linux
dist: bionic
dist: focal
compiler: clang
env:
- BUILD_DIR=unix
- CFGOPT="--enable-symbols=mem"
# Testing on Mac, various styles
- name: "macOS/Xcode 11.5/Shared"
- name: "macOS/Xcode 12/Shared"
os: osx
osx_image: xcode11.5
osx_image: xcode12.2
env:
- BUILD_DIR=macosx
install: []
@@ -134,15 +115,24 @@ matrix:
- make all
# The styles=develop avoids some weird problems on OSX
- make test styles=develop
- name: "macOS/Xcode 11.5/Shared/Unix-like"
- name: "macOS/Xcode 12/Shared/Unix-like"
os: osx
osx_image: xcode11.5
osx_image: xcode12.2
env:
- BUILD_DIR=unix
- CFGOPT="--enable-dtrace"
# Newer MacOS versions
- name: "macOS/Xcode 12/Universal Apps/Shared"
os: osx
osx_image: xcode12u
env:
- BUILD_DIR=macosx
install: []
script: *mactest
# Older MacOS versions
- name: "macOS/Xcode 11/Shared"
os: osx
osx_image: xcode11
osx_image: xcode11.7
env:
- BUILD_DIR=macosx
install: []
@@ -156,7 +146,7 @@ matrix:
script: *mactest
- name: "macOS/Xcode 9/Shared"
os: osx
osx_image: xcode9.2
osx_image: xcode9.4
env:
- BUILD_DIR=macosx
install: []
@@ -172,7 +162,7 @@ matrix:
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows/GCC/Shared/no test"
os: linux
dist: bionic
dist: focal
compiler: x86_64-w64-mingw32-gcc
env:
- BUILD_DIR=win
@@ -186,7 +176,7 @@ matrix:
# Doesn't run tests because wine is only an imperfect Windows emulation
- name: "Linux-cross-Windows-32/GCC/Shared/no test"
os: linux
dist: bionic
dist: focal
compiler: i686-w64-mingw32-gcc
env:
- BUILD_DIR=win
@@ -200,6 +190,8 @@ matrix:
- BUILD_DIR=win
- VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
before_install: &vcpreinst
- rm -rf tests/safe-stock8*.test
- touch generic/tclStubInit.c generic/tclOOStubInit.c
- PATH="$PATH:$VCDIR"
- cd ${BUILD_DIR}
install: []
@@ -224,6 +216,15 @@ matrix:
script:
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
- name: "Windows/MSVC/StaticPackage"
os: windows
compiler: cl
env: *vcenv
before_install: *vcpreinst
install: []
script:
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest
- cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test
- name: "Windows/MSVC/Debug"
os: windows
compiler: cl
@@ -296,6 +297,8 @@ matrix:
- BUILD_DIR=win
- CFGOPT="--enable-64bit"
before_install: &makepreinst
- rm -rf tests/safe-stock8*.test
- touch generic/tclStubInit.c generic/tclOOStubInit.c
- choco install -y make
- cd ${BUILD_DIR}
- name: "Windows/GCC/Shared: UTF_MAX=4"
@@ -364,13 +367,15 @@ matrix:
# "make dist" only
- name: "Linux: make dist"
os: linux
dist: bionic
dist: focal
compiler: gcc
env:
- BUILD_DIR=unix
script:
- make dist
before_install:
- rm -rf tests/safe-stock8*.test
- touch generic/tclStubInit.c generic/tclOOStubInit.c
- cd ${BUILD_DIR}
install:
- mkdir "$HOME/install dir"
@@ -378,6 +383,6 @@ install:
before_script:
- export ERROR_ON_FAILURES=1
script:
- make all tcltest
- make all tcltest || echo "Something wrong, maybe a hickup, let's try again"
- make test
- make install
+2 -2
View File
@@ -351,7 +351,7 @@
* mac/tclMacFile.c: fixed bug in permission checking code
* mac/tclMacLoad.c: corrected utf8 handling, comparison of package
* mac/tclMacLoad.c: corrected utf-8 handling, comparison of package
names to code fragment names changed to only match on the length of
package name, this allows for fragment names with version numbers
appended.
@@ -3525,7 +3525,7 @@
* generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid
a read off the end of the argument array that could occur when
executing something like [unset -nocomplain] was executed. Improved
the error message given when too few arguments are given (-nocomplain
the error message given when not enough arguments are given (-nocomplain
should obviously be *before* --, not after it) and also modified the
test suite to take account of that and the documentation to use the
same improvement. [Bug 405769]
+1 -1
View File
@@ -1753,7 +1753,7 @@
2002-07-05 Reinhard Max <max@suse.de>
* generic/tclClock.c (FormatClock): Convert the format string to UTF8
* generic/tclClock.c (FormatClock): Convert the format string to utf-8
before calling TclpStrftime, so that non-ASCII characters don't get
mangled when the result string is being converted back.
* tests/clock.test: Added a test for that.
+2 -2
View File
@@ -2302,7 +2302,7 @@
934511].
* doc/CrtCommand.3: Added note that the arguments given to the command
proc of a Tcl_CreateCommand are in utf8 since Tcl 8.1. Closing [Patch
proc of a Tcl_CreateCommand are in utf-8 since Tcl 8.1. Closing [Patch
414778].
* doc/ChnlStack.3: Removed the declaration that the interp argument to
@@ -2873,7 +2873,7 @@
2004-06-02 Jeff Hobbs <jeffh@ActiveState.com>
* win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA
(Win9x), convert from CP_ACP to WCHAR then convert back to utf8.
(Win9x), convert from CP_ACP to WCHAR then convert back to utf-8.
Adjunct to 2004-04-07 fix.
2004-06-02 David Gravereaux <davygrvy@pobox.com>
+14 -1
View File
@@ -5,7 +5,20 @@ This is the **Tcl 8.6.10** source distribution.
You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).
[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=core-8-6-branch)](https://travis-ci.org/tcltk/tcl)
8.6.10
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
<br>
8.7a4
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
<br>
9.0a2
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)
## Contents
1. [Introduction](#intro)
+1 -1
View File
@@ -36,7 +36,7 @@ mkstemp(
{
static const char alphanumerics[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
register char *a, *b;
char *a, *b;
int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */
a = template + strlen(template);
+57 -30
View File
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -19,32 +19,47 @@ int
int
\fBTcl_MakeSafe\fR(\fIinterp\fR)
.sp
.VS "TIP 581"
Tcl_Interp *
\fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR)
.VE "TIP 581"
.sp
Tcl_Interp *
\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR)
.sp
.VS "TIP 581"
Tcl_Interp *
\fBTcl_GetChild\fR(\fIinterp, name\fR)
.VE "TIP 581"
.sp
Tcl_Interp *
\fBTcl_GetSlave\fR(\fIinterp, name\fR)
.sp
.VS "TIP 581"
Tcl_Interp *
\fBTcl_GetParent\fR(\fIinterp\fR)
.VE "TIP 581"
.sp
Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
int
\fBTcl_GetInterpPath\fR(\finterp, slaveInterp\fR)
\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
.sp
int
\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
\fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
argc, argv\fR)
.sp
int
\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
\fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
objc, objv\fR)
.sp
int
\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
argcPtr, argvPtr\fR)
.sp
int
\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
objcPtr, objvPtr\fR)
.sp
int
@@ -57,16 +72,16 @@ int
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *name in
Name of slave interpreter to create or manipulate.
Name of child interpreter to create or manipulate.
.AP int isSafe in
If non-zero, a
.QW safe
slave that is suitable for running untrusted code
is created, otherwise a trusted slave is created.
.AP Tcl_Interp *slaveInterp in
child that is suitable for running untrusted code
is created, otherwise a trusted child is created.
.AP Tcl_Interp *childInterp in
Interpreter to use for creating the source command for an alias (see
below).
.AP "const char" *slaveCmd in
.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
@@ -121,17 +136,21 @@ interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new slave.
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
\fBTcl_CreateSlave\fR creates a new interpreter as a child of \fIinterp\fR.
It also creates a child command named \fIchildName\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new child.
If \fIisSafe\fR is zero, the command creates a trusted child in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
.QW safe
slave in which Tcl code has access only to set of Tcl commands defined as
child in which Tcl code has access only to set of Tcl commands defined as
.QW "Safe Tcl" ;
see the manual entry for the Tcl \fBinterp\fR command for details.
If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
If the creation of the new child interpreter failed, \fBNULL\fR is returned.
.PP
.VS "TIP 581"
\fBTcl_CreateChild\fR is a synonym for \fBTcl_CreateSlave\fR.
.VE "TIP 581"
.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
@@ -150,31 +169,39 @@ Callers will want to take care with their use of \fBTcl_MakeSafe\fR
to avoid false claims of safety. For many situations, \fBTcl_CreateSlave\fR
may be a better choice, since it creates interpreters in a known-safe state.
.PP
\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
\fBTcl_GetSlave\fR returns a pointer to a child interpreter of
\fIinterp\fR. The child interpreter is identified by \fIchildName\fR.
If no such child interpreter exists, \fBNULL\fR is returned.
.PP
.VS "TIP 581"
\fBTcl_GetChild\fR is a synonym for \fBTcl_GetSlave\fR.
.VE "TIP 581"
.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIaskingInterp\fR
the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
.VS "TIP 581"
\fBTcl_GetParent\fR is a synonym for \fBTcl_GetMaster\fR.
.VE "TIP 581"
.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
the relative path between \fIinterp\fR and \fIchildInterp\fR;
\fIchildInterp\fR must be a child of \fIinterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
result of \fIaskingInterp\fR.
result of \fIinterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
\fBTcl_CreateAlias\fR creates a command named \fIchildCmd\fR in
\fIchildInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
invocation of \fIchildCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
it fails; in that case, an error message is left in the value result
of \fIslaveInterp\fR.
of \fIchildInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
created by \fBTcl_CreateSlave\fR) between \fIchildInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
@@ -233,4 +260,4 @@ interp
.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave
parent, child
+2 -2
View File
@@ -1350,11 +1350,11 @@ is considered to be owned by the filesystem (not by Tcl's core), but
should be given a reference count for Tcl. Tcl will use the contents of the
list and then decrement that reference count. This allows filesystems to
choose whether they actually want to retain a
.QW "master list"
.QW "global list"
of volumes
or not (if not, they generate the list on the fly and pass it to Tcl
with a reference count of 1 and then forget about the list, if yes, then
they simply increment the reference count of their master list and pass it
they simply increment the reference count of their global list and pass it
to Tcl which will copy the contents and then decrement the count back
to where it was).
.PP
+1 -1
View File
@@ -116,7 +116,7 @@ execution of the callbacks is unspecified) execution in the limited
interpreter is stopped by raising an error and setting a flag that
prevents the \fBcatch\fR command in that interpreter from trapping
that error. It is up to the context that started execution in that
interpreter (typically a master interpreter) to handle the error.
interpreter (typically the main interpreter) to handle the error.
.SH "LIMIT CHECKING API"
.PP
To check the resource limits for an interpreter, call
+6 -6
View File
@@ -79,7 +79,7 @@ against the standard Tcl library. Extensions (stub-enabled or
not) are not intended to call \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not thread-safe. It should only be called by
a single master thread of a multi-threaded application. This
a single main thread of a multi-threaded application. This
restriction is not a problem with normal use described above.
.PP
\fBTcl_Main\fR and therefore all applications based upon it, like
@@ -112,7 +112,7 @@ The file name and encoding values managed by the routines
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
are stored per-thread. Although the storage and retrieval
functions of these routines work in any thread, only those
calls in the same master thread as \fBTcl_Main\fR can have
calls in the same main thread as \fBTcl_Main\fR can have
any influence on it.
.PP
The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
@@ -126,7 +126,7 @@ a \fIstartup script\fR, and \fIname\fR is taken to be the name
of the encoding of the contents of that file. \fBTcl_Main\fR
then calls \fBTcl_SetStartupScript\fR with these values.
.PP
\fBTcl_Main\fR then defines in its master interpreter
\fBTcl_Main\fR then defines in its main interpreter
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
.PP
@@ -154,9 +154,9 @@ When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
been requested, if any. If a startup script has been provided,
\fBTcl_Main\fR attempts to evaluate it. Otherwise, interactive
mode begins with examination of the variable \fItcl_rcFileName\fR
in the master interpreter. If that variable exists and holds the
in the main interpreter. If that variable exists and holds the
name of a readable file, the contents of that file are evaluated
in the master interpreter. Then interactive operations begin,
in the main interpreter. Then interactive operations begin,
with prompts and command evaluation results written to the standard
output channel, and commands read from the standard input channel
and then evaluated. The prompts written to the standard output
@@ -164,7 +164,7 @@ channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
The prompts and command evaluation results are written to the standard
output channel only if the Tcl variable \fItcl_interactive\fR in the
master interpreter holds a non-zero integer value.
main interpreter holds a non-zero integer value.
.PP
\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
This allows, for example, Tk to be dynamically loaded and set its event
+6 -6
View File
@@ -472,36 +472,36 @@ The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
\fB%a\fR
On output, receives an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%A\fR
On output, receives the full name (\fIe.g.,\fR \fBMonday\fR) of the day
On output, produces the full name (\fIe.g.,\fR \fBMonday\fR) of the day
of the week in the given locale. On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%b\fR
On output, receives an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
On output, produces an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%B\fR
On output, receives the full name (\fIe.g.,\fR \fBJanuary\fR)
On output, produces the full name (\fIe.g.,\fR \fBJanuary\fR)
of the month in the given locale. On input, matches the name of the month
in the given locale (in either abbreviated or full form, or
any unique prefix of either form).
.TP
\fB%c\fR
On output, receives a localized representation of date and time of day;
On output, produces a localized representation of date and time of day;
the localized representation is expected to use the Gregorian calendar.
On input, matches whatever \fB%c\fR produces.
.TP
\fB%C\fR
On output, receives the number of the century in Indo-Arabic numerals.
On output, produces the number of the century in Indo-Arabic numerals.
On input, matches one or two digits, possibly with leading whitespace,
that are expected to be the number of the century.
.TP
+5 -4
View File
@@ -107,9 +107,9 @@ will produce the value on the right side of the line:
.PP
.CS
.ta 9c
\fBexpr\fR 3.1 + $a \fI6.1\fR
\fBexpr\fR 2 + "$a.$b" \fI5.6\fR
\fBexpr\fR 4*[llength "6 2"] \fI8\fR
\fBexpr\fR {3.1 + $a} \fI6.1\fR
\fBexpr\fR {2 + "$a.$b"} \fI5.6\fR
\fBexpr\fR {4*[llength "6 2"]} \fI8\fR
\fBexpr\fR {{word one} < "word $a"} \fI0\fR
.CE
.SS OPERATORS
@@ -246,7 +246,7 @@ just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome. For example, in the command
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
\fBexpr\fR {$v?[a]:[b]}
.CE
.PP
only one of
@@ -496,4 +496,5 @@ Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
+4
View File
@@ -250,6 +250,10 @@ proc httpHandlerCallback {socket token} {
return $nbytes
}
.CE
.PP
The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding. If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
.PP
If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel. The name of the channel is available to the handler as element \fB-channel\fR of the token array.
.RE
.TP
\fB\-headers\fR \fIkeyvaluelist\fR
+127 -121
View File
@@ -19,18 +19,18 @@ interp \- Create and manipulate Tcl interpreters
.PP
This command makes it possible to create one or more new Tcl
interpreters that co-exist with the creating interpreter in the
same application. The creating interpreter is called the \fImaster\fR
and the new interpreter is called a \fIslave\fR.
A master can create any number of slaves, and each slave can
itself create additional slaves for which it is master, resulting
same application. The creating interpreter is called the \fIparent\fR
and the new interpreter is called a \fIchild\fR.
A parent can create any number of children, and each child can
itself create additional children for which it is parent, resulting
in a hierarchy of interpreters.
.PP
Each interpreter is independent from the others: it has its own name
space for commands, procedures, and global variables.
A master interpreter may create connections between its slaves and
A parent interpreter may create connections between its children and
itself using a mechanism called an \fIalias\fR. An \fIalias\fR is
a command in a slave interpreter which, when invoked, causes a
command to be invoked in its master interpreter or in another slave
a command in a child interpreter which, when invoked, causes a
command to be invoked in its parent interpreter or in another child
interpreter. The only other connections between interpreters are
through environment variables (the \fBenv\fR variable), which are
normally shared among all interpreters in the application,
@@ -41,7 +41,7 @@ share files and to transfer references to open files from one interpreter
to another.
.PP
The \fBinterp\fR command also provides support for \fIsafe\fR
interpreters. A safe interpreter is a slave whose functions have
interpreters. A safe interpreter is a child whose functions have
been greatly restricted, so that it is safe to execute untrusted
scripts without fear of them damaging other interpreters or the
application's environment. For example, all IO channel creation
@@ -54,18 +54,18 @@ instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
kernel call) between a slave interpreter and its master.
kernel call) between a child interpreter and its parent.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl lists containing a subset of its
A qualified interpreter name is a proper Tcl list containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate master. Interpreter names are relative to the
interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
.QW \fBa\fR
is a slave of the current interpreter and it has a slave
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a slave
which in turn has a child
.QW \fBa11\fR ,
the qualified name of
.QW \fBa11\fR
@@ -77,14 +77,14 @@ is the list
The \fBinterp\fR command, described below, accepts qualified interpreter
names as arguments; the interpreter in which the command is being evaluated
can always be referred to as \fB{}\fR (the empty list or string). Note that
it is impossible to refer to a master (ancestor) interpreter by name in a
slave interpreter except through aliases. Also, there is no global name by
it is impossible to refer to a parent (ancestor) interpreter by name in a
child interpreter except through aliases. Also, there is no global name by
which one can refer to the first interpreter created in an application.
Both restrictions are motivated by safety concerns.
.SH "THE INTERP COMMAND"
.PP
The \fBinterp\fR command is used to create, delete, and manipulate
slave interpreters, and to share or transfer
child interpreters, and to share or transfer
channels between interpreters. It can have any of several forms, depending
on the \fIsubcommand\fR argument:
.TP
@@ -94,11 +94,11 @@ Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the name of the source command in the
slave is different from \fIsrcToken\fR).
child is different from \fIsrcToken\fR).
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
Deletes the alias for \fIsrcToken\fR in the child interpreter identified by
\fIsrcPath\fR.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
@@ -106,9 +106,9 @@ command will be deleted.
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
.
This command creates an alias between one slave and another (see the
\fBalias\fR slave command below for creating aliases between a slave
and its master). In this command, either of the slave interpreters
This command creates an alias between one child and another (see the
\fBalias\fR child command below for creating aliases between a child
and its parent). In this command, either of the child interpreters
may be anywhere in the hierarchy of interpreters under the interpreter
invoking the command.
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
@@ -117,9 +117,9 @@ interpreter. For example,
.QW "\fBa b\fR"
identifies an interpreter
.QW \fBb\fR ,
which is a slave of interpreter
which is a child of interpreter
.QW \fBa\fR ,
which is a slave of the invoking interpreter. An empty list specifies
which is a child of the invoking interpreter. An empty list specifies
the interpreter invoking the command. \fIsrcCmd\fR gives the name of
a new command, which will be created in the source interpreter.
\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
@@ -171,33 +171,33 @@ used.
.TP
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
.
Creates a slave interpreter identified by \fIpath\fR and a new command,
called a \fIslave command\fR. The name of the slave command is the last
component of \fIpath\fR. The new slave interpreter and the slave command
Creates a child interpreter identified by \fIpath\fR and a new command,
called a \fIchild command\fR. The name of the child command is the last
component of \fIpath\fR. The new child interpreter and the child command
are created in the interpreter identified by the path obtained by removing
the last component from \fIpath\fR. For example, if \fIpath\fR is \fBa b
c\fR then a new slave interpreter and slave command named \fBc\fR are
c\fR then a new child interpreter and child command named \fBc\fR are
created in the interpreter identified by the path \fBa b\fR.
The slave command may be used to manipulate the new interpreter as
The child command may be used to manipulate the new interpreter as
described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
interpreter and the slave command. If the \fB\-safe\fR switch is specified
(or if the master interpreter is a safe interpreter), the new slave
interpreter and the child command. If the \fB\-safe\fR switch is specified
(or if the parent interpreter is a safe interpreter), the new child
interpreter will be created as a safe interpreter with limited
functionality; otherwise the slave will include the full set of Tcl
functionality; otherwise the child will include the full set of Tcl
built-in commands and variables. The \fB\-\|\-\fR switch can be used to
mark the end of switches; it may be needed if \fIpath\fR is an unusual
value such as \fB\-safe\fR. The result of the command is the name of the
new interpreter. The name of a slave interpreter must be unique among all
the slaves for its master; an error occurs if a slave interpreter by the
given name already exists in this master.
The initial recursion limit of the slave interpreter is set to the
new interpreter. The name of a child interpreter must be unique among all
the children for its parent; an error occurs if a child interpreter by the
given name already exists in this parent.
The initial recursion limit of the child interpreter is set to the
current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR. If no arguments are
child interpreter identified by \fIpath\fR. If no arguments are
given, option and current setting are returned. If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
@@ -239,8 +239,8 @@ consistency of the underlying interpreter's state.
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
arguments, and for each interpreter, it also deletes its children. The
command also deletes the child command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
@@ -248,20 +248,20 @@ exists, the command raises an error.
.
This command concatenates all of the \fIarg\fR arguments in the same
fashion as the \fBconcat\fR command, then evaluates the resulting string as
a Tcl script in the slave interpreter identified by \fIpath\fR. The result
a Tcl script in the child interpreter identified by \fIpath\fR. The result
of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame of the
\fIpath\fR interpreter; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
\fIpath\fR interpreter; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
and stack frame.
.TP
\fBinterp exists \fIpath\fR
.
Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
Returns \fB1\fR if a child interpreter by the specified \fIpath\fR
exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the
invoking interpreter is used.
.TP
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
@@ -287,7 +287,7 @@ Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
@@ -373,9 +373,15 @@ interpreter is destroyed.
.TP
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
.
Returns a Tcl list of the names of all the slave interpreters associated
Returns a Tcl list of the names of all the child interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.VS "TIP 581"
.TP
\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
.
Synonym for . \fBinterp\fR \fBslaves\fR ?\fIpath\fR?
.VE "TIP 581"
.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
.
@@ -393,48 +399,48 @@ The target command does not have to be defined at the time of this invocation.
Causes the IO channel identified by \fIchannelId\fR to become available in
the interpreter identified by \fIdestPath\fR and unavailable in the
interpreter identified by \fIsrcPath\fR.
.SH "SLAVE COMMAND"
.SH "child COMMAND"
.PP
For each slave interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the master interpreter with the same
For each child interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the parent interpreter with the same
name as the new interpreter. This command may be used to invoke
various operations on the interpreter. It has the following
general form:
.PP
.CS
\fIslave command \fR?\fIarg arg ...\fR?
\fIchild command \fR?\fIarg arg ...\fR?
.CE
.PP
\fISlave\fR is the name of the interpreter, and \fIcommand\fR
\fIchild\fR is the name of the interpreter, and \fIcommand\fR
and the \fIarg\fRs determine the exact behavior of the command.
The valid forms of this command are:
.TP
\fIslave \fBaliases\fR
\fIchild \fBaliases\fR
.
Returns a Tcl list whose elements are the tokens of all the
aliases in \fIslave\fR. The tokens correspond to the values returned when
aliases in \fIchild\fR. The tokens correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fIslave \fBalias \fIsrcToken\fR
\fIchild \fBalias \fIsrcToken\fR
.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the actual source command in the
slave is different from \fIsrcToken\fR).
child is different from \fIsrcToken\fR).
.TP
\fIslave \fBalias \fIsrcToken \fB{}\fR
\fIchild \fBalias \fIsrcToken \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the slave interpreter.
Deletes the alias for \fIsrcToken\fR in the child interpreter.
\fIsrcToken\fR refers to the value returned when the alias
was created; if the source command has been renamed, the renamed
command will be deleted.
.TP
\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
\fIchild \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
.
Creates an alias such that whenever \fIsrcCmd\fR is invoked
in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
in \fIchild\fR, \fItargetCmd\fR is invoked in the parent.
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
arguments, prepended before any arguments passed in the invocation of
\fIsrcCmd\fR.
@@ -443,69 +449,69 @@ The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
\fIchild \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
for the \fIchild\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
\fIchild \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIslave\fR.
the resulting string as a Tcl script in \fIchild\fR.
The result of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame
of \fIslave\fR; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
of \fIchild\fR; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
and stack frame.
.TP
\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
\fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
.
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in \fIslave\fR.
in \fIchild\fR.
If an exposed command with the targeted name already exists, this command
fails.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
\fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
.
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
argument is not given, in the \fIslave\fR interpreter.
argument is not given, in the \fIchild\fR interpreter.
If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBhidden\fR
\fIchild \fBhidden\fR
.
Returns a list of the names of all hidden commands in \fIslave\fR.
Returns a list of the names of all hidden commands in \fIchild\fR.
.TP
\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
\fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
.
This command invokes the hidden command \fIhiddenName\fR with the
supplied arguments, in \fIslave\fR. No substitutions or evaluations are
supplied arguments, in \fIchild\fR. No substitutions or evaluations are
applied to the arguments. Three \fI\-option\fRs are supported, all
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
If the \fB\-namespace\fR flag is given, the hidden command is invoked in
the specified namespace in the slave.
the specified namespace in the child.
If the \fB\-global\fR flag is given, the command is invoked at the global
level in the slave; otherwise it is invoked at the current call frame and
level in the child; otherwise it is invoked at the current call frame and
can access local variables in that or outer call frames.
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
.QW \-
@@ -513,37 +519,37 @@ character, and is otherwise unnecessary.
If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of \fIslave\fR.
current context stack frame of \fIchild\fR.
For more details on hidden commands,
see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIslave \fBissafe\fR
\fIchild \fBissafe\fR
.
Returns \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise.
.TP
\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.
Sets up, manipulates and queries the configuration of the resource
limit \fIlimitType\fR for the slave interpreter. If no \fI\-option\fR
limit \fIlimitType\fR for the child interpreter. If no \fI\-option\fR
is specified, return the current configuration of the limit. If
\fI\-option\fR is the sole argument, return the value of that option.
Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
what limits and options are supported.
.TP
\fIslave \fBmarktrusted\fR
\fIchild \fBmarktrusted\fR
.
Marks the slave interpreter as trusted. Can only be invoked by a
Marks the child interpreter as trusted. Can only be invoked by a
trusted interpreter. This command does not expose any hidden
commands in the slave interpreter. The command has no effect if the slave
commands in the child interpreter. The command has no effect if the child
is already trusted.
.TP
\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
.
Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
Returns the maximum allowable nesting depth for the \fIchild\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
and related procedures in \fIslave\fR will return an error.
and related procedures in \fIchild\fR will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
maximum value of a non-long integer on the platform.
@@ -567,14 +573,14 @@ For example, commands to create files on disk are removed, and the
\fBexec\fR command is removed, since it could be used to cause damage
through subprocesses.
Limited access to these facilities can be provided, by creating
aliases to the master interpreter which check their arguments carefully
aliases to the parent interpreter which check their arguments carefully
and provide restricted access to a safe subset of facilities.
For example, file creation might be allowed in a particular subdirectory
and subprocess invocation might be allowed for a carefully selected and
fixed set of programs.
.PP
A safe interpreter is created by specifying the \fB\-safe\fR switch
to the \fBinterp create\fR command. Furthermore, any slave created
to the \fBinterp create\fR command. Furthermore, any child created
by a safe interpreter will also be safe.
.PP
A safe interpreter is created with exactly the following set of
@@ -661,15 +667,15 @@ including itself.
.SH "ALIAS INVOCATION"
.PP
The alias mechanism has been carefully designed so that it can
be used safely when an untrusted script is executing
in a safe slave and the target of the alias is a trusted
master. The most important thing in guaranteeing safety is to
ensure that information passed from the slave to the master is
never evaluated or substituted in the master; if this were to
occur, it would enable an evil script in the slave to invoke
arbitrary functions in the master, which would compromise security.
be used safely in an untrusted script which is being executed in a
safe interpreter even if the target of the alias is not a safe
interpreter. The most important thing in guaranteeing safety is to
ensure that information passed from the child to the parent is
never evaluated or substituted in the parent; if this were to
occur, it would enable an evil script in the child to invoke
arbitrary functions in the parent, which would compromise security.
.PP
When the source for an alias is invoked in the slave interpreter, the
When the source for an alias is invoked in the child interpreter, the
usual Tcl substitutions are performed when parsing that command.
These substitutions are carried out in the source interpreter just
as they would be for any other command invoked in that interpreter.
@@ -696,8 +702,8 @@ the alias's source command is parsed in the source interpreter.
When writing the \fItargetCmd\fRs for aliases in safe interpreters,
it is very important that the arguments to that command never be
evaluated or substituted, since this would provide an escape
mechanism whereby the slave interpreter could execute arbitrary
code in the master. This in turn would compromise the security
mechanism whereby the child interpreter could execute arbitrary
code in the parent. This in turn would compromise the security
of the system.
.SH "HIDDEN COMMANDS"
.PP
@@ -724,28 +730,28 @@ invoke\fR. Hidden commands and exposed commands reside in separate name
spaces. It is possible to define a hidden command and an exposed command by
the same name within one interpreter.
.PP
Hidden commands in a slave interpreter can be invoked in the body of
procedures called in the master during alias invocation. For example, an
alias for \fBsource\fR could be created in a slave interpreter. When it is
invoked in the slave interpreter, a procedure is called in the master
Hidden commands in a child interpreter can be invoked in the body of
procedures called in the parent during alias invocation. For example, an
alias for \fBsource\fR could be created in a child interpreter. When it is
invoked in the child interpreter, a procedure is called in the parent
interpreter to check that the operation is allowable (e.g. it asks to
source a file that the slave interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the slave
source a file that the child interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the child
interpreter to actually source in the contents of the file. Note that two
commands named \fBsource\fR exist in the slave interpreter: the alias, and
commands named \fBsource\fR exist in the child interpreter: the alias, and
the hidden command.
.PP
Because a master interpreter may invoke a hidden command as part of
Because a parent interpreter may invoke a hidden command as part of
handling an alias invocation, great care must be taken to avoid evaluating
any arguments passed in through the alias invocation.
Otherwise, malicious slave interpreters could cause a trusted master
Otherwise, malicious child interpreters could cause a trusted parent
interpreter to execute dangerous commands on their behalf. See the section
on \fBALIAS INVOCATION\fR for a more complete discussion of this topic.
To help avoid this problem, no substitutions or evaluations are
applied to arguments of \fBinterp invokehidden\fR.
.PP
Safe interpreters are not allowed to invoke hidden commands in themselves
or in their descendants. This prevents safe slaves from gaining access to
or in their descendants. This prevents them from gaining access to
hidden functionality in themselves or their descendants.
.PP
The set of hidden commands in an interpreter can be manipulated by a trusted
@@ -764,12 +770,12 @@ qualifiers, and you must first rename a command in a namespace to the
global namespace before you can hide it.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents slaves from fooling a master interpreter into hiding the wrong
prevents children from fooling a parent interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
.SH "RESOURCE LIMITS"
.PP
Every interpreter has two kinds of resource limits that may be imposed by any
master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
parent interpreter upon its children. Command limits (of type \fBcommand\fR)
restrict the total number of Tcl commands that may be executed by an
interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
time limits (of type \fBtime\fR) place a limit by which execution within the
@@ -778,7 +784,7 @@ interpreter must complete. Note that time limits are expressed as
\fBafter\fR) because they may be modified after creation.
.PP
When a limit is exceeded for an interpreter, first any handler callbacks
defined by master interpreters are called. If those callbacks increase or
defined by parent interpreters are called. If those callbacks increase or
remove the limit, execution within the (previously) limited interpreter
continues. If the limit is still in force, an error is generated at that point
and normal processing of errors within the interpreter (by the \fBcatch\fR
@@ -835,13 +841,13 @@ This option specifies the number of commands that the interpreter may execute
before triggering the command limit. This option may be the empty string,
which indicates that a command limit is not set for the interpreter.
.PP
Where an interpreter with a resource limit set on it creates a slave
interpreter, that slave interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating master
interpreter. If the master interpreter of the limited master wishes to relax
Where an interpreter with a resource limit set on it creates a child
interpreter, that child interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating parent
interpreter. If the parent interpreter of the limited parent wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
access as it chooses to the \fBinterp\fR command to the limited master as
access as it chooses to the \fBinterp\fR command to the limited parent as
necessary.
.SH "BACKGROUND EXCEPTION HANDLING"
.PP
@@ -902,9 +908,9 @@ set i [\fBinterp create\fR]
}
.CE
.SH "SEE ALSO"
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3)
.SH KEYWORDS
alias, master interpreter, safe interpreter, slave interpreter
alias, parent interpreter, safe interpreter, child interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:
+1 -1
View File
@@ -124,7 +124,7 @@ will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
generate a new index file \fBfoo/tclIndex\fR.
.PP
\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
slave interpreter and monitoring the proc and namespace commands that
child interpreter and monitoring the proc and namespace commands that
are executed. Extensions can use the (undocumented)
auto_mkindex_parser package to register other commands that can
contribute to the auto_load index. You will have to read through
+2 -2
View File
@@ -42,7 +42,7 @@ The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
It does this by loading each file into a slave
It does this by loading each file into a child
interpreter and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
@@ -109,7 +109,7 @@ the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
current interpreter and match \fIpkgPat\fR into the slave interpreter used to
current interpreter and match \fIpkgPat\fR into the child interpreter used to
generate the index. The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
+59 -51
View File
@@ -11,17 +11,17 @@
.SH NAME
safe \- Creating and manipulating safe interpreters
.SH SYNOPSIS
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
.sp
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpDelete\fR \fIslave\fR
\fB::safe::interpDelete\fR \fIchild\fR
.sp
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
.sp
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
.SS OPTIONS
@@ -44,7 +44,7 @@ application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
hosting application to any party.
.PP
Safe Tcl allows a master interpreter to create safe, restricted
Safe Tcl allows a parent interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
@@ -53,39 +53,47 @@ No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
master interpreter transparently
parent interpreter transparently
translates the token into a real directory name and executes the
requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
.PP
All commands provided in the master interpreter by Safe Tcl reside in
All commands provided in the parent interpreter by Safe Tcl reside in
the \fBsafe\fR namespace.
.SH COMMANDS
The following commands are provided in the master interpreter:
The following commands are provided in the parent interpreter:
.TP
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
Creates a safe interpreter, installs the aliases described in the section
\fBALIASES\fR and initializes the auto-loading and package mechanism as
specified by the supplied \fIoptions\fR.
See the \fBOPTIONS\fR section below for a description of the
optional arguments.
If the \fIslave\fR argument is omitted, a name will be generated.
If the \fIchild\fR argument is omitted, a name will be generated.
\fB::safe::interpCreate\fR always returns the interpreter name.
.sp
The interpreter name \fIchild\fR may include namespace separators,
but may not have leading or trailing namespace separators, or excess
colon characters in namespace separators. The interpreter name is
qualified relative to the global namespace ::, not the namespace in which
the \fB::safe::interpCreate\fR command is evaluated.
.TP
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
This command is similar to \fBinterpCreate\fR except it that does not
create the safe interpreter. \fIslave\fR must have been created by some
other means, like \fBinterp create\fR \fB\-safe\fR.
create the safe interpreter. \fIchild\fR must have been created by some
other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter
name \fIchild\fR may include namespace separators, subject to the same
restrictions as for \fBinterpCreate\fR.
.TP
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
named safe interpreter as a list of options and their current values
for that \fIslave\fR.
for that \fIchild\fR.
If a single additional argument is provided,
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
\fIname\fR is the full name of that option and \fIvalue\fR the current value
for that option and the \fIslave\fR.
for that option and the \fIchild\fR.
If more than two additional arguments are provided, it will reconfigure the
safe interpreter and change each and only the provided options.
See the section on \fBOPTIONS\fR below for options description.
@@ -105,14 +113,14 @@ safe::interpConfigure $i0 \-delete {foo bar} \-statics 0
.CE
.RE
.TP
\fB::safe::interpDelete\fR \fIslave\fR
\fB::safe::interpDelete\fR \fIchild\fR
Deletes the safe interpreter and cleans up the corresponding
master interpreter data structures.
parent interpreter data structures.
If a \fIdeleteHook\fR script was specified for this interpreter it is
evaluated before the interpreter is deleted, with the name of the
interpreter as an additional argument.
.TP
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
This command finds and returns the token for the real directory
\fIdirectory\fR in the safe interpreter's current virtual access path.
It generates an error if the directory is not found.
@@ -120,14 +128,14 @@ Example of use:
.RS
.PP
.CS
$slave eval [list set tk_library \e
$child eval [list set tk_library \e
[::safe::interpFindInAccessPath $name $tk_library]]
.CE
.RE
.TP
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
This command adds \fIdirectory\fR to the virtual path maintained for the
safe interpreter in the master, and returns the token that can be used in
safe interpreter in the parent, and returns the token that can be used in
the safe interpreter to obtain access to files in that directory.
If the directory is already in the virtual path, it only returns the token
without adding the directory to the virtual path again.
@@ -135,7 +143,7 @@ Example of use:
.RS
.PP
.CS
$slave eval [list set tk_library \e
$child eval [list set tk_library \e
[::safe::interpAddToAccessPath $name $tk_library]]
.CE
.RE
@@ -168,10 +176,10 @@ Note that the safe interpreter only received an error message saying that
the file was not found:
.PP
.CS
NOTICE for slave interp10 : Created
NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
NOTICE for child interp10 : Created
NOTICE for child interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for child interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for child interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
.SS OPTIONS
@@ -187,7 +195,7 @@ This option sets the list of directories from which the safe interpreter
can \fBsource\fR and \fBload\fR files.
If this option is not specified, or if it is given as the
empty list, the safe interpreter will use the same directories as its
master for auto-loading.
parent for auto-loading.
See the section \fBSECURITY\fR below for more detail about virtual paths,
tokens and access control.
.TP
@@ -216,7 +224,7 @@ to load packages into its own sub-interpreters.
.TP
\fB\-deleteHook\fR \fIscript\fR
When this option is given a non-empty \fIscript\fR, it will be
evaluated in the master with the name of
evaluated in the parent with the name of
the safe interpreter as an additional argument
just before actually deleting the safe interpreter.
Giving an empty value removes any currently installed deletion hook
@@ -281,8 +289,8 @@ potential for information leakage about its directory structure.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
e.g., source a file is mediated by the master interpreter.
This virtual path system is maintained in the master interpreter for each safe
e.g., source a file is mediated by the parent interpreter.
This virtual path system is maintained in the parent interpreter for each safe
interpreter created by \fB::safe::interpCreate\fR or initialized by
\fB::safe::interpInit\fR and
the path maps tokens accessible in the safe interpreter into real path
@@ -291,7 +299,7 @@ from gaining knowledge about the
structure of the file system of the host on which the interpreter is
executing.
The only valid file names arguments
for the \fBsource\fR and \fBload\fR aliases provided to the slave
for the \fBsource\fR and \fBload\fR aliases provided to the child
are path in the form of
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
native file path formats: \fItoken\fB/\fIfilename\fR
@@ -320,26 +328,26 @@ or be called
.PP
Each element of the initial access path
list will be assigned a token that will be set in
the slave \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that slave.
the child \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that child.
.PP
If the access path argument is not given or is the empty list,
the default behavior is to let the slave access the same packages
as the master has access to (Or to be more precise:
the default behavior is to let the child access the same packages
as the parent has access to (Or to be more precise:
only packages written in Tcl (which by definition cannot be dangerous
as they run in the slave interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the master's
\fBauto_path\fR will be used to construct the slave access path.
In order that the slave successfully loads the Tcl library files
as they run in the child interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the parent's
\fBauto_path\fR will be used to construct the child access path.
In order that the child successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
added or moved to the first position if necessary, in the
slave access path, so the slave
\fBtcl_library\fR will be the same as the master's (its real
path will still be invisible to the slave though).
In order that auto-loading works the same for the slave and
the master in this by default case, the first-level
sub directories of each directory in the master \fBauto_path\fR will
also be added (if not already included) to the slave access path.
child access path, so the child
\fBtcl_library\fR will be the same as the parent's (its real
path will still be invisible to the child though).
In order that auto-loading works the same for the child and
the parent in this by default case, the first-level
sub directories of each directory in the parent \fBauto_path\fR will
also be added (if not already included) to the child access path.
You can always specify a more
restrictive path for which sub directories will never be searched by
explicitly specifying your directory list with the \fB\-accessPath\fR flag
@@ -352,8 +360,8 @@ to synchronize its \fBauto_index\fR with the new token list.
.SH "SEE ALSO"
interp(n), library(n), load(n), package(n), source(n), unknown(n)
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source
alias, auto\-loading, auto_mkindex, load, parent interpreter, safe
interpreter, child interpreter, source
'\" Local Variables:
'\" mode: nroff
'\" End:
+11 -11
View File
@@ -203,7 +203,7 @@ array. Returns an empty string.
.TP
\fBrunAllTests\fR
.
This is a master command meant to run an entire suite of tests,
This is a main command meant to run an entire suite of tests,
spanning multiple files and/or directories, as governed by
the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR
below for a complete description of the many variations possible
@@ -804,17 +804,17 @@ then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file. The multi-process operation is useful
when testing can cause errors so severe that a process
terminates. Although such an error may terminate a child
process evaluating one file, the master process can continue
process evaluating one file, the main process can continue
with the rest of the test suite. In multi-process operation,
the configuration of \fBtcltest\fR in the master process is
the configuration of \fBtcltest\fR in the main process is
passed to the child processes as command line arguments,
with the exception of \fBconfigure \-outfile\fR. The
\fBrunAllTests\fR command in the
master process collects all output from the child processes
and collates their results into one master report. Any
main process collects all output from the child processes
and collates their results into one main report. Any
reports of individual test failures, or messages requested
by a \fBconfigure \-verbose\fR setting are passed directly
on to \fBoutputChannel\fR by the master process.
on to \fBoutputChannel\fR by the main process.
.PP
After evaluating all selected test files, a summary of the
results is printed to \fBoutputChannel\fR. The summary
@@ -1134,7 +1134,7 @@ A good namespace to use is a child namespace \fBtest\fR of the namespace
of the module you are testing.
.PP
A test file should also be able to be evaluated directly as a script,
not depending on being called by a master \fBrunAllTests\fR. This
not depending on being called by a main \fBrunAllTests\fR. This
means that each test file should process command line arguments to give
the tester all the configuration control that \fBtcltest\fR provides.
.PP
@@ -1145,7 +1145,7 @@ Here is a sketch of a sample test file illustrating those points:
.RS
.PP
.CS
package require tcltest 2.2
package require tcltest 2.5
eval \fB::tcltest::configure\fR $argv
package require example
namespace eval ::example::test {
@@ -1175,12 +1175,12 @@ doing any necessary setup. This script is usually named \fBall.tcl\fR
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite master script:
Here is a sketch of a sample test suite main script:
.RS
.PP
.CS
package require Tcl 8.4
package require tcltest 2.2
package require Tcl 8.6
package require tcltest 2.5
package require example
\fB::tcltest::configure\fR -testdir \e
[file dirname [file normalize [info script]]]
+1 -1
View File
@@ -73,7 +73,7 @@ struct dfa {
chr *lastnopr; /* location of last cache-flushed NOPROGRESS */
struct sset *search; /* replacement-search-pointer memory */
int cptsmalloced; /* were the areas individually malloced? */
char *mallocarea; /* self, or master malloced area, or NULL */
char *mallocarea; /* self, or malloced area, or NULL */
};
#define WORK 1 /* number of work bitvectors needed */
+7 -7
View File
@@ -316,12 +316,12 @@ declare 85 {
int flags)
}
declare 86 {
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
CONST84 char *const *argv)
}
declare 87 {
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd,
Tcl_Interp *target, const char *targetCmd, int objc,
Tcl_Obj *const objv[])
}
@@ -364,7 +364,7 @@ declare 96 {
Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName,
Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
int isSafe)
}
declare 98 {
@@ -527,12 +527,12 @@ declare 147 {
void Tcl_FreeResult(Tcl_Interp *interp)
}
declare 148 {
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *argcPtr, CONST84 char ***argvPtr)
}
declare 149 {
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
@@ -582,7 +582,7 @@ declare 162 {
CONST84_RETURN char *Tcl_GetHostName(void)
}
declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *slaveInterp)
int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp)
}
declare 164 {
Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
@@ -616,7 +616,7 @@ declare 171 {
int Tcl_GetServiceMode(void)
}
declare 172 {
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *name)
}
declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
+2 -2
View File
@@ -384,7 +384,7 @@ typedef long LONG;
*/
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
# if defined(_WIN32)
# if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
# define TCL_WIDE_INT_TYPE __int64
# ifdef __BORLANDC__
# define TCL_LL_MODIFIER "L"
@@ -2517,7 +2517,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define Tcl_DecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
if ((_objPtr)->refCount-- <= 1) { \
if (_objPtr->refCount-- <= 1) { \
TclFreeObj(_objPtr); \
} \
} while(0)
+13 -13
View File
@@ -24,7 +24,7 @@
#include "tclInt.h"
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
#if USE_TCLALLOC
#if defined(USE_TCLALLOC) && USE_TCLALLOC
/*
* We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
@@ -253,9 +253,9 @@ char *
TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
register union overhead *overPtr;
register long bucket;
register unsigned amount;
union overhead *overPtr;
long bucket;
unsigned amount;
struct block *bigBlockPtr = NULL;
if (!allocInit) {
@@ -274,7 +274,7 @@ TclpAlloc(
if (numBytes >= MAXMALLOC - OVERHEAD) {
if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
bigBlockPtr = (struct block *) TclpSysAlloc(
(sizeof(struct block) + OVERHEAD + numBytes), 0);
}
if (bigBlockPtr == NULL) {
@@ -387,8 +387,8 @@ static void
MoreCore(
int bucket) /* What bucket to allocat to. */
{
register union overhead *overPtr;
register long size; /* size of desired block */
union overhead *overPtr;
long size; /* size of desired block */
long amount; /* amount to allocate */
int numBlocks; /* how many blocks we get */
struct block *blockPtr;
@@ -405,7 +405,7 @@ MoreCore(
numBlocks = amount / size;
ASSERT(numBlocks*size == amount);
blockPtr = (struct block *) TclpSysAlloc((unsigned)
blockPtr = (struct block *) TclpSysAlloc(
(sizeof(struct block) + amount), 1);
/* no more room! */
if (blockPtr == NULL) {
@@ -448,8 +448,8 @@ void
TclpFree(
char *oldPtr) /* Pointer to memory to free. */
{
register long size;
register union overhead *overPtr;
long size;
union overhead *overPtr;
struct block *bigBlockPtr;
if (oldPtr == NULL) {
@@ -604,7 +604,7 @@ TclpRealloc(
if (maxSize < numBytes) {
numBytes = maxSize;
}
memcpy(newPtr, oldPtr, (size_t) numBytes);
memcpy(newPtr, oldPtr, numBytes);
TclpFree(oldPtr);
return newPtr;
}
@@ -645,8 +645,8 @@ void
mstats(
char *s) /* Where to write info. */
{
register int i, j;
register union overhead *overPtr;
int i, j;
union overhead *overPtr;
int totalFree = 0, totalUsed = 0;
Tcl_MutexLock(allocMutexPtr);
+4 -3
View File
@@ -803,7 +803,7 @@ TclNRAssembleObjCmd(
Tcl_AddErrorInfo(interp, "\n (\"");
Tcl_AppendObjToErrorInfo(interp, objv[0]);
Tcl_AddErrorInfo(interp, "\" body, line ");
backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
TclNewIntObj(backtrace, Tcl_GetErrorLine(interp));
Tcl_AppendObjToErrorInfo(interp, backtrace);
Tcl_AddErrorInfo(interp, ")");
return TCL_ERROR;
@@ -2089,8 +2089,9 @@ GetNextOperand(
* with \-substitutions done. */
{
Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
Tcl_Obj* operandObj = Tcl_NewObj();
Tcl_Obj* operandObj;
TclNewObj(operandObj);
if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
Tcl_DecrRefCount(operandObj);
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
@@ -4260,7 +4261,7 @@ AddBasicBlockRangeToErrorInfo(
Tcl_Obj* lineNo; /* Line number in the source */
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
lineNo = Tcl_NewIntObj(bbPtr->startLine);
TclNewIntObj(lineNo, bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
+31 -30
View File
@@ -1036,7 +1036,7 @@ int
TclHideUnsafeCommands(
Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
const CmdInfo *cmdInfoPtr;
if (interp == NULL) {
return TCL_ERROR;
@@ -2485,7 +2485,7 @@ int
TclInvokeStringCommand(
ClientData clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
register int objc, /* Number of arguments. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Command *cmdPtr = clientData;
@@ -2534,7 +2534,7 @@ TclInvokeObjectCommand(
ClientData clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
register const char **argv) /* Argument strings. */
const char **argv) /* Argument strings. */
{
Command *cmdPtr = clientData;
Tcl_Obj *objPtr;
@@ -3025,7 +3025,7 @@ Tcl_GetCommandFullName(
{
Interp *iPtr = (Interp *) interp;
register Command *cmdPtr = (Command *) command;
Command *cmdPtr = (Command *) command;
char *name;
/*
@@ -3268,6 +3268,7 @@ Tcl_DeleteCommandFromToken(
* TclNRExecuteByteCode looks up the command in the command hashtable).
*/
cmdPtr->flags |= CMD_DEAD;
TclCleanupCommandMacro(cmdPtr);
return 0;
}
@@ -3301,7 +3302,7 @@ CallCommandTraces(
* trigger, either TCL_TRACE_DELETE or
* TCL_TRACE_RENAME. */
{
register CommandTrace *tracePtr;
CommandTrace *tracePtr;
ActiveCommandTrace active;
char *result;
Tcl_Obj *oldNamePtr = NULL;
@@ -3443,11 +3444,11 @@ CancelEvalProc(
TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
/*
* Now, we must set the script cancellation flags on all the slave
* Now, we must set the script cancellation flags on all the child
* interpreters belonging to this one.
*/
TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
TclSetChildCancelFlags((Tcl_Interp *) iPtr,
cancelInfo->flags | CANCELED, 0);
/*
@@ -3491,7 +3492,7 @@ CancelEvalProc(
void
TclCleanupCommand(
register Command *cmdPtr) /* Points to the Command structure to
Command *cmdPtr) /* Points to the Command structure to
* be freed. */
{
cmdPtr->refCount--;
@@ -3876,7 +3877,7 @@ int
TclInterpReady(
Tcl_Interp *interp)
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
/*
* Reset both the interpreter's string and object results and clear out
@@ -3948,7 +3949,7 @@ TclResetCancellation(
Tcl_Interp *interp,
int force)
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
if (iPtr == NULL) {
return TCL_ERROR;
@@ -3966,7 +3967,7 @@ TclResetCancellation(
* Tcl_Canceled --
*
* Check if the script in progress has been canceled, i.e.,
* Tcl_CancelEval was called for this interpreter or any of its master
* Tcl_CancelEval was called for this interpreter or any of its parent
* interpreters.
*
* Results:
@@ -3990,7 +3991,7 @@ Tcl_Canceled(
Tcl_Interp *interp,
int flags)
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
/*
* Has the current script in progress for this interpreter been canceled
@@ -4138,7 +4139,7 @@ Tcl_CancelEval(
if (resultObjPtr != NULL) {
result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
memcpy(cancelInfo->result, result, cancelInfo->length);
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
} else {
cancelInfo->result = NULL;
@@ -4331,7 +4332,7 @@ EvalObjvCore(
* Caller gave it to us.
*/
if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
if (!(preCmdPtr->flags & CMD_DEAD)) {
/*
* So long as it exists, use it.
*/
@@ -4719,7 +4720,7 @@ TEOV_NotFound(
newObjv[i] = handlerObjv[i];
Tcl_IncrRefCount(newObjv[i]);
}
memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);
/*
* Look up and invoke the handler (by recursive call to this function). If
@@ -5046,7 +5047,7 @@ TclEvalEx(
* the embedded command, which is refered to
* by 'script'. The 'clNextOuter' refers to
* the current entry in the table of
* continuation lines in this "master script",
* continuation lines in this "main script",
* and the character offsets are relative to
* the 'outerScript' as well.
*
@@ -5505,7 +5506,7 @@ TclAdvanceLines(
const char *start,
const char *end)
{
register const char *p;
const char *p;
for (p = start; p < end; p++) {
if (*p == '\n') {
@@ -6030,7 +6031,7 @@ int
Tcl_EvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6043,7 +6044,7 @@ int
TclEvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6062,7 +6063,7 @@ int
TclNREvalObjEx(
Tcl_Interp *interp, /* Token for command interpreter (returned by
* a previous call to Tcl_CreateInterp). */
register Tcl_Obj *objPtr, /* Pointer to object containing commands to
Tcl_Obj *objPtr, /* Pointer to object containing commands to
* execute. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Supported values
@@ -6370,7 +6371,7 @@ Tcl_ExprLong(
const char *exprstring, /* Expression to evaluate. */
long *ptr) /* Where to store result. */
{
register Tcl_Obj *exprPtr;
Tcl_Obj *exprPtr;
int result = TCL_OK;
if (*exprstring == '\0') {
/*
@@ -6397,7 +6398,7 @@ Tcl_ExprDouble(
const char *exprstring, /* Expression to evaluate. */
double *ptr) /* Where to store result. */
{
register Tcl_Obj *exprPtr;
Tcl_Obj *exprPtr;
int result = TCL_OK;
if (*exprstring == '\0') {
@@ -6477,7 +6478,7 @@ int
Tcl_ExprLongObj(
Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
register Tcl_Obj *objPtr, /* Expression to evaluate. */
Tcl_Obj *objPtr, /* Expression to evaluate. */
long *ptr) /* Where to store long result. */
{
Tcl_Obj *resultPtr;
@@ -6525,7 +6526,7 @@ int
Tcl_ExprDoubleObj(
Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
register Tcl_Obj *objPtr, /* Expression to evaluate. */
Tcl_Obj *objPtr, /* Expression to evaluate. */
double *ptr) /* Where to store double result. */
{
Tcl_Obj *resultPtr;
@@ -6561,7 +6562,7 @@ int
Tcl_ExprBooleanObj(
Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
register Tcl_Obj *objPtr, /* Expression to evaluate. */
Tcl_Obj *objPtr, /* Expression to evaluate. */
int *ptr) /* Where to store 0/1 result. */
{
Tcl_Obj *resultPtr;
@@ -6673,7 +6674,7 @@ TclNRInvoke(
int objc,
Tcl_Obj *const objv[])
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
const char *cmdName; /* Name of the command from objv[0]. */
Tcl_HashEntry *hPtr = NULL;
@@ -6867,7 +6868,7 @@ Tcl_AddObjErrorInfo(
int length) /* The number of bytes in the message. If < 0,
* then append all bytes up to a NULL byte. */
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
/*
* If we are just starting to log an error, errorInfo is initialized from
@@ -7015,7 +7016,7 @@ Tcl_GlobalEval(
* command. */
const char *command) /* Command to evaluate. */
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
int result;
CallFrame *savedVarFramePtr;
@@ -8006,8 +8007,8 @@ MathFuncWrongNumArgs(
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"too %s arguments for math function \"%s\"",
(found < expected ? "few" : "many"), name));
"%s arguments for math function \"%s\"",
(found < expected ? "not enough" : "too many"), name));
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
}
+13 -13
View File
@@ -199,7 +199,7 @@ typedef struct ByteArray {
* array. */
int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[1]; /* The array of bytes. The actual size of this
unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
* above. */
} ByteArray;
@@ -334,12 +334,12 @@ Tcl_SetByteArrayObj(
if (length < 0) {
length = 0;
}
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr->used = length;
byteArrayPtr->allocated = length;
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
memcpy(byteArrayPtr->bytes, bytes, length);
}
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
@@ -460,7 +460,7 @@ SetByteArrayFromAny(
src = TclGetStringFromObj(objPtr, &length);
srcEnd = src + length;
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += TclUtfToUniChar(src, &ch);
*dst++ = UCHAR(ch);
@@ -529,10 +529,10 @@ DupByteArrayInternalRep(
srcArrayPtr = GET_BYTEARRAY(srcPtr);
length = srcArrayPtr->used;
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
copyPtr->typePtr = &tclByteArrayType;
@@ -588,12 +588,12 @@ UpdateStringOfByteArray(
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
dst = ckalloc(size + 1);
dst = (char *)ckalloc(size + 1);
objPtr->bytes = dst;
objPtr->length = size;
if (size == length) {
memcpy(dst, src, (size_t) size);
memcpy(dst, src, size);
dst[size] = '\0';
} else {
for (i = 0; i < length; i++) {
@@ -945,7 +945,7 @@ BinaryFormatCmd(
resultPtr = Tcl_NewObj();
buffer = Tcl_SetByteArrayLength(resultPtr, length);
memset(buffer, 0, (size_t) length);
memset(buffer, 0, length);
/*
* Pack the data into the result object. Note that we can skip the error
@@ -982,10 +982,10 @@ BinaryFormatCmd(
count = 1;
}
if (length >= count) {
memcpy(cursor, bytes, (size_t) count);
memcpy(cursor, bytes, count);
} else {
memcpy(cursor, bytes, (size_t) length);
memset(cursor + length, pad, (size_t) (count - length));
memcpy(cursor, bytes, length);
memset(cursor + length, pad, count - length);
}
cursor += count;
break;
@@ -1174,7 +1174,7 @@ BinaryFormatCmd(
if (count == BINARY_NOCOUNT) {
count = 1;
}
memset(cursor, 0, (size_t) count);
memset(cursor, 0, count);
cursor += count;
break;
case 'X':
+6 -6
View File
@@ -406,7 +406,7 @@ Tcl_DbCkalloc(
/* Don't let size argument to TclpAlloc overflow */
if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
result = (struct mem_header *) TclpAlloc((unsigned)size +
result = (struct mem_header *) TclpAlloc(size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
}
if (result == NULL) {
@@ -496,7 +496,7 @@ Tcl_AttemptDbCkalloc(
/* Don't let size argument to TclpAlloc overflow */
if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
result = (struct mem_header *) TclpAlloc((unsigned)size +
result = (struct mem_header *) TclpAlloc(size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
}
if (result == NULL) {
@@ -623,7 +623,7 @@ Tcl_DbCkfree(
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
memset(ptr, GUARD_VALUE, (size_t) memp->length);
memset(ptr, GUARD_VALUE, memp->length);
}
total_frees++;
@@ -693,7 +693,7 @@ Tcl_DbCkrealloc(
copySize = memp->length;
}
newPtr = Tcl_DbCkalloc(size, file, line);
memcpy(newPtr, ptr, (size_t) copySize);
memcpy(newPtr, ptr, copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
@@ -727,7 +727,7 @@ Tcl_AttemptDbCkrealloc(
if (newPtr == NULL) {
return NULL;
}
memcpy(newPtr, ptr, (size_t) copySize);
memcpy(newPtr, ptr, copySize);
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
@@ -1324,7 +1324,7 @@ TclFinalizeMemorySubsystem(void)
Tcl_MutexUnlock(ckallocMutexPtr);
#endif
#if USE_TCLALLOC
#if defined(USE_TCLALLOC) && USE_TCLALLOC
TclFinalizeAllocSubsystem();
#endif
}
+1 -1
View File
@@ -263,7 +263,7 @@ TclClockInit(
};
/*
* Safe interps get [::clock] as alias to a master, so do not need their
* Safe interps get [::clock] as alias to a parent, so do not need their
* own copies of the support routines.
*/
+13 -12
View File
@@ -401,7 +401,7 @@ Tcl_IncrObjCmd(
if (objc == 3) {
incrPtr = objv[2];
} else {
incrPtr = Tcl_NewIntObj(1);
TclNewIntObj(incrPtr, 1);
}
Tcl_IncrRefCount(incrPtr);
newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
@@ -719,7 +719,7 @@ InfoCommandsCmd(
if (entryPtr != NULL) {
if (specificNsInPattern) {
cmd = Tcl_GetHashValue(entryPtr);
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
} else {
cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
@@ -770,7 +770,7 @@ InfoCommandsCmd(
|| Tcl_StringMatch(cmdName, simplePattern)) {
if (specificNsInPattern) {
cmd = Tcl_GetHashValue(entryPtr);
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
} else {
elemObjPtr = Tcl_NewStringObj(cmdName, -1);
@@ -997,8 +997,9 @@ InfoDefaultCmd(
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
Tcl_Obj *nullObjPtr;
TclNewObj(nullObjPtr);
valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
nullObjPtr, TCL_LEAVE_ERR_MSG);
if (valueObjPtr == NULL) {
@@ -1054,7 +1055,7 @@ InfoErrorStackCmd(
target = interp;
if (objc == 2) {
target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
target = Tcl_GetChild(interp, Tcl_GetString(objv[1]));
if (target == NULL) {
return TCL_ERROR;
}
@@ -1908,7 +1909,7 @@ InfoProcsCmd(
} else {
simpleProcOK:
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
elemObjPtr);
} else {
@@ -1936,7 +1937,7 @@ InfoProcsCmd(
} else {
procOK:
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
elemObjPtr);
} else {
@@ -2169,7 +2170,7 @@ Tcl_JoinObjCmd(
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
Tcl_IncrRefCount(joinObjPtr);
resObjPtr = Tcl_NewObj();
TclNewObj(resObjPtr);
for (i = 0; i < listLen; i++) {
if (i > 0) {
@@ -3485,7 +3486,7 @@ Tcl_LsearchObjCmd(
} else if (returnSubindices) {
int j;
itemPtr = Tcl_NewIntObj(i);
TclNewIntObj(itemPtr, i);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
@@ -3507,7 +3508,7 @@ Tcl_LsearchObjCmd(
if (returnSubindices) {
int j;
itemPtr = Tcl_NewIntObj(index);
TclNewIntObj(itemPtr, index);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
@@ -4087,7 +4088,7 @@ Tcl_LsortObjCmd(
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
objPtr = Tcl_NewIntObj(idx + j - groupOffset);
TclNewIntObj(objPtr, idx + j - groupOffset);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
} else {
@@ -4099,7 +4100,7 @@ Tcl_LsortObjCmd(
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
objPtr = Tcl_NewIntObj(elementPtr->payload.index);
TclNewIntObj(objPtr, elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
+17 -16
View File
@@ -357,7 +357,7 @@ Tcl_RegexpObjCmd(
objc = info.nsubs + 1;
if (all <= 1) {
resultPtr = Tcl_NewObj();
TclNewObj(resultPtr);
}
}
for (i = 0; i < objc; i++) {
@@ -399,7 +399,7 @@ Tcl_RegexpObjCmd(
offset + info.matches[i].start,
offset + info.matches[i].end - 1);
} else {
newPtr = Tcl_NewObj();
TclNewObj(newPtr);
}
}
if (doinline) {
@@ -1058,7 +1058,7 @@ Tcl_SplitObjCmd(
stringPtr = TclGetStringFromObj(objv[1], &stringLen);
end = stringPtr + stringLen;
listPtr = Tcl_NewObj();
TclNewObj(listPtr);
if (stringLen == 0) {
/*
@@ -1231,7 +1231,7 @@ StringFirstCmd(
*/
if (needleLen > 0 && needleLen <= haystackLen) {
register Tcl_UniChar *p, *end;
Tcl_UniChar *p, *end;
end = haystackStr + haystackLen - needleLen + 1;
for (p = haystackStr; p < end; p++) {
@@ -1712,7 +1712,7 @@ StringIsCmd(
const char *elemStart, *nextElem;
int lenRemain, elemSize;
register const char *p;
const char *p;
string1 = TclGetStringFromObj(objPtr, &length1);
end = string1 + length1;
@@ -2035,7 +2035,7 @@ StringMapCmd(
(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
/* Restrict max compare length. */
(end-ustring1 >= length2) && ((length2 == 1) ||
!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
!strCmpFn(ustring2, ustring1, length2))) {
if (p != ustring1) {
/*
* Put the skipped chars onto the result first.
@@ -2272,7 +2272,7 @@ StringReptCmd(
* Include space for the NUL.
*/
string2 = attemptckalloc((unsigned) length2 + 1);
string2 = attemptckalloc(length2 + 1);
if (string2 == NULL) {
/*
* Alloc failed. Note that in this case we try to do an error message
@@ -2288,7 +2288,7 @@ StringReptCmd(
return TCL_ERROR;
}
for (index = 0; index < count; index++) {
memcpy(string2 + (length1 * index), string1, (size_t) length1);
memcpy(string2 + (length1 * index), string1, length1);
}
string2[length2] = '\0';
@@ -2850,7 +2850,7 @@ TclStringCmp(
* The comparison function should compare up to the minimum byte
* length only.
*/
match = memCmpFn(s1, s2, (size_t) length);
match = memCmpFn(s1, s2, length);
}
if ((match == 0) && (reqlength > length)) {
match = s1len - s2len;
@@ -3915,7 +3915,8 @@ TclNRSwitchObjCmd(
rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
} else {
rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
TclNewIntObj(rangeObjAry[1], -1);
rangeObjAry[0] = rangeObjAry[1];
}
/*
@@ -4185,9 +4186,9 @@ Tcl_TimeObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
Tcl_Obj *objs[4];
register int i, result;
int i, result;
int count;
double totalMicroSec;
#ifndef TCL_WIDE_CLICKS
@@ -4286,8 +4287,8 @@ Tcl_TimeRateObjCmd(
static double measureOverhead = 0;
/* global measure-overhead */
double overhead = -1; /* given measure-overhead */
register Tcl_Obj *objPtr;
register int result, i;
Tcl_Obj *objPtr;
int result, i;
Tcl_Obj *calibrate = NULL, *direct = NULL;
TclWideMUInt count = 0; /* Holds repetition count */
Tcl_WideInt maxms = WIDE_MIN;
@@ -4301,7 +4302,7 @@ Tcl_TimeRateObjCmd(
* zero (i.e., never < 1) */
unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid
* growth of execution time. */
register Tcl_WideInt start, middle, stop;
Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
@@ -4857,7 +4858,7 @@ TclNRTryObjCmd(
return TCL_ERROR;
}
bodyObj = objv[1];
handlersObj = Tcl_NewObj();
TclNewObj(handlersObj);
bodyShared = 0;
haveHandlers = 0;
for (i=2 ; i<objc ; i++) {
+10 -10
View File
@@ -403,9 +403,9 @@ TclCompileArraySetCmd(
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
infoPtr = ckalloc(sizeof(ForeachInfo));
infoPtr = ckalloc(TclOffset(ForeachInfo, varLists) + sizeof(ForeachVarList *));
infoPtr->numLists = 1;
infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
infoPtr->varLists[0] = ckalloc(TclOffset(ForeachVarList, varIndexes) + 2 * sizeof(int));
infoPtr->varLists[0]->numVars = 2;
infoPtr->varLists[0]->varIndexes[0] = keyVar;
infoPtr->varLists[0]->varIndexes[1] = valVar;
@@ -1776,7 +1776,7 @@ TclCompileDictUpdateCmd(
* that are to be used.
*/
duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
duiPtr = ckalloc(TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * numVars);
duiPtr->length = numVars;
keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
tokenPtr = TokenAfter(dictVarTokenPtr);
@@ -2258,7 +2258,7 @@ DupDictUpdateInfo(
unsigned len;
dui1Ptr = clientData;
len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
len = TclOffset(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
dui2Ptr = ckalloc(len);
memcpy(dui2Ptr, dui1Ptr, len);
return dui2Ptr;
@@ -2712,8 +2712,8 @@ CompileEachloopCmd(
*/
numLists = (numWords - 2)/2;
infoPtr = ckalloc(sizeof(ForeachInfo)
+ (numLists - 1) * sizeof(ForeachVarList *));
infoPtr = ckalloc(TclOffset(ForeachInfo, varLists)
+ numLists * sizeof(ForeachVarList *));
infoPtr->numLists = 0; /* Count this up as we go */
/*
@@ -2746,8 +2746,8 @@ CompileEachloopCmd(
goto done;
}
varListPtr = ckalloc(sizeof(ForeachVarList)
+ (numVars - 1) * sizeof(int));
varListPtr = ckalloc(TclOffset(ForeachVarList, varIndexes)
+ numVars * sizeof(int));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
@@ -2882,7 +2882,7 @@ DupForeachInfo(
ForeachVarList *srcListPtr, *dupListPtr;
int numVars, i, j, numLists = srcPtr->numLists;
dupPtr = ckalloc(sizeof(ForeachInfo)
dupPtr = ckalloc(TclOffset(ForeachInfo, varLists)
+ numLists * sizeof(ForeachVarList *));
dupPtr->numLists = numLists;
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
@@ -2891,7 +2891,7 @@ DupForeachInfo(
for (i = 0; i < numLists; i++) {
srcListPtr = srcPtr->varLists[i];
numVars = srcListPtr->numVars;
dupListPtr = ckalloc(sizeof(ForeachVarList)
dupListPtr = ckalloc(TclOffset(ForeachVarList, varIndexes)
+ numVars * sizeof(int));
dupListPtr->numVars = numVars;
for (j = 0; j < numVars; j++) {
+3 -3
View File
@@ -881,7 +881,7 @@ TclCompileLappendCmd(
*/
if (numWords > 2) {
Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
valueTokenPtr = TokenAfter(varTokenPtr);
CompileWord(envPtr, valueTokenPtr, interp, 2);
}
@@ -1073,7 +1073,7 @@ TclCompileLindexCmd(
int i, idx, numWords = parsePtr->numWords;
/*
* Quit if too few args.
* Quit if not enough args.
*/
/* TODO: Consider support for compiling expanded args. */
@@ -2119,7 +2119,7 @@ TclCompileRegexpCmd(
sawLast++;
i++;
break;
} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
} else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) {
nocase = 1;
} else {
/*
+1 -1
View File
@@ -756,7 +756,7 @@ TclCompileStringMatchCmd(
}
str = tokenPtr[1].start;
length = tokenPtr[1].size;
if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
if ((length <= 1) || strncmp(str, "-nocase", length)) {
/*
* Fail at run time, not in compilation.
*/
+11 -11
View File
@@ -2068,7 +2068,7 @@ ParseLexeme(
} else {
char utfBytes[TCL_UTF_MAX];
memcpy(utfBytes, start, (size_t) numBytes);
memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
scanned = TclUtfToUniChar(utfBytes, &ch);
}
@@ -2424,8 +2424,8 @@ CompileExprTree(
if (optimize) {
int length;
const char *bytes = TclGetStringFromObj(literal, &length);
int index = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
int idx = TclRegisterNewLiteral(envPtr, bytes, length);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
@@ -2445,7 +2445,7 @@ CompileExprTree(
objPtr->internalRep = literal->internalRep;
literal->typePtr = NULL;
}
TclEmitPush(index, envPtr);
TclEmitPush(idx, envPtr);
} else {
/*
* When optimize==0, we know the expression is a one-off and
@@ -2471,7 +2471,7 @@ CompileExprTree(
if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
== TCL_OK) {
int index;
int idx;
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
/*
@@ -2482,9 +2482,9 @@ CompileExprTree(
if (objPtr->bytes) {
Tcl_Obj *tableValue;
index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
idx = TclRegisterNewLiteral(envPtr, objPtr->bytes,
objPtr->length);
tableValue = TclFetchLiteral(envPtr, index);
tableValue = TclFetchLiteral(envPtr, idx);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
@@ -2496,9 +2496,9 @@ CompileExprTree(
objPtr->typePtr = NULL;
}
} else {
index = TclAddLiteralObj(envPtr, objPtr, NULL);
idx = TclAddLiteralObj(envPtr, objPtr, NULL);
}
TclEmitPush(index, envPtr);
TclEmitPush(idx, envPtr);
} else {
TclCompileSyntaxError(interp, envPtr);
}
@@ -2689,7 +2689,7 @@ TclVariadicOpCmd(
Tcl_Obj *const *litObjPtrPtr = litObjv;
if (lexeme == EXPON) {
litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
TclNewIntObj(litObjv[1], occdPtr->i.identity);
Tcl_IncrRefCount(litObjv[1]);
decrMe = 1;
litObjv[0] = objv[1];
@@ -2705,7 +2705,7 @@ TclVariadicOpCmd(
if (lexeme == DIVIDE) {
litObjv[0] = Tcl_NewDoubleObj(1.0);
} else {
litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
TclNewIntObj(litObjv[0], occdPtr->i.identity);
}
Tcl_IncrRefCount(litObjv[0]);
litObjv[1] = objv[1];
+6 -6
View File
@@ -827,7 +827,7 @@ TclSetByteCodeFromAny(
* faster code in some cases, and more compact code in more.
*/
if (Tcl_GetMaster(interp) == NULL &&
if (Tcl_GetParent(interp) == NULL &&
!Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
&& IsCompactibleCompileEnv(interp, &compEnv)) {
TclFreeCompileEnv(&compEnv);
@@ -2820,7 +2820,7 @@ TclInitByteCodeObj(
p += sizeof(ByteCode);
codePtr->codeStart = p;
memcpy(p, envPtr->codeStart, (size_t) codeBytes);
memcpy(p, envPtr->codeStart, codeBytes);
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
@@ -2853,7 +2853,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
if (exceptArrayBytes > 0) {
codePtr->exceptArrayPtr = (ExceptionRange *) p;
memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes);
} else {
codePtr->exceptArrayPtr = NULL;
}
@@ -2861,7 +2861,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
if (auxDataArrayBytes > 0) {
codePtr->auxDataArrayPtr = (AuxData *) p;
memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes);
} else {
codePtr->auxDataArrayPtr = NULL;
}
@@ -2996,7 +2996,7 @@ TclFindCompiledLocal(
char *localName = localPtr->name;
if ((nameBytes == localPtr->nameLength) &&
(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
(strncmp(name, localName, nameBytes) == 0)) {
return i;
}
}
@@ -3028,7 +3028,7 @@ TclFindCompiledLocal(
localPtr->resolveInfo = NULL;
if (name != NULL) {
memcpy(localPtr->name, name, (size_t) nameBytes);
memcpy(localPtr->name, name, nameBytes);
}
localPtr->name[nameBytes] = '\0';
procPtr->numCompiledLocals++;
+3 -3
View File
@@ -966,7 +966,7 @@ typedef struct JumpFixupArray {
typedef struct ForeachVarList {
int numVars; /* The number of variables in the list. */
int varIndexes[1]; /* An array of the indexes ("slot numbers")
int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
* for each variable in the procedure's array
* of local variables. Only scalar variables
* are supported. The actual size of this
@@ -990,7 +990,7 @@ typedef struct ForeachInfo {
* the loop's iteration count. Used to
* determine next value list element to assign
* each loop var. */
ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
* structures describing each var list. The
* actual size of this field will be large
* enough to numVars indexes. THIS MUST BE THE
@@ -1021,7 +1021,7 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType;
typedef struct {
int length; /* Size of array */
int varIndices[1]; /* Array of variable indices to manage when
int varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when
* processing the start and end of a [dict
* update]. There is really more than one
* entry, and the structure is allocated to
+9 -9
View File
@@ -2501,12 +2501,12 @@ TclDateerror(
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
Tcl_AppendToObj(infoPtr->messages, s, -1);
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
t = Tcl_NewIntObj(location->first_column);
TclNewIntObj(t, location->first_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, "-", -1);
t = Tcl_NewIntObj(location->last_column);
TclNewIntObj(t, location->last_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
@@ -2788,7 +2788,7 @@ TclClockOldscanObjCmd(
yyHaveRel = 0;
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
dateInfo.messages = Tcl_NewObj();
TclNewObj(dateInfo.messages);
dateInfo.separatrix = "";
Tcl_IncrRefCount(dateInfo.messages);
@@ -2845,8 +2845,8 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
TclNewObj(result);
TclNewObj(resultElement);
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
@@ -2864,7 +2864,7 @@ TclClockOldscanObjCmd(
Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
}
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveZone) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) -yyTimezone));
@@ -2873,7 +2873,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveRel) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyRelMonth));
@@ -2884,7 +2884,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveDay && !yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyDayOrdinal));
@@ -2893,7 +2893,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinal));
+20 -18
View File
@@ -279,13 +279,13 @@ EXTERN int Tcl_ConvertElement(const char *src, char *dst,
EXTERN int Tcl_ConvertCountedElement(const char *src,
int length, char *dst, int flags);
/* 86 */
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
EXTERN int Tcl_CreateAlias(Tcl_Interp *childInterp,
const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int argc,
CONST84 char *const *argv);
/* 87 */
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *childInterp,
const char *childCmd, Tcl_Interp *target,
const char *targetCmd, int objc,
Tcl_Obj *const objv[]);
/* 88 */
@@ -323,8 +323,8 @@ EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
/* 97 */
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp,
const char *slaveName, int isSafe);
EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
int isSafe);
/* 98 */
EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
Tcl_TimerProc *proc, ClientData clientData);
@@ -458,13 +458,13 @@ EXTERN int Tcl_Flush(Tcl_Channel chan);
EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
const char *slaveCmd,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *argcPtr,
CONST84 char ***argvPtr);
/* 149 */
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *slaveCmd,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
CONST84 char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
@@ -504,7 +504,7 @@ EXTERN int Tcl_GetErrno(void);
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
/* 163 */
EXTERN int Tcl_GetInterpPath(Tcl_Interp *interp,
Tcl_Interp *slaveInterp);
Tcl_Interp *childInterp);
/* 164 */
EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
/* 165 */
@@ -532,8 +532,7 @@ EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int Tcl_GetServiceMode(void);
/* 172 */
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
const char *slaveName);
EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *name);
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
@@ -1949,8 +1948,8 @@ typedef struct TclStubs {
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
@@ -1960,7 +1959,7 @@ typedef struct TclStubs {
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
@@ -2011,8 +2010,8 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
@@ -2026,7 +2025,7 @@ typedef struct TclStubs {
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *slaveInterp); /* 163 */
int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
@@ -2043,7 +2042,7 @@ typedef struct TclStubs {
int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
int (*tcl_GetServiceMode) (void); /* 171 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *name); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
@@ -3974,5 +3973,8 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp,objPtr) \
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#define Tcl_CreateChild Tcl_CreateSlave
#define Tcl_GetChild Tcl_GetSlave
#define Tcl_GetParent Tcl_GetMaster
#endif /* _TCLDECLS */
+2 -1
View File
@@ -2142,8 +2142,9 @@ DictIncrCmd(
if (objc == 4) {
code = TclIncrObj(interp, valuePtr, objv[3]);
} else {
Tcl_Obj *incrPtr = Tcl_NewIntObj(1);
Tcl_Obj *incrPtr;
TclNewIntObj(incrPtr, 1);
Tcl_IncrRefCount(incrPtr);
code = TclIncrObj(interp, valuePtr, incrPtr);
TclDecrRefCount(incrPtr);
+2 -2
View File
@@ -116,7 +116,7 @@ typedef struct {
* entry in this array is 1, otherwise it is
* 0. */
int numSubTables; /* Length of following array. */
EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used
* by this encoding type. The actual size is
* as large as necessary to hold all
* EscapeSubTables. */
@@ -2039,7 +2039,7 @@ LoadEscapeEncoding(
Tcl_DStringFree(&lineString);
}
size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
size = TclOffset(EscapeEncodingData, subTables)
+ Tcl_DStringLength(&escapeData);
dataPtr = (EscapeEncodingData *)ckalloc(size);
dataPtr->initLen = strlen(init);
+3 -3
View File
@@ -1043,9 +1043,9 @@ TclInitSubsystems(void)
* implementation of self-initializing locks.
*/
TclInitThreadStorage(); /* Creates master hash table for
TclInitThreadStorage(); /* Creates hash table for
* thread local storage */
#if USE_TCLALLOC
#if defined(USE_TCLALLOC) && USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
#endif
#ifdef TCL_MEM_DEBUG
@@ -1157,7 +1157,7 @@ Tcl_Finalize(void)
TclFinalizeFilesystem();
/*
* Undo all Tcl_ObjType registrations, and reset the master list of free
* Undo all Tcl_ObjType registrations, and reset the global list of free
* Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
* freed.
*
+26 -26
View File
@@ -914,8 +914,8 @@ TclCreateExecEnv(
* [sizeof(Tcl_Obj*)] */
{
ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
ExecStack *esPtr = ckalloc(sizeof(ExecStack)
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
ExecStack *esPtr = ckalloc(TclOffset(ExecStack, stackWords)
+ size * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
TclNewBooleanObj(eePtr->constants[0], 0);
@@ -1180,7 +1180,7 @@ GrowEvaluationStack(
newElems = needed;
#endif
newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
newBytes = TclOffset(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);
oldPtr = esPtr;
esPtr = ckalloc(newBytes);
@@ -1407,7 +1407,7 @@ int
Tcl_ExprObj(
Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
register Tcl_Obj *objPtr, /* Points to Tcl object containing expression
Tcl_Obj *objPtr, /* Points to Tcl object containing expression
* to evaluate. */
Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression
* result is stored if no errors occur. */
@@ -1526,7 +1526,7 @@ CompileExprObj(
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
register ByteCode *codePtr = NULL;
ByteCode *codePtr = NULL;
/* Tcl Internal type of bytecode. Initialized
* to avoid compiler warning. */
@@ -1680,8 +1680,8 @@ TclCompileObj(
const CmdFrame *invoker,
int word)
{
register Interp *iPtr = (Interp *) interp;
register ByteCode *codePtr; /* Tcl Internal type of bytecode. */
Interp *iPtr = (Interp *) interp;
ByteCode *codePtr; /* Tcl Internal type of bytecode. */
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
/*
@@ -2838,7 +2838,7 @@ TEBCresume(
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
bytes = TclGetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
memcpy(p, bytes, (size_t) length);
memcpy(p, bytes, length);
p += length;
}
}
@@ -2873,7 +2873,7 @@ TEBCresume(
for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
if ((*currPtr)->bytes != tclEmptyStringRep) {
bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
memcpy(p, bytes, (size_t) length);
memcpy(p, bytes, length);
p += length;
}
}
@@ -3854,7 +3854,7 @@ TEBCresume(
case INST_INCR_SCALAR_STK_IMM:
case INST_INCR_STK_IMM:
increment = TclGetInt1AtPtr(pc+1);
incrPtr = Tcl_NewIntObj(increment);
TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
pcAdjustment = 2;
@@ -3889,7 +3889,7 @@ TEBCresume(
case INST_INCR_ARRAY1_IMM:
opnd = TclGetUInt1AtPtr(pc+1);
increment = TclGetInt1AtPtr(pc+2);
incrPtr = Tcl_NewIntObj(increment);
TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
pcAdjustment = 3;
@@ -6806,8 +6806,8 @@ TEBCresume(
if (valuePtr->typePtr == &tclBooleanType) {
objResultPtr = TCONST(1);
} else {
int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
objResultPtr = TCONST(result);
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
objResultPtr = TCONST(res);
}
TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 0, 1);
@@ -7000,7 +7000,7 @@ TEBCresume(
}
{
ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements, *tmpPtr;
Tcl_Obj *listPtr, **elements;
ForeachVarList *varListPtr;
int numLists, iterMax, listLen, numVars;
int iterTmp, iterNum, listTmpDepth;
@@ -7286,8 +7286,8 @@ TEBCresume(
case INST_DICT_GET:
case INST_DICT_EXISTS: {
register Tcl_Interp *interp2 = interp;
register int found;
Tcl_Interp *interp2 = interp;
int found;
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
@@ -7394,7 +7394,7 @@ TEBCresume(
if (valuePtr == NULL) {
Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
} else {
value2Ptr = Tcl_NewIntObj(opnd);
TclNewIntObj(value2Ptr, opnd);
Tcl_IncrRefCount(value2Ptr);
if (Tcl_IsShared(valuePtr)) {
valuePtr = Tcl_DuplicateObj(valuePtr);
@@ -9599,7 +9599,7 @@ TclCompareTwoNumbers(
static void
PrintByteCodeInfo(
register ByteCode *codePtr) /* The bytecode whose summary is printed to
ByteCode *codePtr) /* The bytecode whose summary is printed to
* stdout. */
{
Proc *procPtr = codePtr->procPtr;
@@ -9663,7 +9663,7 @@ PrintByteCodeInfo(
#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(
register ByteCode *codePtr, /* The bytecode whose summary is printed to
ByteCode *codePtr, /* The bytecode whose summary is printed to
* stdout. */
const unsigned char *pc, /* Points to first byte of a bytecode
* instruction. The program counter. */
@@ -9906,7 +9906,7 @@ GetSrcInfoForPc(
* of the command containing the pc should
* be stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
int pcOffset = (pc - codePtr->codeStart);
int numCmds = codePtr->numCommands;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
@@ -10059,9 +10059,9 @@ GetExceptRangeForPc(
{
ExceptionRange *rangeArrayPtr;
int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
ExceptionRange *rangePtr;
int pcOffset = pc - codePtr->codeStart;
register int start;
int start;
if (numRanges == 0) {
return NULL;
@@ -10193,11 +10193,11 @@ TclExprFloatError(
int
TclLog2(
register int value) /* The integer for which to compute the log
int value) /* The integer for which to compute the log
* base 2. */
{
register int n = value;
register int result = 0;
int n = value;
int result = 0;
while (n > 1) {
n = n >> 1;
@@ -10248,7 +10248,7 @@ EvalStatsCmd(
#define Percent(a,b) ((a) * 100.0 / (b))
objPtr = Tcl_NewObj();
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
numInstructions = 0.0;
+1 -1
View File
@@ -904,7 +904,7 @@ FileBasename(
}
}
if (resultPtr == NULL) {
resultPtr = Tcl_NewObj();
TclNewObj(resultPtr);
}
Tcl_IncrRefCount(resultPtr);
Tcl_DecrRefCount(splitPtr);
+32 -24
View File
@@ -587,7 +587,8 @@ Tcl_SplitPath(
* plus the argv pointers and the terminating NULL pointer.
*/
*argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
*argvPtr = (const char **)ckalloc(
((((*argcPtr) + 1) * sizeof(char *)) + size));
/*
* Position p after the last argv pointer and copy the contents of the
@@ -598,7 +599,7 @@ Tcl_SplitPath(
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
str = Tcl_GetStringFromObj(eltPtr, &len);
memcpy(p, str, (size_t) len+1);
memcpy(p, str, len + 1);
p += len+1;
}
@@ -644,12 +645,13 @@ SplitUnixPath(
{
int length;
const char *origPath = path, *elementStart;
Tcl_Obj *result = Tcl_NewObj();
Tcl_Obj *result;
/*
* Deal with the root directory as a special case.
*/
TclNewObj(result);
if (*path == '/') {
Tcl_Obj *rootElt;
++path;
@@ -735,9 +737,10 @@ SplitWinPath(
const char *p, *elementStart;
Tcl_PathType type = TCL_PATH_ABSOLUTE;
Tcl_DString buf;
Tcl_Obj *result = Tcl_NewObj();
Tcl_Obj *result;
Tcl_DStringInit(&buf);
TclNewObj(result);
p = ExtractWinRoot(path, &buf, 0, &type);
/*
@@ -821,7 +824,7 @@ Tcl_FSJoinToPath(
return TclJoinPath(2, pair, 0);
} else {
int elemc = objc + 1;
Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));
elemv[0] = pathPtr;
memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
@@ -977,7 +980,7 @@ Tcl_JoinPath(
Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
{
int i, len;
Tcl_Obj *listObj = Tcl_NewObj();
Tcl_Obj *listObj;
Tcl_Obj *resultObj;
const char *resultStr;
@@ -985,6 +988,7 @@ Tcl_JoinPath(
* Build the list of paths.
*/
TclNewObj(listObj);
for (i = 0; i < argc; i++) {
Tcl_ListObjAppendElement(NULL, listObj,
Tcl_NewStringObj(argv[i], -1));
@@ -1072,7 +1076,7 @@ Tcl_TranslateFileName(
*/
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
register char *p;
char *p;
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
@@ -1217,7 +1221,6 @@ DoTildeSubst(
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
Tcl_GlobObjCmd(
ClientData dummy, /* Not used. */
@@ -1235,12 +1238,13 @@ Tcl_GlobObjCmd(
"-directory", "-join", "-nocomplain", "-path", "-tails",
"-types", "--", NULL
};
enum options {
enum globOptionsEnum {
GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
GLOB_TYPE, GLOB_LAST
};
enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
Tcl_GlobTypeData *globTypes = NULL;
(void)dummy;
globFlags = 0;
join = 0;
@@ -1268,7 +1272,7 @@ Tcl_GlobObjCmd(
}
}
switch (index) {
switch ((enum globOptionsEnum) index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
break;
@@ -1281,7 +1285,10 @@ Tcl_GlobObjCmd(
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-directory\" cannot be used with \"-path\"", -1));
dir == PATH_DIR
? "\"-directory\" may only be used once"
: "\"-directory\" cannot be used with \"-path\"",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
"BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
@@ -1306,7 +1313,10 @@ Tcl_GlobObjCmd(
}
if (dir != PATH_NONE) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-path\" cannot be used with \"-directory\"", -1));
dir == PATH_GENERAL
? "\"-path\" may only be used once"
: "\"-path\" cannot be used with \"-dictionary\"",
-1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
"BADOPTIONCOMBINATION", NULL);
return TCL_ERROR;
@@ -1344,7 +1354,7 @@ Tcl_GlobObjCmd(
return TCL_ERROR;
}
separators = NULL; /* lint. */
separators = NULL;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -1449,7 +1459,7 @@ Tcl_GlobObjCmd(
if (length <= 0) {
goto skipTypes;
}
globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
globTypes->type = 0;
globTypes->perm = 0;
globTypes->macType = NULL;
@@ -1680,9 +1690,8 @@ Tcl_GlobObjCmd(
*
* TclGlob --
*
* This procedure prepares arguments for the DoGlob call. It sets the
* separator string based on the platform, performs * tilde substitution,
* and calls DoGlob.
* Sets the separator string based on the platform, performs tilde
* substitution, and calls DoGlob.
*
* The interpreter's result, on entry to this function, must be a valid
* Tcl list (e.g. it could be empty), since we will lappend any new
@@ -1705,7 +1714,6 @@ Tcl_GlobObjCmd(
*----------------------------------------------------------------------
*/
/* ARGSUSED */
int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
@@ -1724,7 +1732,7 @@ TclGlob(
int result;
Tcl_Obj *filenamesObj, *savedResultObj;
separators = NULL; /* lint. */
separators = NULL;
switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
@@ -2077,7 +2085,7 @@ SkipToChar(
int match) /* Character to find. */
{
int quoted, level;
register char *p;
char *p;
quoted = 0;
level = 0;
@@ -2448,7 +2456,7 @@ DoGlob(
int len;
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
}
@@ -2485,7 +2493,7 @@ DoGlob(
int len;
const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
Tcl_AppendToObj(joinedPtr, "/", 1);
}
@@ -2523,7 +2531,7 @@ DoGlob(
Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
return ckalloc(sizeof(Tcl_StatBuf));
return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}
/*
@@ -2628,7 +2636,7 @@ Tcl_GetBlocksFromStat(
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
return (Tcl_WideUInt) statPtr->st_blocks;
#else
register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
#endif
+9 -9
View File
@@ -716,12 +716,12 @@ TclDateerror(
Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
Tcl_AppendToObj(infoPtr->messages, s, -1);
Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
t = Tcl_NewIntObj(location->first_column);
TclNewIntObj(t, location->first_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
Tcl_AppendToObj(infoPtr->messages, "-", -1);
t = Tcl_NewIntObj(location->last_column);
TclNewIntObj(t, location->last_column);
Tcl_IncrRefCount(t);
Tcl_AppendObjToObj(infoPtr->messages, t);
Tcl_DecrRefCount(t);
@@ -1003,7 +1003,7 @@ TclClockOldscanObjCmd(
yyHaveRel = 0;
yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
dateInfo.messages = Tcl_NewObj();
TclNewObj(dateInfo.messages);
dateInfo.separatrix = "";
Tcl_IncrRefCount(dateInfo.messages);
@@ -1060,8 +1060,8 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
TclNewObj(result);
TclNewObj(resultElement);
if (yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyYear));
@@ -1079,7 +1079,7 @@ TclClockOldscanObjCmd(
Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
}
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveZone) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) -yyTimezone));
@@ -1088,7 +1088,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveRel) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyRelMonth));
@@ -1099,7 +1099,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TcNewObj(resultElement);
if (yyHaveDay && !yyHaveDate) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyDayOrdinal));
@@ -1108,7 +1108,7 @@ TclClockOldscanObjCmd(
}
Tcl_ListObjAppendElement(interp, result, resultElement);
resultElement = Tcl_NewObj();
TclNewObj(resultElement);
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
Tcl_NewIntObj((int) yyMonthOrdinal));
+6 -6
View File
@@ -287,9 +287,9 @@ static int WillRead(Channel *chanPtr);
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)
#define InsertPoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextAdded])
#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)
#define RemovePoint(bufPtr) (&(bufPtr)->buf[(bufPtr)->nextRemoved])
/*
* For working with channel state flag bits.
@@ -4314,7 +4314,7 @@ Write(
* that we need to stick at the beginning of this buffer.
*/
memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
memcpy(InsertPoint(bufPtr), safe, saved);
bufPtr->nextAdded += saved;
saved = 0;
}
@@ -4711,7 +4711,7 @@ Tcl_GetsObj(
gs.rawRead -= rawRead;
gs.bytesWrote--;
gs.charsWrote--;
memmove(dst, dst + 1, (size_t) (dstEnd - dst));
memmove(dst, dst + 1, dstEnd - dst);
dstEnd--;
}
}
@@ -7699,7 +7699,7 @@ Tcl_BadChannelOption(
}
Tcl_ResetResult(interp);
errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
optionName);
optionName ? optionName : "");
argc--;
for (i = 0; i < argc; i++) {
Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
@@ -10475,7 +10475,7 @@ Tcl_IsChannelExisting(
}
if ((*chanName == *name) &&
(memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
(memcmp(name, chanName, chanNameLen + 1) == 0)) {
return 1;
}
}
+1 -1
View File
@@ -44,7 +44,7 @@ typedef struct ChannelBuffer {
int bufLength; /* How big is the buffer? */
struct ChannelBuffer *nextPtr;
/* Next buffer in chain. */
char buf[1]; /* Placeholder for real buffer. The real
char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real
* buffer occuppies this space + bufSize-1
* bytes. This must be the last field in the
* structure. */
+6 -4
View File
@@ -1318,7 +1318,7 @@ ReflectInput(
Tcl_Preserve(rcPtr);
toReadObj = Tcl_NewIntObj(toRead);
TclNewIntObj(toReadObj, toRead);
Tcl_IncrRefCount(toReadObj);
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
@@ -2999,10 +2999,12 @@ ForwardProc(
}
case ForwardedInput: {
Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
Tcl_IncrRefCount(toReadObj);
Tcl_Obj *toReadObj;
Tcl_Preserve(rcPtr);
TclNewIntObj(toReadObj, paramPtr->input.toRead);
Tcl_IncrRefCount(toReadObj);
Tcl_Preserve(rcPtr);
if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
int code = ErrnoReturn(rcPtr, resObj);
+3 -3
View File
@@ -3244,7 +3244,7 @@ Tcl_LoadFile(
}
if (fsPtr->loadFileProc != NULL) {
int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
(interp, pathPtr, handlePtr, &unloadProcPtr, flags);
if (retVal == TCL_OK) {
@@ -4209,7 +4209,7 @@ TclFSNonnativePathType(
if (pathLen < len) {
continue;
}
if (strncmp(strVol, path, (size_t) len) == 0) {
if (strncmp(strVol, path, len) == 0) {
type = TCL_PATH_ABSOLUTE;
if (filesystemPtrPtr != NULL) {
*filesystemPtrPtr = fsRecPtr->fsPtr;
@@ -4619,7 +4619,7 @@ Tcl_FSGetFileSystemForPath(
/*
* Check if the filesystem has changed in some way since this object's
* internal representation was calculated. Before doing that, assure we
* have the most up-to-date copy of the master filesystem. This is
* have the most up-to-date copy of the first filesystem. This is
* accomplished by the FsGetFirstFilesystem() call.
*/
+1 -1
View File
@@ -903,7 +903,7 @@ declare 227 {
# Used to be needed for TclOO-extension; unneeded now that TclOO is in the
# core and NRE-enabled
# declare 228 {
# int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
# int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
# int skip, ProcErrorProc *errorProc)
# }
declare 229 {
+37 -24
View File
@@ -877,6 +877,12 @@ typedef struct VarInHash {
*----------------------------------------------------------------
*/
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCLFLEXARRAY 0
#else
# define TCLFLEXARRAY 1
#endif
/*
* Forward declaration to prevent an error when the forward reference to
* Command is encountered in the Proc and ImportRef types declared below.
@@ -920,7 +926,7 @@ typedef struct CompiledLocal {
* is marked by a unique ClientData tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
char name[1]; /* Name of the local variable starts here. If
char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If
* the name is NULL, this will just be '\0'.
* The actual size of this field will be large
* enough to hold the name. MUST BE THE LAST
@@ -1254,7 +1260,7 @@ typedef struct CFWordBC {
typedef struct ContLineLoc {
int num; /* Number of entries in loc, not counting the
* final -1 marker entry. */
int loc[1]; /* Table of locations, as character offsets.
int 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
@@ -1403,7 +1409,7 @@ typedef struct ExecStack {
Tcl_Obj **markerPtr;
Tcl_Obj **endPtr;
Tcl_Obj **tosPtr;
Tcl_Obj *stackWords[1];
Tcl_Obj *stackWords[TCLFLEXARRAY];
} ExecStack;
/*
@@ -1682,6 +1688,7 @@ typedef struct Command {
#define CMD_COMPILES_EXPANDED 0x08
#define CMD_REDEF_IN_PROGRESS 0x10
#define CMD_VIA_RESOLVER 0x20
#define CMD_DEAD 0x40
/*
@@ -1804,7 +1811,7 @@ typedef struct Interp {
* of hidden commands on a per-interp
* basis. */
ClientData interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* track of parent/child interps on a
* per-interp basis. */
union {
void (*optimizer)(void *envPtr);
@@ -2082,7 +2089,7 @@ typedef struct Interp {
* (c) are accessed very often (e.g., at each command call)
*
* Note that these are the same for all interps in the same thread. They
* just have to be initialised for the thread's master interp, slaves
* just have to be initialised for the thread's parent interp, children
* inherit the value.
*
* They are used by the macros defined below.
@@ -2600,20 +2607,20 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
/*
* A ProcessGlobalValue struct exists for each internal value in Tcl that is
* to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
* the value, and the master is kept as a counted string, with epoch and mutex
* control. Each ProcessGlobalValue struct should be a static variable in some
* file.
* the value, and the gobal value is kept as a counted string, with epoch and
* mutex control. Each ProcessGlobalValue struct should be a static variable in
* some file.
*/
typedef struct ProcessGlobalValue {
int epoch; /* Epoch counter to detect changes in the
* master value. */
int numBytes; /* Length of the master string. */
char *value; /* The master string value. */
Tcl_Encoding encoding; /* system encoding when master string was
* global value. */
int numBytes; /* Length of the global string. */
char *value; /* The global string value. */
Tcl_Encoding encoding; /* system encoding when global string was
* initialized. */
TclInitProcessGlobalValueProc *proc;
/* A procedure to initialize the master string
/* A procedure to initialize the global string
* copy when a "get" request comes in before
* any "set" request has been received. */
Tcl_Mutex mutex; /* Enforce orderly access from multiple
@@ -3097,8 +3104,8 @@ MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void);
MODULE_SCOPE void TclpMasterLock(void);
MODULE_SCOPE void TclpMasterUnlock(void);
MODULE_SCOPE void TclpGlobalLock(void);
MODULE_SCOPE void TclpGlobalUnlock(void);
MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators,
Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp,
@@ -3242,8 +3249,8 @@ MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);
MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
@@ -4308,8 +4315,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->bytes = tclEmptyStringRep; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
(objPtr)->bytes = (char *) ckalloc((len) + 1); \
memcpy((objPtr)->bytes, (bytePtr), (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
@@ -4362,12 +4369,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclInvalidateStringRep(objPtr) \
if (objPtr->bytes != NULL) { \
if (objPtr->bytes != tclEmptyStringRep) { \
ckfree((char *) objPtr->bytes); \
do { \
Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \
if (_isobjPtr->bytes != NULL) { \
if (_isobjPtr->bytes != tclEmptyStringRep) { \
ckfree((char *)_isobjPtr->bytes); \
} \
_isobjPtr->bytes = NULL; \
} \
objPtr->bytes = NULL; \
}
} while (0)
#define TclHasStringRep(objPtr) \
((objPtr)->bytes != NULL)
/*
*----------------------------------------------------------------
+2
View File
@@ -1422,4 +1422,6 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TclCopyChannelOld
#undef TclSockMinimumBuffersOld
#define TclSetChildCancelFlags TclSetSlaveCancelFlags
#endif /* _TCLINTDECLS */
+558 -557
View File
File diff suppressed because it is too large Load Diff
+16 -16
View File
@@ -420,14 +420,14 @@ TclListObjCopy(
int
Tcl_ListObjGetElements(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
register Tcl_Obj *listPtr, /* List object for which an element array is
Tcl_Obj *listPtr, /* List object for which an element array is
* to be returned. */
int *objcPtr, /* Where to store the count of objects
* referenced by objv. */
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
{
register List *listRepPtr;
List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
int result;
@@ -481,7 +481,7 @@ Tcl_ListObjGetElements(
int
Tcl_ListObjAppendList(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
register Tcl_Obj *listPtr, /* List object to append elements to. */
Tcl_Obj *listPtr, /* List object to append elements to. */
Tcl_Obj *elemListPtr) /* List obj with elements to append. */
{
int objc;
@@ -543,7 +543,7 @@ Tcl_ListObjAppendElement(
Tcl_Obj *listPtr, /* List object to append objPtr to. */
Tcl_Obj *objPtr) /* Object to append to listPtr's list. */
{
register List *listRepPtr, *newPtr = NULL;
List *listRepPtr, *newPtr = NULL;
int numElems, numRequired, needGrow, isShared, attempt;
if (Tcl_IsShared(listPtr)) {
@@ -653,7 +653,7 @@ Tcl_ListObjAppendElement(
* Old intrep to be freed, re-use refCounts.
*/
memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
ckfree(listRepPtr);
}
listRepPtr = newPtr;
@@ -711,11 +711,11 @@ Tcl_ListObjAppendElement(
int
Tcl_ListObjIndex(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
register Tcl_Obj *listPtr, /* List object to index into. */
register int index, /* Index of element to return. */
Tcl_Obj *listPtr, /* List object to index into. */
int index, /* Index of element to return. */
Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
register List *listRepPtr;
List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
int result;
@@ -766,10 +766,10 @@ Tcl_ListObjIndex(
int
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
register Tcl_Obj *listPtr, /* List object whose #elements to return. */
register int *intPtr) /* The resulting int is stored here. */
Tcl_Obj *listPtr, /* List object whose #elements to return. */
int *intPtr) /* The resulting int is stored here. */
{
register List *listRepPtr;
List *listRepPtr;
if (listPtr->typePtr != &tclListType) {
int result;
@@ -839,7 +839,7 @@ Tcl_ListObjReplace(
* insert. */
{
List *listRepPtr;
register Tcl_Obj **elemPtrs;
Tcl_Obj **elemPtrs;
int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
if (Tcl_IsShared(listPtr)) {
@@ -953,7 +953,7 @@ Tcl_ListObjReplace(
if ((numAfterLast > 0) && (shift != 0)) {
Tcl_Obj **src = elemPtrs + start;
memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
}
} else {
/*
@@ -1024,7 +1024,7 @@ Tcl_ListObjReplace(
*/
if (first > 0) {
memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *));
}
/*
@@ -1227,7 +1227,7 @@ TclLindexFlat(
return NULL;
}
}
listPtr = Tcl_NewObj();
TclNewObj(listPtr);
} else {
/*
* Extract the pointer to the appropriate element.
@@ -1458,7 +1458,7 @@ TclLsetFlat(
if (--indexCount) {
parentList = subListPtr;
if (index == elemCount) {
subListPtr = Tcl_NewObj();
TclNewObj(subListPtr);
} else {
subListPtr = elemPtrs[index];
}
+2 -2
View File
@@ -213,7 +213,7 @@ TclCreateLiteral(
if ((objLength == length) && ((length == 0)
|| ((objBytes[0] == bytes[0])
&& (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
&& (memcmp(objBytes, bytes, length) == 0)))) {
/*
* A literal was found: return it
*/
@@ -418,7 +418,7 @@ TclRegisterLiteral(
objPtr = localPtr->objPtr;
if ((objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
if ((flags & LITERAL_ON_HEAP)) {
ckfree(bytes);
}
+7 -7
View File
@@ -196,9 +196,9 @@ Tcl_LoadObjCmd(
target = interp;
if (objc == 4) {
const char *slaveIntName = Tcl_GetString(objv[3]);
const char *childIntName = Tcl_GetString(objv[3]);
target = Tcl_GetSlave(interp, slaveIntName);
target = Tcl_GetChild(interp, childIntName);
if (target == NULL) {
code = TCL_ERROR;
goto done;
@@ -619,9 +619,9 @@ Tcl_UnloadObjCmd(
target = interp;
if (objc - i == 3) {
const char *slaveIntName = Tcl_GetString(objv[i + 2]);
const char *childIntName = Tcl_GetString(objv[i + 2]);
target = Tcl_GetSlave(interp, slaveIntName);
target = Tcl_GetChild(interp, childIntName);
if (target == NULL) {
return TCL_ERROR;
}
@@ -1049,7 +1049,7 @@ TclGetLoadedPackages(
* Return information about all of the available packages.
*/
resultObj = Tcl_NewObj();
TclNewObj(resultObj);
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
@@ -1068,12 +1068,12 @@ TclGetLoadedPackages(
* interpreter.
*/
target = Tcl_GetSlave(interp, targetName);
target = Tcl_GetChild(interp, targetName);
if (target == NULL) {
return TCL_ERROR;
}
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
resultObj = Tcl_NewObj();
TclNewObj(resultObj);
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+4 -3
View File
@@ -306,7 +306,7 @@ Tcl_MainEx(
is.interp = interp;
is.prompt = PROMPT_START;
is.commandPtr = Tcl_NewObj();
TclNewObj(is.commandPtr);
/*
* If the application has not already set a startup script, parse the
@@ -521,7 +521,7 @@ Tcl_MainEx(
TCL_EVAL_GLOBAL);
is.input = Tcl_GetStdChannel(TCL_STDIN);
Tcl_DecrRefCount(is.commandPtr);
is.commandPtr = Tcl_NewObj();
TclNewObj(is.commandPtr);
Tcl_IncrRefCount(is.commandPtr);
if (code != TCL_OK) {
chan = Tcl_GetStdChannel(TCL_STDERR);
@@ -805,7 +805,8 @@ StdinProc(
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
Tcl_DecrRefCount(commandPtr);
isPtr->commandPtr = commandPtr = Tcl_NewObj();
TclNewObj(commandPtr);
isPtr->commandPtr = commandPtr;
Tcl_IncrRefCount(commandPtr);
if (chan != NULL) {
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
+41 -39
View File
@@ -225,7 +225,7 @@ TclInitNamespaceSubsystem(void)
Tcl_Namespace *
Tcl_GetCurrentNamespace(
register Tcl_Interp *interp)/* Interpreter whose current namespace is
Tcl_Interp *interp)/* Interpreter whose current namespace is
* being queried. */
{
return TclGetCurrentNamespace(interp);
@@ -249,7 +249,7 @@ Tcl_GetCurrentNamespace(
Tcl_Namespace *
Tcl_GetGlobalNamespace(
register Tcl_Interp *interp)/* Interpreter whose global namespace should
Tcl_Interp *interp)/* Interpreter whose global namespace should
* be returned. */
{
return TclGetGlobalNamespace(interp);
@@ -301,8 +301,8 @@ Tcl_PushCallFrame(
* variables. */
{
Interp *iPtr = (Interp *) interp;
register CallFrame *framePtr = (CallFrame *) callFramePtr;
register Namespace *nsPtr;
CallFrame *framePtr = (CallFrame *) callFramePtr;
Namespace *nsPtr;
if (namespacePtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
@@ -378,8 +378,8 @@ void
Tcl_PopCallFrame(
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
register Interp *iPtr = (Interp *) interp;
register CallFrame *framePtr = iPtr->framePtr;
Interp *iPtr = (Interp *) interp;
CallFrame *framePtr = iPtr->framePtr;
Namespace *nsPtr;
/*
@@ -664,7 +664,7 @@ Tcl_CreateNamespace(
* function should be called. */
{
Interp *iPtr = (Interp *) interp;
register Namespace *nsPtr, *ancestorPtr;
Namespace *nsPtr, *ancestorPtr;
Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
const char *simpleName;
@@ -833,7 +833,7 @@ Tcl_CreateNamespace(
for (ancestorPtr = nsPtr; ancestorPtr != NULL;
ancestorPtr = ancestorPtr->parentPtr) {
if (ancestorPtr != globalNsPtr) {
register Tcl_DString *tempPtr = namePtr;
Tcl_DString *tempPtr = namePtr;
TclDStringAppendLiteral(buffPtr, "::");
Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
@@ -861,7 +861,7 @@ Tcl_CreateNamespace(
name = Tcl_DStringValue(namePtr);
nameLen = Tcl_DStringLength(namePtr);
nsPtr->fullName = ckalloc(nameLen + 1);
memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
memcpy(nsPtr->fullName, name, nameLen + 1);
Tcl_DStringFree(&buffer1);
Tcl_DStringFree(&buffer2);
@@ -907,7 +907,7 @@ void
Tcl_DeleteNamespace(
Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{
register Namespace *nsPtr = (Namespace *) namespacePtr;
Namespace *nsPtr = (Namespace *) namespacePtr;
Interp *iPtr = (Interp *) nsPtr->interp;
Namespace *globalNsPtr = (Namespace *)
TclGetGlobalNamespace((Tcl_Interp *) iPtr);
@@ -1103,11 +1103,11 @@ TclNamespaceDeleted(
void
TclTeardownNamespace(
register Namespace *nsPtr) /* Points to the namespace to be dismantled
Namespace *nsPtr) /* Points to the namespace to be dismantled
* and unlinked from its parent. */
{
Interp *iPtr = (Interp *) nsPtr->interp;
register Tcl_HashEntry *entryPtr;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
int i;
@@ -1296,7 +1296,7 @@ TclTeardownNamespace(
static void
NamespaceFree(
register Namespace *nsPtr) /* Points to the namespace to free. */
Namespace *nsPtr) /* Points to the namespace to free. */
{
/*
* Most of the namespace's contents are freed when the namespace is
@@ -1455,7 +1455,7 @@ Tcl_Export(
len = strlen(pattern);
patternCpy = ckalloc(len + 1);
memcpy(patternCpy, pattern, (unsigned) len + 1);
memcpy(patternCpy, pattern, len + 1);
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
nsPtr->numExportPatterns++;
@@ -1572,7 +1572,7 @@ Tcl_Import(
{
Namespace *nsPtr, *importNsPtr, *dummyPtr;
const char *simplePattern;
register Tcl_HashEntry *hPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
/*
@@ -1851,7 +1851,7 @@ Tcl_ForgetImport(
Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
const char *simplePattern;
char *cmdName;
register Tcl_HashEntry *hPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
/*
@@ -1978,7 +1978,7 @@ TclGetOriginalCommand(
Tcl_Command command) /* The imported command for which the original
* command should be returned. */
{
register Command *cmdPtr = (Command *) command;
Command *cmdPtr = (Command *) command;
ImportedCmdData *dataPtr;
if (cmdPtr->deleteProc != DeleteImportedCmd) {
@@ -2067,7 +2067,7 @@ DeleteImportedCmd(
ImportedCmdData *dataPtr = clientData;
Command *realCmdPtr = dataPtr->realCmdPtr;
Command *selfPtr = dataPtr->selfPtr;
register ImportRef *refPtr, *prevPtr;
ImportRef *refPtr, *prevPtr;
prevPtr = NULL;
for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
@@ -2487,7 +2487,7 @@ Tcl_FindNamespace(
* points to namespace in which to resolve
* name; if NULL, look up name in the current
* namespace. */
register int flags) /* Flags controlling namespace lookup: an OR'd
int flags) /* Flags controlling namespace lookup: an OR'd
* combination of TCL_GLOBAL_ONLY and
* TCL_LEAVE_ERR_MSG flags. */
{
@@ -2558,8 +2558,8 @@ Tcl_FindCommand(
{
Interp *iPtr = (Interp *) interp;
Namespace *cxtNsPtr;
register Tcl_HashEntry *entryPtr;
register Command *cmdPtr;
Tcl_HashEntry *entryPtr;
Command *cmdPtr;
const char *simpleName;
int result;
@@ -2670,7 +2670,7 @@ Tcl_FindCommand(
}
} else {
Namespace *nsPtr[2];
register int search;
int search;
TclGetNamespaceForQualName(interp, name, cxtNsPtr,
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
@@ -2744,7 +2744,7 @@ TclResetShadowedCmdRefs(
{
char *cmdName;
Tcl_HashEntry *hPtr;
register Namespace *nsPtr;
Namespace *nsPtr;
Namespace *trailNsPtr, *shadowNsPtr;
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
int found, i;
@@ -2991,7 +2991,7 @@ NamespaceChildrenCmd(
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
const char *pattern = NULL;
Tcl_DString buffer;
register Tcl_HashEntry *entryPtr;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Tcl_Obj *listPtr, *elemPtr;
@@ -3117,7 +3117,7 @@ NamespaceCodeCmd(
{
Namespace *currNsPtr;
Tcl_Obj *listPtr, *objPtr;
register const char *arg;
const char *arg;
int length;
if (objc != 2) {
@@ -3196,7 +3196,7 @@ NamespaceCurrentCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Namespace *currNsPtr;
Namespace *currNsPtr;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -3261,7 +3261,7 @@ NamespaceDeleteCmd(
{
Tcl_Namespace *namespacePtr;
const char *name;
register int i;
int i;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
@@ -3547,8 +3547,9 @@ NamespaceExportCmd(
*/
if (objc == 1) {
Tcl_Obj *listPtr = Tcl_NewObj();
Tcl_Obj *listPtr;
TclNewObj(listPtr);
(void) Tcl_AppendExportList(interp, NULL, listPtr);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
@@ -3616,7 +3617,7 @@ NamespaceForgetCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *pattern;
register int i, result;
int i, result;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
@@ -3682,7 +3683,7 @@ NamespaceImportCmd(
{
int allowOverwrite = 0;
const char *string, *pattern;
register int i, result;
int i, result;
int firstArg;
if (objc < 1) {
@@ -3835,7 +3836,7 @@ NRNamespaceInscopeCmd(
cmdObjPtr = objv[2];
} else {
Tcl_Obj *concatObjv[2];
register Tcl_Obj *listPtr;
Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
for (i = 3; i < objc; i++) {
@@ -4026,8 +4027,9 @@ NamespacePathCmd(
*/
if (objc == 1) {
Tcl_Obj *resultObj = Tcl_NewObj();
Tcl_Obj *resultObj;
TclNewObj(resultObj);
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
if (nsPtr->commandPathArray[i].nsPtr != NULL) {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
@@ -4236,7 +4238,7 @@ NamespaceQualifiersCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register const char *name, *p;
const char *name, *p;
int length;
if (objc != 2) {
@@ -4491,7 +4493,7 @@ NamespaceTailCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register const char *name, *p;
const char *name, *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
@@ -4694,7 +4696,7 @@ NamespaceWhichCmd(
static void
FreeNsNameInternalRep(
register Tcl_Obj *objPtr) /* nsName object with internal representation
Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -4740,7 +4742,7 @@ FreeNsNameInternalRep(
static void
DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
@@ -4776,11 +4778,11 @@ SetNsNameFromAny(
Tcl_Interp *interp, /* Points to the namespace in which to resolve
* name. Also used for error reporting if not
* NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
Tcl_Obj *objPtr) /* The object to convert. */
{
const char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
ResolvedNsName *resNamePtr;
const char *name;
if (interp == NULL) {
@@ -4914,7 +4916,7 @@ TclLogCommandInfo(
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
register const char *p;
const char *p;
Interp *iPtr = (Interp *) interp;
int overflow, limit = 150;
Var *varPtr, *arrayPtr;
+1 -1
View File
@@ -132,7 +132,7 @@ static const Tcl_MethodType classConstructor = {
};
/*
* Scripted parts of TclOO. First, the master script (cannot be outside this
* Scripted parts of TclOO. First, the main script (cannot be outside this
* file).
*/
+1 -1
View File
@@ -1155,7 +1155,7 @@ TclOOSelfObjCmd(
}
case SELF_CALL:
result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
result[1] = Tcl_NewIntObj(contextPtr->index);
TclNewIntObj(result[1], contextPtr->index);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
return TCL_OK;
}
+8 -8
View File
@@ -105,7 +105,7 @@ void
TclOODeleteContext(
CallContext *contextPtr)
{
register Object *oPtr = contextPtr->oPtr;
Object *oPtr = contextPtr->oPtr;
TclOODeleteChain(contextPtr->callPtr);
if (oPtr != NULL) {
@@ -215,7 +215,7 @@ DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
dstPtr->typePtr = &methodNameType;
dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
@@ -226,7 +226,7 @@ static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
TclOODeleteChain(callPtr);
objPtr->typePtr = NULL;
@@ -255,7 +255,7 @@ TclOOInvokeContext(
int objc, /* The number of arguments. */
Tcl_Obj *const objv[]) /* The arguments as actually seen. */
{
register CallContext *const contextPtr = clientData;
CallContext *const contextPtr = clientData;
Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
const int isFilter =
contextPtr->callPtr->chain[contextPtr->index].isFilter;
@@ -487,7 +487,7 @@ TclOOGetSortedMethodList(
if (i > 0) {
if (i > 1) {
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
qsort((void *) strings, i, sizeof(char *), CmpStr);
}
*stringsPtr = strings;
} else {
@@ -560,7 +560,7 @@ TclOOGetSortedClassMethodList(
if (i > 0) {
if (i > 1) {
qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
qsort((void *) strings, i, sizeof(char *), CmpStr);
}
*stringsPtr = strings;
} else {
@@ -792,7 +792,7 @@ AddMethodToCallChain(
* looking to add things from a mixin and have
* not passed a mixin. */
{
register CallChain *callPtr = cbPtr->callChainPtr;
CallChain *callPtr = cbPtr->callChainPtr;
int i;
/*
@@ -1463,7 +1463,7 @@ AddSimpleClassChainToCallContext(
(char *) methodNameObj);
if (hPtr != NULL) {
register Method *mPtr = Tcl_GetHashValue(hPtr);
Method *mPtr = Tcl_GetHashValue(hPtr);
if (!(flags & KNOWN_STATE)) {
if (flags & PUBLIC_METHOD) {
+1 -1
View File
@@ -110,7 +110,7 @@ TclOOInitInfo(
TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);
/*
* Install into the master [info] ensemble.
* Install into the [info] ensemble.
*/
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
+2 -2
View File
@@ -277,7 +277,7 @@ typedef struct Class {
*/
typedef struct ThreadLocalData {
int nsCount; /* Master epoch counter is used for keeping
int nsCount; /* Epoch counter is used for keeping
* the values used in Tcl_Obj internal
* representations sane. Must be thread-local
* because Tcl_Objs can cross interpreter
@@ -289,7 +289,7 @@ typedef struct Foundation {
Tcl_Interp *interp;
Class *objectCls; /* The root of the object system. */
Class *classCls; /* The class of all classes. */
Tcl_Namespace *ooNs; /* Master ::oo namespace. */
Tcl_Namespace *ooNs; /* ::oo namespace. */
Tcl_Namespace *defineNs; /* Namespace containing special commands for
* manipulating objects and classes. The
* "oo::define" command acts as a special kind
+132 -132
View File
@@ -145,12 +145,12 @@ typedef struct PendingObjData {
#define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--)
#define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr) \
#define PushObjToDelete(contextPtr,objPtr) \
/* The string rep is already invalidated so we can use the bytes value \
* for our pointer chain: push onto the head of the stack. */ \
(objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
(contextPtr)->deletionStack = (objPtr)
#define PopObjToDelete(contextPtr,objPtrVar) \
#define PopObjToDelete(contextPtr,objPtrVar) \
(objPtrVar) = (contextPtr)->deletionStack; \
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
@@ -161,14 +161,14 @@ typedef struct PendingObjData {
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
#elif HAVE_FAST_TSD
#elif defined(HAVE_FAST_TSD)
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = \
PendingObjData *const contextPtr = \
Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
@@ -177,27 +177,27 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*/
#define PACK_BIGNUM(bignum, objPtr) \
if ((bignum).used > 0x7FFF) { \
mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
if ((bignum).used > 0x7FFF) { \
mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int)); \
*temp = bignum; \
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
} else { \
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
} else { \
if ((bignum).alloc > 0x7FFF) { \
mp_shrink(&(bignum)); \
} \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
| ((bignum).alloc << 15) | ((bignum).used)); \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
| ((bignum).alloc << 15) | ((bignum).used)); \
}
#define UNPACK_BIGNUM(objPtr, bignum) \
if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
} else { \
(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1; \
(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
(bignum).alloc = \
(bignum).alloc = \
(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7FFF; \
(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7FFF; \
}
@@ -541,7 +541,7 @@ TclGetContLineTable(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->lineCLPtr) {
tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
@@ -576,7 +576,7 @@ TclContinuationsEnter(
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(TclOffset(ContLineLoc, loc) + (num + 1) *sizeof(int));
if (!newEntry) {
/*
@@ -876,7 +876,7 @@ Tcl_AppendAllObjTypes(
* name of each registered type is appended as
* a list element. */
{
register Tcl_HashEntry *hPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
int numElems;
@@ -924,7 +924,7 @@ const Tcl_ObjType *
Tcl_GetObjType(
const char *typeName) /* Name of Tcl object type to look up. */
{
register Tcl_HashEntry *hPtr;
Tcl_HashEntry *hPtr;
const Tcl_ObjType *typePtr = NULL;
Tcl_MutexLock(&tableMutex);
@@ -1054,10 +1054,10 @@ TclDbDumpActiveObjects(
#ifdef TCL_MEM_DEBUG
void
TclDbInitNewObj(
register Tcl_Obj *objPtr,
register const char *file, /* The name of the source file calling this
Tcl_Obj *objPtr,
const char *file, /* The name of the source file calling this
* function; used for debugging. */
register int line) /* Line number in the source file; used for
int line) /* Line number in the source file; used for
* debugging. */
{
objPtr->refCount = 0;
@@ -1079,7 +1079,7 @@ TclDbInitNewObj(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->objThreadMap == NULL) {
tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
}
tablePtr = tsdPtr->objThreadMap;
@@ -1092,7 +1092,7 @@ TclDbInitNewObj(
* Record the debugging information.
*/
objData = ckalloc(sizeof(ObjData));
objData = (ObjData *)ckalloc(sizeof(ObjData));
objData->objPtr = objPtr;
objData->file = file;
objData->line = line;
@@ -1142,7 +1142,7 @@ Tcl_NewObj(void)
Tcl_Obj *
Tcl_NewObj(void)
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
/*
* Use the macro defined in tclInt.h - it will use the correct allocator.
@@ -1184,12 +1184,12 @@ Tcl_NewObj(void)
Tcl_Obj *
Tcl_DbNewObj(
register const char *file, /* The name of the source file calling this
const char *file, /* The name of the source file calling this
* function; used for debugging. */
register int line) /* Line number in the source file; used for
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
/*
* Use the macro defined in tclInt.h - it will use the correct allocator.
@@ -1239,8 +1239,8 @@ TclAllocateFreeObjects(void)
{
size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
char *basePtr;
register Tcl_Obj *prevPtr, *objPtr;
register int i;
Tcl_Obj *prevPtr, *objPtr;
int i;
/*
* This has been noted by Purify to be a potential leak. The problem is
@@ -1251,7 +1251,7 @@ TclAllocateFreeObjects(void)
* Purify apparently can't figure that out, and fires a false alarm.
*/
basePtr = ckalloc(bytesToAlloc);
basePtr = (char *)ckalloc(bytesToAlloc);
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
@@ -1291,9 +1291,9 @@ TclAllocateFreeObjects(void)
#ifdef TCL_MEM_DEBUG
void
TclFreeObj(
register Tcl_Obj *objPtr) /* The object to be freed. */
Tcl_Obj *objPtr) /* The object to be freed. */
{
register const Tcl_ObjType *typePtr = objPtr->typePtr;
const Tcl_ObjType *typePtr = objPtr->typePtr;
/*
* This macro declares a variable, so must come here...
@@ -1416,7 +1416,7 @@ TclFreeObj(
void
TclFreeObj(
register Tcl_Obj *objPtr) /* The object to be freed. */
Tcl_Obj *objPtr) /* The object to be freed. */
{
/*
* Invalidate the string rep first so we can use the bytes value for our
@@ -1625,7 +1625,7 @@ TclSetDuplicateObj(
char *
Tcl_GetString(
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be returned. */
{
if (objPtr->bytes != NULL) {
@@ -1683,9 +1683,9 @@ Tcl_GetString(
char *
Tcl_GetStringFromObj(
register Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
Tcl_Obj *objPtr, /* Object whose string rep byte pointer should
* be returned. */
register int *lengthPtr) /* If non-NULL, the location where the string
int *lengthPtr) /* If non-NULL, the location where the string
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
@@ -1717,7 +1717,7 @@ Tcl_GetStringFromObj(
void
Tcl_InvalidateStringRep(
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be freed. */
{
TclInvalidateStringRep(objPtr);
@@ -1751,7 +1751,7 @@ Tcl_InvalidateStringRep(
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
int boolValue) /* Boolean used to initialize new object. */
{
return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
}
@@ -1760,9 +1760,9 @@ Tcl_NewBooleanObj(
Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
int boolValue) /* Boolean used to initialize new object. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclNewBooleanObj(objPtr, boolValue);
return objPtr;
@@ -1800,13 +1800,13 @@ Tcl_NewBooleanObj(
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
@@ -1820,7 +1820,7 @@ Tcl_DbNewBooleanObj(
Tcl_Obj *
Tcl_DbNewBooleanObj(
register int boolValue, /* Boolean used to initialize new object. */
int boolValue, /* Boolean used to initialize new object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
@@ -1851,8 +1851,8 @@ Tcl_DbNewBooleanObj(
#undef Tcl_SetBooleanObj
void
Tcl_SetBooleanObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int boolValue) /* Boolean used to set object's value. */
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
int boolValue) /* Boolean used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
@@ -1883,8 +1883,8 @@ Tcl_SetBooleanObj(
int
Tcl_GetBooleanFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get boolean. */
register int *boolPtr) /* Place to store resulting boolean. */
Tcl_Obj *objPtr, /* The object from which to get boolean. */
int *boolPtr) /* Place to store resulting boolean. */
{
do {
if (objPtr->typePtr == &tclIntType) {
@@ -1950,7 +1950,7 @@ Tcl_GetBooleanFromObj(
int
TclSetBooleanFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
Tcl_Obj *objPtr) /* The object to convert. */
{
/*
* For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
@@ -2003,7 +2003,7 @@ TclSetBooleanFromAny(
static int
ParseBoolean(
register Tcl_Obj *objPtr) /* The object to parse/convert. */
Tcl_Obj *objPtr) /* The object to parse/convert. */
{
int i, length, newBool;
char lowerCase[6];
@@ -2059,25 +2059,25 @@ ParseBoolean(
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
if (strncmp(lowerCase, "yes", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'n':
if (strncmp(lowerCase, "no", (size_t) length) == 0) {
if (strncmp(lowerCase, "no", length) == 0) {
newBool = 0;
goto goodBoolean;
}
return TCL_ERROR;
case 't':
if (strncmp(lowerCase, "true", (size_t) length) == 0) {
if (strncmp(lowerCase, "true", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'f':
if (strncmp(lowerCase, "false", (size_t) length) == 0) {
if (strncmp(lowerCase, "false", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2086,10 +2086,10 @@ ParseBoolean(
if (length < 2) {
return TCL_ERROR;
}
if (strncmp(lowerCase, "on", (size_t) length) == 0) {
if (strncmp(lowerCase, "on", length) == 0) {
newBool = 1;
goto goodBoolean;
} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
} else if (strncmp(lowerCase, "off", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2144,7 +2144,7 @@ ParseBoolean(
Tcl_Obj *
Tcl_NewDoubleObj(
register double dblValue) /* Double used to initialize the object. */
double dblValue) /* Double used to initialize the object. */
{
return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
}
@@ -2153,9 +2153,9 @@ Tcl_NewDoubleObj(
Tcl_Obj *
Tcl_NewDoubleObj(
register double dblValue) /* Double used to initialize the object. */
double dblValue) /* Double used to initialize the object. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclNewDoubleObj(objPtr, dblValue);
return objPtr;
@@ -2192,13 +2192,13 @@ Tcl_NewDoubleObj(
Tcl_Obj *
Tcl_DbNewDoubleObj(
register double dblValue, /* Double used to initialize the object. */
double dblValue, /* Double used to initialize the object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
@@ -2212,7 +2212,7 @@ Tcl_DbNewDoubleObj(
Tcl_Obj *
Tcl_DbNewDoubleObj(
register double dblValue, /* Double used to initialize the object. */
double dblValue, /* Double used to initialize the object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
@@ -2242,8 +2242,8 @@ Tcl_DbNewDoubleObj(
void
Tcl_SetDoubleObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register double dblValue) /* Double used to set the object's value. */
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
double dblValue) /* Double used to set the object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
@@ -2275,8 +2275,8 @@ Tcl_SetDoubleObj(
int
Tcl_GetDoubleFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get a double. */
register double *dblPtr) /* Place to store resulting double. */
Tcl_Obj *objPtr, /* The object from which to get a double. */
double *dblPtr) /* Place to store resulting double. */
{
do {
if (objPtr->typePtr == &tclDoubleType) {
@@ -2336,7 +2336,7 @@ Tcl_GetDoubleFromObj(
static int
SetDoubleFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
Tcl_Obj *objPtr) /* The object to convert. */
{
return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
NULL, 0);
@@ -2365,16 +2365,16 @@ SetDoubleFromAny(
static void
UpdateStringOfDouble(
register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
Tcl_Obj *objPtr) /* Double obj with string rep to update. */
{
char buffer[TCL_DOUBLE_SPACE];
register int len;
int len;
Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
len = strlen(buffer);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->bytes = (char *)ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
@@ -2413,7 +2413,7 @@ UpdateStringOfDouble(
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
int intValue) /* Int used to initialize the new object. */
{
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}
@@ -2422,9 +2422,9 @@ Tcl_NewIntObj(
Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
int intValue) /* Int used to initialize the new object. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclNewIntObj(objPtr, intValue);
return objPtr;
@@ -2452,8 +2452,8 @@ Tcl_NewIntObj(
#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register int intValue) /* Integer used to set object's value. */
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
int intValue) /* Integer used to set object's value. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
@@ -2494,8 +2494,8 @@ Tcl_SetIntObj(
int
Tcl_GetIntFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get a int. */
register int *intPtr) /* Place to store resulting int. */
Tcl_Obj *objPtr, /* The object from which to get a int. */
int *intPtr) /* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
@@ -2566,15 +2566,15 @@ SetIntFromAny(
static void
UpdateStringOfInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE];
register int len;
int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->bytes = (char *)ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
@@ -2613,7 +2613,7 @@ UpdateStringOfInt(
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
long longValue) /* Long integer used to initialize the
* new object. */
{
return Tcl_DbNewLongObj(longValue, "unknown", 0);
@@ -2623,10 +2623,10 @@ Tcl_NewLongObj(
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
long longValue) /* Long integer used to initialize the
* new object. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclNewLongObj(objPtr, longValue);
return objPtr;
@@ -2669,14 +2669,14 @@ Tcl_NewLongObj(
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
@@ -2690,7 +2690,7 @@ Tcl_DbNewLongObj(
Tcl_Obj *
Tcl_DbNewLongObj(
register long longValue, /* Long integer used to initialize the new
long longValue, /* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
@@ -2721,8 +2721,8 @@ Tcl_DbNewLongObj(
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
register long longValue) /* Long integer used to initialize the
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
long longValue) /* Long integer used to initialize the
* object's value. */
{
if (Tcl_IsShared(objPtr)) {
@@ -2756,8 +2756,8 @@ Tcl_SetLongObj(
int
Tcl_GetLongFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* The object from which to get a long. */
register long *longPtr) /* Place to store resulting long. */
Tcl_Obj *objPtr, /* The object from which to get a long. */
long *longPtr) /* Place to store resulting long. */
{
do {
if (objPtr->typePtr == &tclIntType) {
@@ -2862,11 +2862,11 @@ Tcl_GetLongFromObj(
static void
UpdateStringOfWideInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
char buffer[TCL_INTEGER_SPACE+2];
register unsigned len;
register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
unsigned len;
Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
/*
* Note that sprintf will generate a compiler warning under Mingw claiming
@@ -2877,7 +2877,7 @@ UpdateStringOfWideInt(
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
len = strlen(buffer);
objPtr->bytes = ckalloc(len + 1);
objPtr->bytes = (char *)ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
@@ -2913,7 +2913,7 @@ UpdateStringOfWideInt(
Tcl_Obj *
Tcl_NewWideIntObj(
register Tcl_WideInt wideValue)
Tcl_WideInt wideValue)
/* Wide integer used to initialize the new
* object. */
{
@@ -2924,11 +2924,11 @@ Tcl_NewWideIntObj(
Tcl_Obj *
Tcl_NewWideIntObj(
register Tcl_WideInt wideValue)
Tcl_WideInt wideValue)
/* Wide integer used to initialize the new
* object. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetWideIntObj(objPtr, wideValue);
@@ -2972,7 +2972,7 @@ Tcl_NewWideIntObj(
Tcl_Obj *
Tcl_DbNewWideIntObj(
register Tcl_WideInt wideValue,
Tcl_WideInt wideValue,
/* Wide integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
@@ -2980,7 +2980,7 @@ Tcl_DbNewWideIntObj(
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetWideIntObj(objPtr, wideValue);
@@ -2991,7 +2991,7 @@ Tcl_DbNewWideIntObj(
Tcl_Obj *
Tcl_DbNewWideIntObj(
register Tcl_WideInt wideValue,
Tcl_WideInt wideValue,
/* Long integer used to initialize the new
* object. */
const char *file, /* The name of the source file calling this
@@ -3023,8 +3023,8 @@ Tcl_DbNewWideIntObj(
void
Tcl_SetWideIntObj(
register Tcl_Obj *objPtr, /* Object w. internal rep to init. */
register Tcl_WideInt wideValue)
Tcl_Obj *objPtr, /* Object w. internal rep to init. */
Tcl_WideInt wideValue)
/* Wide integer used to initialize the
* object's value. */
{
@@ -3071,8 +3071,8 @@ Tcl_SetWideIntObj(
int
Tcl_GetWideIntFromObj(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr, /* Object from which to get a wide int. */
register Tcl_WideInt *wideIntPtr)
Tcl_Obj *objPtr, /* Object from which to get a wide int. */
Tcl_WideInt *wideIntPtr)
/* Place to store resulting long. */
{
do {
@@ -3269,7 +3269,7 @@ UpdateStringOfBignum(
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
stringVal = ckalloc(size);
stringVal = (char *)ckalloc(size);
status = mp_to_radix(&bignumVal, stringVal, size, NULL, 10);
if (status != MP_OKAY) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
@@ -3712,7 +3712,7 @@ TclGetNumberFromObj(
void
Tcl_DbIncrRefCount(
register Tcl_Obj *objPtr, /* The object we are registering a reference
Tcl_Obj *objPtr, /* The object we are registering a reference
* to. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
@@ -3775,7 +3775,7 @@ Tcl_DbIncrRefCount(
void
Tcl_DbDecrRefCount(
register Tcl_Obj *objPtr, /* The object we are releasing a reference
Tcl_Obj *objPtr, /* The object we are releasing a reference
* to. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
@@ -3841,7 +3841,7 @@ Tcl_DbDecrRefCount(
int
Tcl_DbIsShared(
register Tcl_Obj *objPtr, /* The object to test for being shared. */
Tcl_Obj *objPtr, /* The object to test for being shared. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
@@ -3913,7 +3913,7 @@ Tcl_DbIsShared(
void
Tcl_InitObjHashTable(
register Tcl_HashTable *tablePtr)
Tcl_HashTable *tablePtr)
/* Pointer to table record, which is supplied
* by the caller. */
{
@@ -3942,8 +3942,8 @@ AllocObjEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key to store in the hash table entry. */
{
Tcl_Obj *objPtr = keyPtr;
Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
hPtr->key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
@@ -3976,8 +3976,8 @@ TclCompareObjKeys(
{
Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
register const char *p1, *p2;
register size_t l1, l2;
const char *p1, *p2;
size_t l1, l2;
/*
* If the object pointers are the same then they match.
@@ -4134,13 +4134,13 @@ Tcl_Command
Tcl_GetCommandFromObj(
Tcl_Interp *interp, /* The interpreter in which to resolve the
* command and to report errors. */
register Tcl_Obj *objPtr) /* The object containing the command's name.
Tcl_Obj *objPtr) /* The object containing the command's name.
* If the name starts with "::", will be
* looked up in global namespace. Else, looked
* up first in the current namespace, then in
* global namespace. */
{
register ResolvedCmdName *resPtr;
ResolvedCmdName *resPtr;
/*
* Get the internal representation, converting to a command type if
@@ -4163,13 +4163,13 @@ Tcl_GetCommandFromObj(
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
register Command *cmdPtr = resPtr->cmdPtr;
Command *cmdPtr = resPtr->cmdPtr;
if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
&& !(cmdPtr->flags & CMD_IS_DELETED)
&& (interp == cmdPtr->nsPtr->interp)
&& !(cmdPtr->nsPtr->flags & NS_DYING)) {
register Namespace *refNsPtr = (Namespace *)
Namespace *refNsPtr = (Namespace *)
TclGetCurrentNamespace(interp);
if ((resPtr->refNsPtr == NULL)
@@ -4218,14 +4218,14 @@ void
TclSetCmdNameObj(
Tcl_Interp *interp, /* Points to interpreter containing command
* that should be cached in objPtr. */
register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
* CmdName object. */
Command *cmdPtr) /* Points to Command structure that the
* CmdName object should refer to. */
{
Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
register Namespace *currNsPtr;
ResolvedCmdName *resPtr;
Namespace *currNsPtr;
const char *name;
if (objPtr->typePtr == &tclCmdNameType) {
@@ -4236,7 +4236,7 @@ TclSetCmdNameObj(
}
cmdPtr->refCount++;
resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
resPtr->cmdPtr = cmdPtr;
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
resPtr->refCount = 1;
@@ -4290,10 +4290,10 @@ TclSetCmdNameObj(
static void
FreeCmdNameInternalRep(
register Tcl_Obj *objPtr) /* CmdName object with internal
Tcl_Obj *objPtr) /* CmdName object with internal
* representation to free. */
{
register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
if (resPtr != NULL) {
/*
@@ -4340,9 +4340,9 @@ FreeCmdNameInternalRep(
static void
DupCmdNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -4376,13 +4376,13 @@ DupCmdNameInternalRep(
static int
SetCmdNameFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
register Command *cmdPtr;
Command *cmdPtr;
Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
ResolvedCmdName *resPtr;
if (interp == NULL) {
return TCL_ERROR;
@@ -4422,7 +4422,7 @@ SetCmdNameFromAny(
}
} else {
TclFreeIntRep(objPtr);
resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
resPtr->refCount = 1;
objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+1 -1
View File
@@ -2172,7 +2172,7 @@ TclSubstTokens(
* command, which is refered to by 'script'.
* The 'clNextOuter' refers to the current
* entry in the table of continuation lines in
* this "master script", and the character
* this "main script", and the character
* offsets are relative to the 'outerScript'
* as well.
*
+2 -2
View File
@@ -1745,7 +1745,7 @@ Tcl_FSGetTranslatedStringPath(
const char *orig = Tcl_GetStringFromObj(transPtr, &len);
char *result = ckalloc(len+1);
memcpy(result, orig, (size_t) len+1);
memcpy(result, orig, len+1);
TclDecrRefCount(transPtr);
return result;
}
@@ -2617,7 +2617,7 @@ DupFsPathInternalRep(
static void
UpdateStringOfFsPath(
register Tcl_Obj *pathPtr) /* path obj with string rep to update. */
Tcl_Obj *pathPtr) /* path obj with string rep to update. */
{
FsPath *fsPathPtr = PATHOBJ(pathPtr);
int cwdLen;
+5 -3
View File
@@ -718,8 +718,9 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
}
}
} else if (result != TCL_ERROR) {
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
Tcl_Obj *codePtr;
TclNewIntObj(codePtr, result);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to provide package %s %s failed:"
" bad return code: %s",
@@ -1137,9 +1138,10 @@ TclNRPackageObjCmd(
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL);
return TCL_OK;
} else {
int i, newobjc = objc-3;
Tcl_Obj *const *newobjv = objv + 3;
if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
newobjc = objc - 3;
if (CheckAllRequirements(interp, objc - 3, objv + 3) != TCL_OK) {
return TCL_ERROR;
}
objvListPtr = Tcl_NewListObj(0, NULL);
+8
View File
@@ -35,6 +35,14 @@
#include "tclInt.h"
#ifndef TCL_CFGVAL_ENCODING
# ifdef _WIN32
# define TCL_CFGVAL_ENCODING "cp1252"
# else
# define TCL_CFGVAL_ENCODING "iso8859-1"
# endif
#endif
/*
* Use C preprocessor statements to define the various values for the embedded
* configuration information.
+26 -5
View File
@@ -600,7 +600,7 @@ TclCreateProc(
*/
localPtr = (CompiledLocal *)ckalloc(
TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
TclOffset(CompiledLocal, name) + fieldValues[0]->length + 1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
@@ -903,9 +903,28 @@ TclNRUplevelObjCmd(
Tcl_Obj *objPtr;
if (objc < 2) {
/* to do
* simplify things by interpreting the argument as a command when there
* is only one argument. This requires a TIP since currently a single
* argument is interpreted as a level indicator if possible.
*/
uplevelSyntax:
Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
return TCL_ERROR;
} else if (!TclHasStringRep(objv[1]) && objc == 2) {
int status ,llength;
status = Tcl_ListObjLength(interp, objv[1], &llength);
if (status == TCL_OK && llength > 1) {
/* the first argument can't interpreted as a level. Avoid
* generating a string representation of the script. */
result = TclGetFrame(interp, "1", &framePtr);
if (result == -1) {
return TCL_ERROR;
}
objc -= 1;
objv += 1;
goto havelevel;
}
}
/*
@@ -922,6 +941,8 @@ TclNRUplevelObjCmd(
}
objv += result + 1;
havelevel:
/*
* Modify the interpreter state to execute in the given frame.
*/
@@ -1305,8 +1326,8 @@ InitLocalCache(
* for future calls.
*/
localCachePtr = ckalloc(sizeof(LocalCache)
+ (localCt - 1) * sizeof(Tcl_Obj *)
localCachePtr = (LocalCache *)ckalloc(TclOffset(LocalCache, varName0)
+ localCt * sizeof(Tcl_Obj *)
+ numArgs * sizeof(Var));
namePtr = &localCachePtr->varName0;
@@ -2499,12 +2520,12 @@ SetLambdaFromAny(
* location (line of 2nd list element).
*/
cfPtr = ckalloc(sizeof(CmdFrame));
cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = ckalloc(sizeof(int));
cfPtr->line = (int *)ckalloc(sizeof(int));
cfPtr->line[0] = buf[1];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
+9 -9
View File
@@ -64,7 +64,7 @@
#define NUM_REGEXPS 30
typedef struct ThreadSpecificData {
typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
* expression patterns. NULL means that this
@@ -245,7 +245,7 @@ Tcl_RegExpRange(
if ((size_t) index > regexpPtr->re.re_nsub) {
*startPtr = *endPtr = NULL;
} else if (regexpPtr->matches[index].rm_so < 0) {
} else if (regexpPtr->matches[index].rm_so == -1) {
*startPtr = *endPtr = NULL;
} else {
if (regexpPtr->objPtr) {
@@ -355,7 +355,7 @@ TclRegExpRangeUniChar(
{
TclRegexp *regexpPtr = (TclRegexp *) re;
if ((regexpPtr->flags&REG_EXPECT) && index == -1) {
if ((regexpPtr->flags&REG_EXPECT) && (index == -1)) {
*startPtr = regexpPtr->details.rm_extend.rm_so;
*endPtr = regexpPtr->details.rm_extend.rm_eo;
} else if ((size_t) index > regexpPtr->re.re_nsub) {
@@ -510,9 +510,9 @@ Tcl_RegExpMatchObj(
*/
if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
TCL_REG_ADVANCED | TCL_REG_NOSUB))
TCL_REG_ADVANCED | TCL_REG_NOSUB))
&& !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
return -1;
return -1;
}
return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
0 /* nmatches */, 0 /* flags */);
@@ -912,7 +912,7 @@ CompileRegexp(
* This is a new expression, so compile it and add it to the cache.
*/
regexpPtr = ckalloc(sizeof(TclRegexp));
regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp));
regexpPtr->objPtr = NULL;
regexpPtr->string = NULL;
regexpPtr->details.rm_extend.rm_so = -1;
@@ -967,7 +967,7 @@ CompileRegexp(
*/
regexpPtr->matches =
ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
(regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
/*
* Initialize the refcount to one initially, since it is in the cache.
@@ -993,8 +993,8 @@ CompileRegexp(
tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
}
tsdPtr->patterns[0] = ckalloc(length + 1);
memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
tsdPtr->patterns[0] = (char *)ckalloc(length + 1);
memcpy(tsdPtr->patterns[0], string, length + 1);
tsdPtr->patLengths[0] = length;
tsdPtr->regexps[0] = regexpPtr;
+14 -14
View File
@@ -411,14 +411,14 @@ void
Tcl_SetResult(
Tcl_Interp *interp, /* Interpreter with which to associate the
* return value. */
register char *result, /* Value to be returned. If NULL, the result
char *result, /* Value to be returned. If NULL, the result
* is set to an empty string. */
Tcl_FreeProc *freeProc) /* Gives information about the string:
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
Interp *iPtr = (Interp *) interp;
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
char *oldResult = iPtr->result;
if (result == NULL) {
@@ -435,7 +435,7 @@ Tcl_SetResult(
iPtr->result = iPtr->resultSpace;
iPtr->freeProc = 0;
}
memcpy(iPtr->result, result, (unsigned) length+1);
memcpy(iPtr->result, result, length+1);
} else {
iPtr->result = (char *) result;
iPtr->freeProc = freeProc;
@@ -481,7 +481,7 @@ Tcl_SetResult(
const char *
Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
Tcl_Interp *interp)/* Interpreter whose result to return. */
{
/*
* If the string result is empty, move the object result to the string
@@ -520,11 +520,11 @@ void
Tcl_SetObjResult(
Tcl_Interp *interp, /* Interpreter with which to associate the
* return object value. */
register Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj
* result is made an empty string object. */
{
register Interp *iPtr = (Interp *) interp;
register Tcl_Obj *oldObjResult = iPtr->objResultPtr;
Interp *iPtr = (Interp *) interp;
Tcl_Obj *oldObjResult = iPtr->objResultPtr;
iPtr->objResultPtr = objPtr;
Tcl_IncrRefCount(objPtr); /* since interp result is a reference */
@@ -577,7 +577,7 @@ Tcl_Obj *
Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
Tcl_Obj *objResultPtr;
int length;
@@ -880,9 +880,9 @@ SetupAppendBuffer(
void
Tcl_FreeResult(
register Tcl_Interp *interp)/* Interpreter for which to free result. */
Tcl_Interp *interp)/* Interpreter for which to free result. */
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
@@ -917,9 +917,9 @@ Tcl_FreeResult(
void
Tcl_ResetResult(
register Tcl_Interp *interp)/* Interpreter for which to clear result. */
Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
register Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
if (iPtr->freeProc != NULL) {
@@ -980,10 +980,10 @@ Tcl_ResetResult(
static void
ResetObjResult(
register Interp *iPtr) /* Points to the interpreter whose result
Interp *iPtr) /* Points to the interpreter whose result
* object should be reset. */
{
register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
Tcl_Obj *objResultPtr = iPtr->objResultPtr;
if (Tcl_IsShared(objResultPtr)) {
TclDecrRefCount(objResultPtr);
+6 -6
View File
@@ -721,7 +721,7 @@ Tcl_ScanObjCmd(
switch (ch) {
case 'n':
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj(string - baseString);
TclNewIntObj(objPtr, string - baseString);
Tcl_IncrRefCount(objPtr);
CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
@@ -884,7 +884,7 @@ Tcl_ScanObjCmd(
offset = TclUtfToUCS4(string, &i);
string += offset;
if (!(flags & SCAN_SUPPRESS)) {
objPtr = Tcl_NewIntObj(i);
TclNewIntObj(objPtr, i);
Tcl_IncrRefCount(objPtr);
CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
@@ -1035,7 +1035,7 @@ Tcl_ScanObjCmd(
* Here no vars were specified, we want a list returned (inline scan)
*/
objPtr = Tcl_NewObj();
TclNewObj(objPtr);
for (i = 0; i < totalVars; i++) {
if (objs[i] != NULL) {
Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
@@ -1056,16 +1056,16 @@ Tcl_ScanObjCmd(
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
objPtr = Tcl_NewIntObj(-1);
TclNewIntObj(objPtr, -1);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
} else {
objPtr = Tcl_NewObj();
TclNewObj(objPtr);
}
}
} else if (numVars) {
objPtr = Tcl_NewIntObj(result);
TclNewIntObj(objPtr, result);
}
Tcl_SetObjResult(interp, objPtr);
}
+11 -8
View File
@@ -2209,7 +2209,7 @@ Tcl_AppendFormatToObj(
isNegative = (l < (long) 0);
}
segment = Tcl_NewObj();
TclNewObj(segment);
allocSegment = 1;
segmentLimit = INT_MAX;
Tcl_IncrRefCount(segment);
@@ -2249,7 +2249,7 @@ Tcl_AppendFormatToObj(
const char *bytes;
if (useShort) {
pure = Tcl_NewIntObj((int) s);
TclNewIntObj(pure, (int) s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
@@ -2378,7 +2378,7 @@ Tcl_AppendFormatToObj(
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
numDigits = 1;
}
pure = Tcl_NewObj();
TclNewObj(pure);
Tcl_SetObjLength(pure, (int) numDigits);
bytes = TclGetString(pure);
toAppend = length = (int) numDigits;
@@ -2497,7 +2497,7 @@ Tcl_AppendFormatToObj(
*p++ = (char) ch;
*p = '\0';
segment = Tcl_NewObj();
TclNewObj(segment);
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
msg = overflow;
@@ -2605,8 +2605,9 @@ Tcl_Format(
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_Obj *objPtr;
TclNewObj(objPtr);
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
@@ -2634,9 +2635,10 @@ AppendPrintfToObjVA(
va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
Tcl_Obj **objv, *list;
const char *p;
TclNewObj(list);
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
@@ -2808,8 +2810,9 @@ Tcl_ObjPrintf(
...)
{
va_list argList;
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_Obj *objPtr;
TclNewObj(objPtr);
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
@@ -2948,7 +2951,7 @@ TclStringReverse(
char *to, *from = objPtr->bytes;
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
TclNewObj(objPtr);
Tcl_SetObjLength(objPtr, numBytes);
}
to = objPtr->bytes;
+3 -3
View File
@@ -59,15 +59,15 @@ typedef struct String {
* space allocated for the unicode array. */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size
Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size
* of this field depends on the 'maxChars'
* field above. */
} String;
#define STRING_MAXCHARS \
(int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
(int)(((size_t)UINT_MAX - 1 - TclOffset(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
(TclOffset(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
+1 -1
View File
@@ -465,7 +465,7 @@ mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
if (maxlen < 0) {
return MP_VAL;
}
return mp_to_radix(a, str, (size_t)maxlen, NULL, radix);
return mp_to_radix(a, str, maxlen, NULL, radix);
}
void bn_reverse(unsigned char *s, int len)
+71 -26
View File
@@ -307,7 +307,7 @@ static Tcl_FSNormalizePathProc TestReportNormalizePath;
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
static Tcl_CmdProc TestServiceModeCmd;
static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
@@ -561,6 +561,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -1506,15 +1508,15 @@ TestdelCmd(
const char **argv) /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
Tcl_Interp *child;
if (argc != 4) {
Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
return TCL_ERROR;
}
slave = Tcl_GetSlave(interp, argv[1]);
if (slave == NULL) {
child = Tcl_GetChild(interp, argv[1]);
if (child == NULL) {
return TCL_ERROR;
}
@@ -1523,7 +1525,7 @@ TestdelCmd(
dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
strcpy(dPtr->deleteCmd, argv[3]);
Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
Tcl_CreateCommand(child, argv[2], DelCmdProc, (ClientData) dPtr,
DelDeleteProc);
return TCL_OK;
}
@@ -1863,11 +1865,11 @@ TestencodingObjCmd(
string = Tcl_GetStringFromObj(objv[3], &length);
encodingPtr->toUtfCmd = (char *)ckalloc(length + 1);
memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
memcpy(encodingPtr->toUtfCmd, string, length + 1);
string = Tcl_GetStringFromObj(objv[4], &length);
encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1);
memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
memcpy(encodingPtr->fromUtfCmd, string, length + 1);
string = Tcl_GetStringFromObj(objv[2], &length);
@@ -1916,7 +1918,7 @@ EncodingToUtfProc(
if (len > dstLen) {
len = dstLen;
}
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
Tcl_ResetResult(encodingPtr->interp);
*srcReadPtr = srcLen;
@@ -1948,7 +1950,7 @@ EncodingFromUtfProc(
if (len > dstLen) {
len = dstLen;
}
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
Tcl_ResetResult(encodingPtr->interp);
*srcReadPtr = srcLen;
@@ -2689,18 +2691,18 @@ TestinterpdeleteCmd(
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
Tcl_Interp *slaveToDelete;
Tcl_Interp *childToDelete;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" path\"", NULL);
return TCL_ERROR;
}
slaveToDelete = Tcl_GetSlave(interp, argv[1]);
if (slaveToDelete == NULL) {
childToDelete = Tcl_GetChild(interp, argv[1]);
if (childToDelete == NULL) {
return TCL_ERROR;
}
Tcl_DeleteInterp(slaveToDelete);
Tcl_DeleteInterp(childToDelete);
return TCL_OK;
}
@@ -5877,7 +5879,7 @@ TestChannelEventCmd(
cmd = argv[2];
len = strlen(cmd);
if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName add eventSpec script\"", NULL);
@@ -5912,7 +5914,7 @@ TestChannelEventCmd(
return TCL_OK;
}
if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) {
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName delete index\"", NULL);
@@ -5958,7 +5960,7 @@ TestChannelEventCmd(
return TCL_OK;
}
if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName list\"", NULL);
@@ -5981,7 +5983,7 @@ TestChannelEventCmd(
return TCL_OK;
}
if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName removeall\"", NULL);
@@ -6000,7 +6002,7 @@ TestChannelEventCmd(
return TCL_OK;
}
if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
if ((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName delete index event\"", NULL);
@@ -6046,6 +6048,54 @@ TestChannelEventCmd(
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TestServiceModeCmd --
*
* This procedure implements the "testservicemode" command which gets or
* sets the current Tcl ServiceMode. There are several tests which open
* a file and assign various handlers to it. For these tests to be
* deterministic it is important that file events not be processed until
* all of the handlers are in place.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May change the ServiceMode setting.
*
*----------------------------------------------------------------------
*/
static int
TestServiceModeCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
int newmode, oldmode;
if (argc > 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ?newmode?\"", NULL);
return TCL_ERROR;
}
oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE);
if (argc == 2) {
if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) {
return TCL_ERROR;
}
if (newmode == 0) {
Tcl_SetServiceMode(TCL_SERVICE_NONE);
} else {
Tcl_SetServiceMode(TCL_SERVICE_ALL);
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
@@ -7348,8 +7398,6 @@ TestconcatobjCmd(
"\n\t* (e) concatObj does not have refCount 0", NULL);
}
if (concatPtr == tmpPtr) {
int len;
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ",
NULL);
@@ -7380,8 +7428,6 @@ TestconcatobjCmd(
"\n\t* (f) concatObj does not have refCount 0", NULL);
}
if (concatPtr == tmpPtr) {
int len;
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
NULL);
@@ -7413,8 +7459,6 @@ TestconcatobjCmd(
"\n\t* (g) concatObj does not have refCount 0", NULL);
}
if (concatPtr == tmpPtr) {
int len;
result = TCL_ERROR;
Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
NULL);
@@ -7509,7 +7553,7 @@ static int
InterpCmdResolver(
Tcl_Interp *interp,
const char *name,
Tcl_Namespace *context,
Tcl_Namespace *dummy,
int flags,
Tcl_Command *rPtr)
{
@@ -7519,6 +7563,7 @@ InterpCmdResolver(
varFramePtr->procPtr : NULL;
Namespace *callerNsPtr = varFramePtr->nsPtr;
Tcl_Command resolvedCmdPtr = NULL;
(void)dummy;
/*
* Just do something special on a cmd literal "z" in two cases:
@@ -7731,7 +7776,7 @@ TestInterpResolverCmd(
return TCL_ERROR;
}
if (objc == 3) {
interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
interp = Tcl_GetChild(interp, Tcl_GetString(objv[2]));
if (interp == NULL) {
Tcl_AppendResult(interp, "provided interpreter not found", NULL);
return TCL_ERROR;
+2 -2
View File
@@ -53,7 +53,7 @@ static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
{
register int i;
int i;
Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
@@ -91,7 +91,7 @@ int
TclObjTest_Init(
Tcl_Interp *interp)
{
register int i;
int i;
/*
* An array of Tcl_Obj pointers used in the commands that operate on or get
* the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
+13 -13
View File
@@ -88,13 +88,13 @@ Tcl_GetThreadData(
if (result == NULL) {
result = ckalloc(size);
memset(result, 0, (size_t) size);
memset(result, 0, size);
TclThreadStorageKeySet(keyPtr, result);
}
#else /* TCL_THREADS */
if (*keyPtr == NULL) {
result = ckalloc(size);
memset(result, 0, (size_t)size);
memset(result, 0, size);
*keyPtr = result;
RememberSyncObject(keyPtr, &keyRecord);
} else {
@@ -141,7 +141,7 @@ TclThreadDataKeyGet(
* Keep a list of (mutexes/condition variable/data key) used during
* finalization.
*
* Assume master lock is held.
* Assume global lock is held.
*
* Results:
* None.
@@ -202,7 +202,7 @@ RememberSyncObject(
* ForgetSyncObject
*
* Remove a single object from the list.
* Assume master lock is held.
* Assume global lock is held.
*
* Results:
* None.
@@ -234,7 +234,7 @@ ForgetSyncObject(
* TclRememberMutex
*
* Keep a list of mutexes used during finalization.
* Assume master lock is held.
* Assume global lock is held.
*
* Results:
* None.
@@ -276,9 +276,9 @@ Tcl_MutexFinalize(
#ifdef TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
TclpMasterLock();
TclpGlobalLock();
ForgetSyncObject(mutexPtr, &mutexRecord);
TclpMasterUnlock();
TclpGlobalUnlock();
}
/*
@@ -287,7 +287,7 @@ Tcl_MutexFinalize(
* TclRememberCondition
*
* Keep a list of condition variables used during finalization.
* Assume master lock is held.
* Assume global lock is held.
*
* Results:
* None.
@@ -329,9 +329,9 @@ Tcl_ConditionFinalize(
#ifdef TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
TclpMasterLock();
TclpGlobalLock();
ForgetSyncObject(condPtr, &condRecord);
TclpMasterUnlock();
TclpGlobalUnlock();
}
/*
@@ -393,7 +393,7 @@ TclFinalizeSynchronization(void)
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
TclpMasterLock();
TclpGlobalLock();
#endif
/*
@@ -415,7 +415,7 @@ TclFinalizeSynchronization(void)
#ifdef TCL_THREADS
/*
* Call thread storage master cleanup.
* Call thread storage global cleanup.
*/
TclFinalizeThreadStorage();
@@ -446,7 +446,7 @@ TclFinalizeSynchronization(void)
condRecord.max = 0;
condRecord.num = 0;
TclpMasterUnlock();
TclpGlobalUnlock();
#endif /* TCL_THREADS */
}
+16 -16
View File
@@ -27,11 +27,11 @@
*/
/*
* The master collection of information about TSDs. This is shared across the
* The global collection of information about TSDs. This is shared across the
* whole process, and includes the mutex used to protect it.
*/
static struct TSDMaster {
static struct {
void *key; /* Key into the system TSD structure. The
* collection of Tcl TSD values for a
* particular thread will hang off the
@@ -41,13 +41,13 @@ static struct TSDMaster {
* increasing value. */
Tcl_Mutex mutex; /* Protection for the rest of this structure,
* which holds per-process data. */
} tsdMaster = { NULL, 0, NULL };
} tsdGlobal = { NULL, 0, NULL };
/*
* The type of the data held per thread in a system TSD.
*/
typedef struct TSDTable {
typedef struct {
ClientData *tablePtr; /* The table of Tcl TSDs. */
sig_atomic_t allocated; /* The size of the table in the current
* thread. */
@@ -57,7 +57,7 @@ typedef struct TSDTable {
* The actual type of Tcl_ThreadDataKey.
*/
typedef union TSDUnion {
typedef union {
volatile sig_atomic_t offset;
/* The type is really an offset into the
* thread-local table of TSDs, which is this
@@ -189,7 +189,7 @@ void *
TclThreadStorageKeyGet(
Tcl_ThreadDataKey *dataKeyPtr)
{
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
ClientData resultPtr = NULL;
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
sig_atomic_t offset = keyPtr->offset;
@@ -223,12 +223,12 @@ TclThreadStorageKeySet(
Tcl_ThreadDataKey *dataKeyPtr,
void *value)
{
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
if (tsdTablePtr == NULL) {
tsdTablePtr = TSDTableCreate();
TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr);
}
/*
@@ -240,15 +240,15 @@ TclThreadStorageKeySet(
*/
if (keyPtr->offset == 0) {
Tcl_MutexLock(&tsdMaster.mutex);
Tcl_MutexLock(&tsdGlobal.mutex);
if (keyPtr->offset == 0) {
/*
* The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
*/
keyPtr->offset = ++tsdMaster.counter;
keyPtr->offset = ++tsdGlobal.counter;
}
Tcl_MutexUnlock(&tsdMaster.mutex);
Tcl_MutexUnlock(&tsdGlobal.mutex);
}
/*
@@ -288,11 +288,11 @@ TclThreadStorageKeySet(
void
TclFinalizeThreadDataThread(void)
{
TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
TSDTable *tsdTablePtr = TclpThreadGetGlobalTSD(tsdGlobal.key);
if (tsdTablePtr != NULL) {
TSDTableDelete(tsdTablePtr);
TclpThreadSetMasterTSD(tsdMaster.key, NULL);
TclpThreadSetGlobalTSD(tsdGlobal.key, NULL);
}
}
@@ -316,7 +316,7 @@ TclFinalizeThreadDataThread(void)
void
TclInitThreadStorage(void)
{
tsdMaster.key = TclpThreadCreateKey();
tsdGlobal.key = TclpThreadCreateKey();
}
/*
@@ -339,8 +339,8 @@ TclInitThreadStorage(void)
void
TclFinalizeThreadStorage(void)
{
TclpThreadDeleteKey(tsdMaster.key);
tsdMaster.key = NULL;
TclpThreadDeleteKey(tsdGlobal.key);
tsdGlobal.key = NULL;
}
#else /* !TCL_THREADS */
+2 -2
View File
@@ -294,7 +294,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
(0 == strncmp(script, "-joinable", (size_t) len))) {
(0 == strncmp(script, "-joinable", len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
@@ -311,7 +311,7 @@ ThreadObjCmd(
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
&& (0 == strncmp(script, "-joinable", (size_t) len)));
&& (0 == strncmp(script, "-joinable", len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
+6 -6
View File
@@ -217,7 +217,7 @@ TimerExitProc(
Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
if (tsdPtr != NULL) {
register TimerHandler *timerHandlerPtr;
TimerHandler *timerHandlerPtr;
timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
while (timerHandlerPtr != NULL) {
@@ -294,7 +294,7 @@ TclCreateAbsoluteTimerHandler(
Tcl_TimerProc *proc,
ClientData clientData)
{
register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
ThreadSpecificData *tsdPtr = InitTimer();
timerHandlerPtr = ckalloc(sizeof(TimerHandler));
@@ -355,7 +355,7 @@ Tcl_DeleteTimerHandler(
Tcl_TimerToken token) /* Result previously returned by
* Tcl_DeleteTimerHandler. */
{
register TimerHandler *timerHandlerPtr, *prevPtr;
TimerHandler *timerHandlerPtr, *prevPtr;
ThreadSpecificData *tsdPtr = InitTimer();
if (token == NULL) {
@@ -621,7 +621,7 @@ Tcl_DoWhenIdle(
Tcl_IdleProc *proc, /* Function to invoke. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
register IdleHandler *idlePtr;
IdleHandler *idlePtr;
Tcl_Time blockTime;
ThreadSpecificData *tsdPtr = InitTimer();
@@ -665,7 +665,7 @@ Tcl_CancelIdleCall(
Tcl_IdleProc *proc, /* Function that was previously registered. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
register IdleHandler *idlePtr, *prevPtr;
IdleHandler *idlePtr, *prevPtr;
IdleHandler *nextPtr;
ThreadSpecificData *tsdPtr = InitTimer();
@@ -906,7 +906,7 @@ Tcl_AfterObjCmd(
tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
&tempLength);
if ((length == tempLength)
&& !memcmp(command, tempCommand, (unsigned) length)) {
&& !memcmp(command, tempCommand, length)) {
break;
}
}
+25 -26
View File
@@ -136,7 +136,7 @@ static int StringTraceProc(ClientData clientData,
static void StringTraceDeleteProc(ClientData clientData);
static void DisposeTraceResult(int flags, char *result);
static int TraceVarEx(Tcl_Interp *interp, const char *part1,
const char *part2, register VarTrace *tracePtr);
const char *part2, VarTrace *tracePtr);
/*
* The following structure holds the client data for string-based
@@ -278,7 +278,7 @@ Tcl_TraceObjCmd(
return TCL_ERROR;
}
opsList = Tcl_NewObj();
TclNewObj(opsList);
Tcl_IncrRefCount(opsList);
flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
if (numFlags == 0) {
@@ -322,7 +322,7 @@ Tcl_TraceObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "name");
return TCL_ERROR;
}
resultListPtr = Tcl_NewObj();
TclNewObj(resultListPtr);
name = Tcl_GetString(objv[2]);
FOREACH_VAR_TRACE(interp, name, clientData) {
TraceVarInfo *tvarPtr = clientData;
@@ -967,7 +967,7 @@ TraceVariableObjCmd(
return TCL_ERROR;
}
resultListPtr = Tcl_NewObj();
TclNewObj(resultListPtr);
name = Tcl_GetString(objv[3]);
FOREACH_VAR_TRACE(interp, name, clientData) {
Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
@@ -1049,7 +1049,7 @@ Tcl_CommandTraceInfo(
* call will return the first trace. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
CommandTrace *tracePtr;
cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
TCL_LEAVE_ERR_MSG);
@@ -1114,7 +1114,7 @@ Tcl_TraceCommand(
ClientData clientData) /* Arbitrary argument to pass to proc. */
{
Command *cmdPtr;
register CommandTrace *tracePtr;
CommandTrace *tracePtr;
cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
TCL_LEAVE_ERR_MSG);
@@ -1177,10 +1177,10 @@ Tcl_UntraceCommand(
Tcl_CommandTraceProc *proc, /* Function assocated with trace. */
ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register CommandTrace *tracePtr;
CommandTrace *tracePtr;
CommandTrace *prevPtr;
Command *cmdPtr;
Interp *iPtr = (Interp *) interp;
Interp *iPtr = (Interp *)interp;
ActiveCommandTrace *activePtr;
int hasExecTraces = 0;
@@ -1255,7 +1255,6 @@ Tcl_UntraceCommand(
*/
if (cmdPtr->compileProc != NULL) {
Interp *iPtr = (Interp *) interp;
iPtr->compileEpoch++;
}
}
@@ -1672,13 +1671,13 @@ TclCheckInterpTraces(
static int
CallTraceFunction(
Tcl_Interp *interp, /* The current interpreter. */
register Trace *tracePtr, /* Describes the trace function to call. */
Trace *tracePtr, /* Describes the trace function to call. */
Command *cmdPtr, /* Points to command's Command struct. */
const char *command, /* Points to the first character of the
* command's source before substitutions. */
int numChars, /* The number of characters in the command's
* source. */
register int objc, /* Number of arguments for the command. */
int objc, /* Number of arguments for the command. */
Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */
{
Interp *iPtr = (Interp *) interp;
@@ -1689,8 +1688,8 @@ CallTraceFunction(
* Copy the command characters into a new string.
*/
commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
memcpy(commandCopy, command, (size_t) numChars);
commandCopy = TclStackAlloc(interp, numChars + 1);
memcpy(commandCopy, command, numChars);
commandCopy[numChars] = '\0';
/*
@@ -1853,7 +1852,7 @@ TraceExecutionProc(
* Append result code.
*/
resultCode = Tcl_NewIntObj(code);
TclNewIntObj(resultCode, code);
resultCodeStr = Tcl_GetString(resultCode);
Tcl_DStringAppendElement(&cmd, resultCodeStr);
Tcl_DecrRefCount(resultCode);
@@ -1920,7 +1919,7 @@ TraceExecutionProc(
if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
TCL_TRACE_LEAVE_DURING_EXEC))) {
register unsigned len = strlen(command) + 1;
unsigned len = strlen(command) + 1;
tcmdPtr->startLevel = level;
tcmdPtr->startCmd = ckalloc(len);
@@ -2065,7 +2064,7 @@ TraceVarProc(
}
}
if (destroy && result != NULL) {
register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
Tcl_DecrRefCount(errMsgObj);
result = NULL;
@@ -2142,8 +2141,8 @@ Tcl_CreateObjTrace(
Tcl_CmdObjTraceDeleteProc *delProc)
/* Function to call when trace is deleted */
{
register Trace *tracePtr;
register Interp *iPtr = (Interp *) interp;
Trace *tracePtr;
Interp *iPtr = (Interp *) interp;
/*
* Test if this trace allows inline compilation of commands.
@@ -2342,7 +2341,7 @@ Tcl_DeleteTrace(
{
Interp *iPtr = (Interp *) interp;
Trace *prevPtr, *tracePtr = (Trace *) trace;
register Trace **tracePtr2 = &iPtr->tracePtr;
Trace **tracePtr2 = &iPtr->tracePtr;
ActiveInterpTrace *activePtr;
/*
@@ -2534,7 +2533,7 @@ TclCheckArrayTraces(
int
TclObjCallVarTraces(
Interp *iPtr, /* Interpreter containing variable. */
register Var *arrayPtr, /* Pointer to array variable that contains the
Var *arrayPtr, /* Pointer to array variable that contains the
* variable, or NULL if the variable isn't an
* element of an array. */
Var *varPtr, /* Variable whose traces are to be invoked. */
@@ -2568,7 +2567,7 @@ TclObjCallVarTraces(
int
TclCallVarTraces(
Interp *iPtr, /* Interpreter containing variable. */
register Var *arrayPtr, /* Pointer to array variable that contains the
Var *arrayPtr, /* Pointer to array variable that contains the
* variable, or NULL if the variable isn't an
* element of an array. */
Var *varPtr, /* Variable whose traces are to be invoked. */
@@ -2581,7 +2580,7 @@ TclCallVarTraces(
* error, then leave an error message and
* stack trace information in *iPTr. */
{
register VarTrace *tracePtr;
VarTrace *tracePtr;
ActiveVarTrace active;
char *result;
const char *openParen, *p;
@@ -2909,7 +2908,7 @@ Tcl_UntraceVar2(
Tcl_VarTraceProc *proc, /* Function assocated with trace. */
ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register VarTrace *tracePtr;
VarTrace *tracePtr;
VarTrace *prevPtr, *nextPtr;
Var *varPtr, *arrayPtr;
Interp *iPtr = (Interp *) interp;
@@ -3099,7 +3098,7 @@ Tcl_VarTraceInfo2(
hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
if (hPtr) {
register VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
if (prevClientData != NULL) {
for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
@@ -3195,7 +3194,7 @@ Tcl_TraceVar2(
* invoked upon varName. */
ClientData clientData) /* Arbitrary argument to pass to proc. */
{
register VarTrace *tracePtr;
VarTrace *tracePtr;
int result;
tracePtr = ckalloc(sizeof(VarTrace));
@@ -3240,7 +3239,7 @@ TraceVarEx(
const char *part2, /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
register VarTrace *tracePtr)/* Structure containing flags, traceProc and
VarTrace *tracePtr)/* Structure containing flags, traceProc and
* clientData fields. Others should be left
* blank. Will be ckfree()d (eventually) if
* this function returns TCL_OK, and up to
+3 -3
View File
@@ -2036,7 +2036,7 @@ Tcl_ConcatObj(
}
}
if (!resPtr) {
resPtr = Tcl_NewObj();
TclNewObj(resPtr);
}
return resPtr;
}
@@ -4263,8 +4263,8 @@ TclGetProcessGlobalValue(
if (pgvPtr->encoding != current) {
/*
* The system encoding has changed since the master string value
* was saved. Convert the master value to be based on the new
* The system encoding has changed since the global string value
* was saved. Convert the global value to be based on the new
* system encoding.
*/
+69 -68
View File
@@ -123,17 +123,17 @@ VarHashNextVar(
* access is denied.
*/
static const char *noSuchVar = "no such variable";
static const char *isArray = "variable is array";
static const char *needArray = "variable isn't array";
static const char *noSuchElement = "no such element in array";
static const char *danglingElement =
static const char NOSUCHVAR[] = "no such variable";
static const char ISARRAY[] = "variable is array";
static const char NEEDARRAY[] = "variable isn't array";
static const char NOSUCHELEMENT[] = "no such element in array";
static const char DANGLINGELEMENT[] =
"upvar refers to element in deleted array";
static const char *danglingVar =
static const char DANGLINGVAR[] =
"upvar refers to variable in deleted namespace";
static const char *badNamespace = "parent namespace doesn't exist";
static const char *missingName = "missing variable name";
static const char *isArrayElement =
static const char BADNAMESPACE[] = "parent namespace doesn't exist";
static const char MISSINGNAME[] = "missing variable name";
static const char ISARRAYELEMENT[] =
"name refers to an element in an array";
/*
@@ -489,7 +489,7 @@ TclLookupVar(
Var *
TclObjLookupVar(
Tcl_Interp *interp, /* Interpreter to use for lookup. */
register Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an
Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an
* array. Otherwise, this is a full variable
* name that could include a parenthesized
* array element. */
@@ -561,7 +561,7 @@ TclObjLookupVarEx(
* is set to NULL. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr; /* Points to the variable's in-frame Var
Var *varPtr; /* Points to the variable's in-frame Var
* structure. */
const char *part1;
int index, len1, len2;
@@ -613,7 +613,7 @@ TclObjLookupVarEx(
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
noSuchVar, -1);
NOSUCHVAR, -1);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
}
return NULL;
@@ -640,7 +640,7 @@ TclObjLookupVarEx(
* part1Ptr is possibly an unparsed array element.
*/
register int i;
int i;
len2 = -1;
for (i = 0; i < len1; i++) {
@@ -648,7 +648,7 @@ TclObjLookupVarEx(
if (part2Ptr != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
needArray, -1);
NEEDARRAY, -1);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
NULL);
}
@@ -665,7 +665,7 @@ TclObjLookupVarEx(
len1 = i;
newPart2 = ckalloc(len2 + 1);
memcpy(newPart2, part2, (unsigned) len2);
memcpy(newPart2, part2, len2);
*(newPart2+len2) = '\0';
part2 = newPart2;
part2Ptr = Tcl_NewStringObj(newPart2, -1);
@@ -942,10 +942,10 @@ TclLookupSimpleVar(
TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
if (varNsPtr == NULL) {
*errMsgPtr = badNamespace;
*errMsgPtr = BADNAMESPACE;
return NULL;
} else if (tail == NULL) {
*errMsgPtr = missingName;
*errMsgPtr = MISSINGNAME;
return NULL;
}
if (tail != varName) {
@@ -967,7 +967,7 @@ TclLookupSimpleVar(
*indexPtr = -2;
}
} else { /* Var wasn't found and not to create it. */
*errMsgPtr = noSuchVar;
*errMsgPtr = NOSUCHVAR;
return NULL;
}
}
@@ -980,7 +980,7 @@ TclLookupSimpleVar(
int localLen;
for (i=0 ; i<localCt ; i++, objPtrPtr++) {
register Tcl_Obj *objPtr = *objPtrPtr;
Tcl_Obj *objPtr = *objPtrPtr;
if (objPtr) {
localNameStr = TclGetStringFromObj(objPtr, &localLen);
@@ -1007,7 +1007,7 @@ TclLookupSimpleVar(
varPtr = VarHashFindVar(tablePtr, varNamePtr);
}
if (varPtr == NULL) {
*errMsgPtr = noSuchVar;
*errMsgPtr = NOSUCHVAR;
}
}
}
@@ -1087,7 +1087,7 @@ TclLookupArrayElement(
if (!createArray) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
noSuchVar, index);
NOSUCHVAR, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
}
@@ -1102,7 +1102,7 @@ TclLookupArrayElement(
if (TclIsVarDeadHash(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
danglingVar, index);
DANGLINGVAR, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
}
@@ -1121,7 +1121,7 @@ TclLookupArrayElement(
TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
} else if (!TclIsVarArray(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
@@ -1143,7 +1143,7 @@ TclLookupArrayElement(
if (varPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
noSuchElement, index);
NOSUCHELEMENT, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
TclGetString(elNamePtr), NULL);
}
@@ -1330,10 +1330,10 @@ Tcl_Obj *
Tcl_ObjGetVar2(
Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
register Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
Tcl_Obj *part2Ptr, /* If non-null, points to an object holding
* the name of an element in the array
* part1Ptr. */
int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and
@@ -1428,7 +1428,7 @@ Tcl_Obj *
TclPtrGetVarIdx(
Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
register Var *varPtr, /* The variable to be read.*/
Var *varPtr, /* The variable to be read.*/
Var *arrayPtr, /* NULL for scalar variables, pointer to the
* containing array otherwise. */
Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
@@ -1469,11 +1469,11 @@ TclPtrGetVarIdx(
if (flags & TCL_LEAVE_ERR_MSG) {
if (TclIsVarUndefined(varPtr) && arrayPtr
&& !TclIsVarUndefined(arrayPtr)) {
msg = noSuchElement;
msg = NOSUCHELEMENT;
} else if (TclIsVarArray(varPtr)) {
msg = isArray;
msg = ISARRAY;
} else {
msg = noSuchVar;
msg = NOSUCHVAR;
}
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
}
@@ -1512,7 +1512,7 @@ TclPtrGetVarIdx(
int
Tcl_SetObjCmd(
ClientData dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
Tcl_Interp *interp,/* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
@@ -1738,10 +1738,10 @@ Tcl_Obj *
Tcl_ObjSetVar2(
Tcl_Interp *interp, /* Command interpreter in which variable is to
* be found. */
register Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
Tcl_Obj *part1Ptr, /* Points to an object holding the name of an
* array (if part2 is non-NULL) or the name of
* a variable. */
register Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding
Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding
* the name of an element in the array
* part1Ptr. */
Tcl_Obj *newValuePtr, /* New value for variable. */
@@ -1854,7 +1854,7 @@ Tcl_Obj *
TclPtrSetVarIdx(
Tcl_Interp *interp, /* Command interpreter in which variable is to
* be looked up. */
register Var *varPtr, /* Reference to the variable to set. */
Var *varPtr, /* Reference to the variable to set. */
Var *arrayPtr, /* Reference to the array containing the
* variable, or NULL if the variable is a
* scalar. */
@@ -1887,11 +1887,11 @@ TclPtrSetVarIdx(
if (flags & TCL_LEAVE_ERR_MSG) {
if (TclIsVarArrayElement(varPtr)) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
danglingElement, index);
DANGLINGELEMENT, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
} else {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
danglingVar, index);
DANGLINGVAR, index);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
}
}
@@ -1904,7 +1904,7 @@ TclPtrSetVarIdx(
if (TclIsVarArray(varPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
}
goto earlyError;
@@ -2205,7 +2205,7 @@ TclPtrIncrObjVarIdx(
* variable, or -1. Only used when part1Ptr is
* NULL. */
{
register Tcl_Obj *varValuePtr;
Tcl_Obj *varValuePtr;
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)++;
@@ -2216,7 +2216,7 @@ TclPtrIncrObjVarIdx(
VarHashRefCount(varPtr)--;
}
if (varValuePtr == NULL) {
varValuePtr = Tcl_NewIntObj(0);
TclNewIntObj(varValuePtr, 0);
}
if (Tcl_IsShared(varValuePtr)) {
/* Copy on write */
@@ -2465,7 +2465,7 @@ int
TclPtrUnsetVarIdx(
Tcl_Interp *interp, /* Command interpreter in which varName is to
* be looked up. */
register Var *varPtr, /* The variable to be unset. */
Var *varPtr, /* The variable to be unset. */
Var *arrayPtr, /* NULL for scalar variables, pointer to the
* containing array otherwise. */
Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
@@ -2502,7 +2502,7 @@ TclPtrUnsetVarIdx(
if (result != TCL_OK) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
}
}
@@ -2719,8 +2719,8 @@ Tcl_UnsetObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register int i, flags = TCL_LEAVE_ERR_MSG;
register const char *name;
int i, flags = TCL_LEAVE_ERR_MSG;
const char *name;
if (objc == 1) {
/*
@@ -2788,7 +2788,7 @@ Tcl_AppendObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Var *varPtr, *arrayPtr;
register Tcl_Obj *varValuePtr = NULL;
Tcl_Obj *varValuePtr = NULL;
/* Initialized to avoid compiler warning. */
int i;
@@ -3697,7 +3697,7 @@ ArraySetCmd(
}
if (arrayPtr) {
CleanupVar(varPtr, arrayPtr);
TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
TclGetString(arrayNameObj), NULL);
return TCL_ERROR;
@@ -3815,7 +3815,7 @@ ArraySetCmd(
*/
TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
needArray, -1);
NEEDARRAY, -1);
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
return TCL_ERROR;
}
@@ -4529,7 +4529,7 @@ Tcl_GetVariableFullName(
* variable's full name is appended. */
{
Interp *iPtr = (Interp *) interp;
register Var *varPtr = (Var *) variable;
Var *varPtr = (Var *) variable;
Tcl_Obj *namePtr;
Namespace *nsPtr;
@@ -4589,9 +4589,9 @@ Tcl_GlobalObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
register Tcl_Obj *objPtr, *tailPtr;
Tcl_Obj *objPtr, *tailPtr;
const char *varName;
register const char *tail;
const char *tail;
int result, i;
/*
@@ -4718,7 +4718,7 @@ Tcl_VariableObjCmd(
*/
TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
isArrayElement, -1);
ISARRAYELEMENT, -1);
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
return TCL_ERROR;
}
@@ -4999,8 +4999,8 @@ ParseSearchId(
* name. */
{
Interp *iPtr = (Interp *) interp;
register const char *string;
register size_t offset;
const char *string;
size_t offset;
int id;
ArraySearch *searchPtr;
const char *varName = TclGetString(varNamePtr);
@@ -5081,7 +5081,7 @@ ParseSearchId(
static void
DeleteSearches(
Interp *iPtr,
register Var *arrayVarPtr) /* Variable whose searches are to be
Var *arrayVarPtr) /* Variable whose searches are to be
* deleted. */
{
ArraySearch *searchPtr, *nextPtr;
@@ -5140,7 +5140,8 @@ TclDeleteNamespaceVars(
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_Obj *objPtr;
TclNewObj(objPtr);
VarHashRefCount(varPtr)++; /* Make sure we get to remove from
* hash. */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
@@ -5222,7 +5223,7 @@ TclDeleteVars(
{
Tcl_Interp *interp = (Tcl_Interp *) iPtr;
Tcl_HashSearch search;
register Var *varPtr;
Var *varPtr;
int flags;
Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
@@ -5274,7 +5275,7 @@ TclDeleteCompiledLocalVars(
CallFrame *framePtr) /* Procedure call frame containing compiler-
* assigned local variables to delete. */
{
register Var *varPtr;
Var *varPtr;
int numLocals, i;
Tcl_Obj **namePtrPtr;
@@ -5323,7 +5324,7 @@ DeleteArray(
{
Tcl_HashSearch search;
Tcl_HashEntry *tPtr;
register Var *elPtr;
Var *elPtr;
ActiveVarTrace *activePtr;
Tcl_Obj *objPtr;
VarTrace *tracePtr;
@@ -5535,8 +5536,8 @@ static void
FreeParsedVarName(
Tcl_Obj *objPtr)
{
register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
char *elem = objPtr->internalRep.twoPtrValue.ptr2;
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
@@ -5550,8 +5551,8 @@ DupParsedVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
char *elemCopy;
unsigned elemLen;
@@ -5595,10 +5596,10 @@ UpdateParsedVarName(
objPtr->bytes = p;
objPtr->length = totalLen;
memcpy(p, part1, (unsigned) len1);
memcpy(p, part1, len1);
p += len1;
*p++ = '(';
memcpy(p, part2, (unsigned) len2);
memcpy(p, part2, len2);
p += len2;
*p++ = ')';
*p = '\0';
@@ -5684,7 +5685,7 @@ ObjFindNamespaceVar(
Namespace *nsPtr[2], *cxtNsPtr;
const char *simpleName;
Var *varPtr;
register int search;
int search;
int result;
Tcl_Var var;
Tcl_Obj *simpleNamePtr;
@@ -5875,7 +5876,7 @@ TclInfoVarsCmd(
if (!TclIsVarUndefined(varPtr)
|| TclIsVarNamespaceVar(varPtr)) {
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
elemObjPtr);
} else {
@@ -5908,7 +5909,7 @@ TclInfoVarsCmd(
if ((simplePattern == NULL)
|| Tcl_StringMatch(varName, simplePattern)) {
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
TclNewObj(elemObjPtr);
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
elemObjPtr);
} else {
@@ -6311,8 +6312,8 @@ CompareVarKeys(
{
Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = hPtr->key.objPtr;
register const char *p1, *p2;
register int l1, l2;
const char *p1, *p2;
int l1, l2;
/*
* If the object pointers are the same then they match.
+11 -10
View File
@@ -205,7 +205,7 @@ static void ZlibTransformTimerRun(ClientData clientData);
static const Tcl_ChannelType zlibChannelType = {
"zlib",
TCL_CHANNEL_VERSION_3,
TCL_CHANNEL_VERSION_5,
ZlibTransformClose,
ZlibTransformInput,
ZlibTransformOutput,
@@ -2133,7 +2133,7 @@ ZlibCmd(
break;
case 1:
headerVarObj = objv[i+1];
headerDictObj = Tcl_NewObj();
TclNewObj(headerDictObj);
break;
}
}
@@ -2664,21 +2664,21 @@ ZlibStreamAddCmd(
switch ((enum addOptions) index) {
case ao_flush: /* -flush */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_SYNC_FLUSH;
}
break;
case ao_fullflush: /* -fullflush */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_FULL_FLUSH;
}
break;
case ao_finalize: /* -finalize */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_FINISH;
@@ -2788,21 +2788,21 @@ ZlibStreamPutCmd(
switch ((enum putOptions) index) {
case po_flush: /* -flush */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_SYNC_FLUSH;
}
break;
case po_fullflush: /* -fullflush */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_FULL_FLUSH;
}
break;
case po_finalize: /* -finalize */
if (flush > -1) {
if (flush >= 0) {
flush = -2;
} else {
flush = Z_FINISH;
@@ -3432,8 +3432,9 @@ ZlibTransformGetOption(
if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
(strcmp(optionName, "-header") == 0))) {
Tcl_Obj *tmpObj = Tcl_NewObj();
Tcl_Obj *tmpObj;
TclNewObj(tmpObj);
ExtractHeader(&cd->inHeader.header, tmpObj);
if (optionName == NULL) {
Tcl_DStringAppendElement(dsPtr, "-header");
@@ -3683,7 +3684,7 @@ ZlibStackChannelTransform(
if (cd->inAllocated < cd->readAheadLimit) {
cd->inAllocated = cd->readAheadLimit;
}
cd->inBuffer = ckalloc(cd->inAllocated);
cd->inBuffer = (char *)ckalloc(cd->inAllocated);
if (cd->flags & IN_HEADER) {
if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
goto error;
+9 -7
View File
@@ -240,6 +240,7 @@ proc auto_mkindex_old {dir args} {
set f ""
set error [catch {
set f [open $file]
fconfigure $f -eofchar \032
while {[gets $f line] >= 0} {
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
set procName [lindex [auto_qualify $procName "::"] 0]
@@ -350,6 +351,7 @@ proc auto_mkindex_parser::mkindex {file} {
set scriptFile $file
set fid [open $file]
fconfigure $fid -eofchar \032
set contents [read $fid]
close $fid
@@ -376,10 +378,10 @@ proc auto_mkindex_parser::mkindex {file} {
# auto_mkindex_parser::hook command
#
# Registers a Tcl command to evaluate when initializing the slave interpreter
# used by the mkindex parser. The command is evaluated in the master
# Registers a Tcl command to evaluate when initializing the child interpreter
# used by the mkindex parser. The command is evaluated in the parent
# interpreter, and can use the variable auto_mkindex_parser::parser to get to
# the slave
# the child
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
@@ -389,14 +391,14 @@ proc auto_mkindex_parser::hook {cmd} {
# auto_mkindex_parser::slavehook command
#
# Registers a Tcl command to evaluate when initializing the slave interpreter
# used by the mkindex parser. The command is evaluated in the slave
# Registers a Tcl command to evaluate when initializing the child interpreter
# used by the mkindex parser. The command is evaluated in the child
# interpreter.
proc auto_mkindex_parser::slavehook {cmd} {
variable initCommands
# The $parser variable is defined to be the name of the slave interpreter
# The $parser variable is defined to be the name of the child interpreter
# when this command is used later.
lappend initCommands "\$parser eval [list $cmd]"
@@ -550,7 +552,7 @@ auto_mkindex_parser::command proc {name args} {
# Conditionally add support for Tcl byte code files. There are some tricky
# details here. First, we need to get the tbcload library initialized in the
# current interpreter. We cannot load tbcload into the slave until we have
# current interpreter. We cannot load tbcload into the child until we have
# done so because it needs access to the tcl_patchLevel variable. Second,
# because the package index file may defer loading the library until we invoke
# a command, we need to explicitly invoke auto_load to force it to be loaded.
+2 -2
View File
@@ -3304,7 +3304,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
return
}
# Since an unsafe interp uses the [clock] command in the master, this code
# Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
@@ -3344,7 +3344,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } {
proc ::tcl::clock::LoadZoneinfoFile { fileName } {
variable ZoneinfoPaths
# Since an unsafe interp uses the [clock] command in the master, this code
# Since an unsafe interp uses the [clock] command in the parent, this code
# is security sensitive. Make sure that the path name cannot escape the
# given directory.
+2 -2
View File
@@ -1,7 +1,7 @@
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] dde]
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] Dde]
} else {
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]
}
+99 -18
View File
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.9.2
package provide http 2.9.5
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -531,7 +531,7 @@ proc http::CloseSocket {s {token {}}} {
} else {
set map [array get socketMapping]
set ndx [lsearch -exact $map $s]
if {$ndx != -1} {
if {$ndx >= 0} {
incr ndx -1
set connId [lindex $map $ndx]
}
@@ -721,7 +721,7 @@ proc http::geturl {url args} {
body {}
status ""
http ""
connection close
connection keep-alive
}
set state(-keepalive) $defaultKeepalive
set state(-strict) $strict
@@ -733,6 +733,7 @@ proc http::geturl {url args} {
-strict boolean
-timeout integer
-validate boolean
-headers dict
}
set state(charset) $defaultCharset
set options {
@@ -746,9 +747,8 @@ proc http::geturl {url args} {
foreach {flag value} $args {
if {[regexp -- $pat $flag]} {
# Validate numbers
if {
[info exists type($flag)] &&
![string is $type($flag) -strict $value]
if {($flag eq "-headers") ? [catch {dict size $value}] :
([info exists type($flag)] && ![string is $type($flag) -strict $value])
} {
unset $token
return -code error \
@@ -966,6 +966,18 @@ proc http::geturl {url args} {
set state(-pipeline) $http(-pipeline)
}
# We cannot handle chunked encodings with -handler, so force HTTP/1.0
# until we can manage this.
if {[info exists state(-handler)]} {
set state(-protocol) 1.0
}
# RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
if {$state(-protocol) eq "1.0"} {
set state(connection) close
set state(-keepalive) 0
}
# See if we are supposed to use a previously opened channel.
# - In principle, ANY call to http::geturl could use a previously opened
# channel if it is available - the "Connection: keep-alive" header is a
@@ -1037,7 +1049,7 @@ proc http::geturl {url args} {
}
# Do not automatically close the connection socket.
set state(connection) {}
set state(connection) keep-alive
}
}
@@ -1338,11 +1350,6 @@ proc http::Connected {token proto phost srvurl} {
if {[info exists state(-method)] && ($state(-method) ne "")} {
set how $state(-method)
}
# We cannot handle chunked encodings with -handler, so force HTTP/1.0
# until we can manage this.
if {[info exists state(-handler)]} {
set state(-protocol) 1.0
}
set accept_types_seen 0
Log ^B$tk begin sending request - token $token
@@ -1361,7 +1368,7 @@ proc http::Connected {token proto phost srvurl} {
puts $sock "Host: $host:$port"
}
puts $sock "User-Agent: $http(-useragent)"
if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
if {($state(-protocol) > 1.0) && $state(-keepalive)} {
# Send this header, because a 1.1 server is not compelled to treat
# this as the default.
puts $sock "Connection: keep-alive"
@@ -1369,9 +1376,17 @@ proc http::Connected {token proto phost srvurl} {
if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
}
if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
puts $sock "Proxy-Connection: Keep-Alive"
if {($state(-protocol) < 1.1)} {
# RFC7230 A.1
# Some server implementations of HTTP/1.0 have a faulty
# implementation of RFC 2068 Keep-Alive.
# Don't leave this to chance.
# For HTTP/1.0 we have already "set state(connection) close"
# and "state(-keepalive) 0".
puts $sock "Connection: close"
}
# RFC7230 A.1 - "clients are encouraged not to send the
# Proxy-Connection header field in any requests"
set accept_encoding_seen 0
set content_type_seen 0
dict for {key value} $state(-headers) {
@@ -1631,9 +1646,51 @@ proc http::ReceiveResponse {token} {
Log ^D$tk begin receiving response - token $token
coroutine ${token}EventCoroutine http::Event $sock $token
fileevent $sock readable ${token}EventCoroutine
if {[info exists state(-handler)] || [info exists state(-progress)]} {
fileevent $sock readable [list http::EventGateway $sock $token]
} else {
fileevent $sock readable ${token}EventCoroutine
}
return
}
# http::EventGateway
#
# Bug [c2dc1da315].
# - Recursive launch of the coroutine can occur if a -handler or -progress
# callback is used, and the callback command enters the event loop.
# - To prevent this, the fileevent "binding" is disabled while the
# coroutine is in flight.
# - If a recursive call occurs despite these precautions, it is not
# trapped and discarded here, because it is better to report it as a
# bug.
# - Although this solution is believed to be sufficiently general, it is
# used only if -handler or -progress is specified. In other cases,
# the coroutine is called directly.
proc http::EventGateway {sock token} {
variable $token
upvar 0 $token state
fileevent $sock readable {}
catch {${token}EventCoroutine} res opts
if {[info commands ${token}EventCoroutine] ne {}} {
# The coroutine can be deleted by completion (a non-yield return), by
# http::Finish (when there is a premature end to the transaction), by
# http::reset or http::cleanup, or if the caller set option -channel
# but not option -handler: in the last case reading from the socket is
# now managed by commands ::http::Copy*, http::ReceiveChunked, and
# http::make-transformation-chunked.
#
# Catch in case the coroutine has closed the socket.
catch {fileevent $sock readable [list http::EventGateway $sock $token]}
}
# If there was an error, re-throw it.
return -options $opts $res
}
# http::NextPipelinedWrite
#
# - Connecting a socket to a token for writing is done by this command and by
@@ -2688,8 +2745,32 @@ proc http::Event {sock token} {
}
proxy-connection -
connection {
set state(connection) \
[string trim [string tolower $value]]
set tmpHeader [string trim [string tolower $value]]
# RFC 7230 Section 6.1 states that a comma-separated
# list is an acceptable value. According to
# https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
# any comma-separated list implies keep-alive, but I
# don't see this in the RFC so we'll play safe and
# scan any list for "close".
if {$tmpHeader in {close keep-alive}} {
# The common cases, continue.
} elseif {[string first , $tmpHeader] < 0} {
# Not a comma-separated list, not "close",
# therefore "keep-alive".
set tmpHeader keep-alive
} else {
set tmpResult keep-alive
set tmpCsl [split $tmpHeader ,]
# Optional whitespace either side of separator.
foreach el $tmpCsl {
if {[string trim $el] eq {close}} {
set tmpResult close
break
}
}
set tmpHeader $tmpResult
}
set state(connection) $tmpHeader
}
}
lappend state(meta) $key [string trim $value]
+1 -1
View File
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.9.2 [list tclPkgSetup $dir http 2.9.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
package ifneeded http 2.9.5 [list tclPkgSetup $dir http 2.9.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+5 -4
View File
@@ -84,7 +84,7 @@ namespace eval tcl {
proc min {args} {
if {![llength $args]} {
return -code error \
"too few arguments to math function \"min\""
"not enough arguments to math function \"min\""
}
set val Inf
foreach arg $args {
@@ -100,7 +100,7 @@ namespace eval tcl {
proc max {args} {
if {![llength $args]} {
return -code error \
"too few arguments to math function \"max\""
"not enough arguments to math function \"max\""
}
set val -Inf
foreach arg $args {
@@ -313,7 +313,7 @@ proc unknown args {
set errInfo [string range $errInfo 0 $last-1]
set tail "\"$cinfo\""
set last [string last $tail $errInfo]
if {$last + [string length $tail] != [string length $errInfo]} {
if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} {
return -code error -errorcode $errCode \
-errorinfo $errInfo $msg
}
@@ -494,6 +494,7 @@ proc auto_load_index {} {
continue
} else {
set error [catch {
fconfigure $f -eofchar \032
set id [gets $f]
if {$id eq "# Tcl autoload index file, version 2.0"} {
eval [read $f]
@@ -797,7 +798,7 @@ proc tcl::CopyDirectory {action src dest} {
}
}
} else {
if {[string first $nsrc $ndest] != -1} {
if {[string first $nsrc $ndest] >= 0} {
set srclen [expr {[llength [file split $nsrc]] - 1}]
set ndest [lindex [file split $ndest] $srclen]
if {$ndest eq [file tail $nsrc]} {
+3 -3
View File
@@ -11,7 +11,7 @@
package require Tcl 8.5-
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
package provide opt 0.4.7
package provide opt 0.4.8
namespace eval ::tcl {
@@ -44,8 +44,8 @@ namespace eval ::tcl {
{-intflag 7}
{-weirdflag "help string"}
{-noStatics "Not ok to load static packages"}
{-nestedloading1 true "OK to load into nested slaves"}
{-nestedloading2 -boolean true "OK to load into nested slaves"}
{-nestedloading1 true "OK to load into nested children"}
{-nestedloading2 -boolean true "OK to load into nested children"}
{-libsOK -choice {Tk SybTcl}
"List of packages that can be loaded"}
{-precision -int 12 "Number of digits of precision"}
+1 -1
View File
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded opt 0.4.7 [list source [file join $dir optparse.tcl]]
package ifneeded opt 0.4.8 [list source [file join $dir optparse.tcl]]
+8 -4
View File
@@ -237,7 +237,7 @@ proc pkg_mkIndex {args} {
$c eval [list set ::tcl::file $file]
$c eval [list set ::tcl::direct $direct]
# Download needed procedures into the slave because we've just deleted
# Download needed procedures into the child because we've just deleted
# the unknown procedure. This doesn't handle procedures with default
# arguments.
@@ -479,9 +479,12 @@ proc tclPkgUnknown {name args} {
}
set tclSeenPath($dir) 1
# we can't use glob in safe interps, so enclose the following in a
# catch statement, where we get the pkgIndex files out of the
# subdirectories
# Get the pkgIndex.tcl files in subdirectories of auto_path directories.
# - Safe Base interpreters have a restricted "glob" command that
# works in this case.
# - The "catch" was essential when there was no safe glob and every
# call in a safe interp failed; it is retained only for corner
# cases in which the eventual call to glob returns an error.
catch {
foreach file [glob -directory $dir -join -nocomplain \
* pkgIndex.tcl] {
@@ -585,6 +588,7 @@ proc tcl::MacOSXPkgUnknown {original name args} {
set tclSeenPath($dir) 1
# get the pkgIndex files out of the subdirectories
# Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl.
foreach file [glob -directory $dir -join -nocomplain \
* Resources Scripts pkgIndex.tcl] {
set dir [file dirname $file]
+2 -2
View File
@@ -2,8 +2,8 @@ if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.5 \
[list load [file join $dir tclreg13g.dll] registry]
[list load [file join $dir tclreg13g.dll] Registry]
} else {
package ifneeded registry 1.3.5 \
[list load [file join $dir tclreg13.dll] registry]
[list load [file join $dir tclreg13.dll] Registry]
}

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