Compare commits
260
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2ce24093a1 | ||
|
|
9e6b54e433 | ||
|
|
39fcdc3c6e | ||
|
|
1479c62f1c | ||
|
|
54a81d4f0e | ||
|
|
f95a5e7c82 | ||
|
|
5285fe3ede | ||
|
|
8e1f9e82da | ||
|
|
fbac621bfc | ||
|
|
3cc058aa46 | ||
|
|
3e3649a18e | ||
|
|
d35d4b2c53 | ||
|
|
c91c7b7cf1 | ||
|
|
b4a00d3ac5 | ||
|
|
bfcb6b40d2 | ||
|
|
2440231062 | ||
|
|
0f1e352369 | ||
|
|
aed9fbb19c | ||
|
|
4551ca9b2c | ||
|
|
e4dfb0d689 | ||
|
|
63e65ca6f1 | ||
|
|
7887926261 | ||
|
|
91eca443b7 | ||
|
|
cb5d76ed2b | ||
|
|
10372d985a | ||
|
|
5aee161167 | ||
|
|
657b49a9d1 | ||
|
|
bbf4d17089 | ||
|
|
4a2c3b6440 | ||
|
|
3f481feba6 | ||
|
|
1b0845930c | ||
|
|
50a0b81579 | ||
|
|
ad07565ec0 | ||
|
|
3b93da87b3 | ||
|
|
a414da9341 | ||
|
|
345bd636d4 | ||
|
|
134ada8ff9 | ||
|
|
3204893f09 | ||
|
|
7bc81bcbb0 | ||
|
|
6d44125712 | ||
|
|
a2df72aecb | ||
|
|
85c48e5e91 | ||
|
|
d4d8f3201a | ||
|
|
debbae5fd9 | ||
|
|
649d0983f9 | ||
|
|
3146ffb96b | ||
|
|
f1a2117967 | ||
|
|
2044cba5ac | ||
|
|
eee6883d2a | ||
|
|
472fd0a636 | ||
|
|
bfe331b12a | ||
|
|
1092cae12e | ||
|
|
54850c7528 | ||
|
|
365b878745 | ||
|
|
08390e5c47 | ||
|
|
a52254cce9 | ||
|
|
5cc8523f8e | ||
|
|
bcb4faa32f | ||
|
|
fa65ef51ba | ||
|
|
e94119e59b | ||
|
|
0440ab215b | ||
|
|
27c4d781f4 | ||
|
|
8fd5bbdc7c | ||
|
|
612c7a7d4a | ||
|
|
c4a5440ed1 | ||
|
|
822fd2d405 | ||
|
|
e723893895 | ||
|
|
e0623615e3 | ||
|
|
b348c536f6 | ||
|
|
2b788a21e4 | ||
|
|
a8bbc9486a | ||
|
|
f089b1e4a1 | ||
|
|
bb55ca2e95 | ||
|
|
0288a572d8 | ||
|
|
1ecf461e41 | ||
|
|
97f9595151 | ||
|
|
30710a181c | ||
|
|
493b04cbc0 | ||
|
|
8938dbcc25 | ||
|
|
db738e7756 | ||
|
|
c6bb98e763 | ||
|
|
c938932757 | ||
|
|
9878106deb | ||
|
|
4d70c5f1e1 | ||
|
|
c5cad32cd6 | ||
|
|
6a3868f2cc | ||
|
|
3116380710 | ||
|
|
53dc4dcdee | ||
|
|
4733e874fc | ||
|
|
a313e78ffa | ||
|
|
2c3dbea378 | ||
|
|
8520e69f32 | ||
|
|
54223a5f7e | ||
|
|
22515fc47f | ||
|
|
8932701ae7 | ||
|
|
6b45d21b4b | ||
|
|
3adc645802 | ||
|
|
743ced9da3 | ||
|
|
b9ef276505 | ||
|
|
ebd7e8a86b | ||
|
|
4096bf5d01 | ||
|
|
6dcfcb8be9 | ||
|
|
24cec35f7b | ||
|
|
367ade79ed | ||
|
|
e6af5d333b | ||
|
|
24be1383da | ||
|
|
28384139ba | ||
|
|
e5b2f21fe9 | ||
|
|
ccbbb5d288 | ||
|
|
2d27ea7088 | ||
|
|
a33a94ec85 | ||
|
|
f36f801d24 | ||
|
|
841e525556 | ||
|
|
55b0c17067 | ||
|
|
993b39c491 | ||
|
|
272b2008ad | ||
|
|
f7cf1b2bae | ||
|
|
8173bccfd9 | ||
|
|
a5b75dfa9a | ||
|
|
52b97dd00b | ||
|
|
987eb68977 | ||
|
|
f632850eb8 | ||
|
|
ed72e77b7d | ||
|
|
83d427e824 | ||
|
|
f18c1126d5 | ||
|
|
62e1b3723e | ||
|
|
4d6aaa2e8b | ||
|
|
6b6685b8fd | ||
|
|
4bf79aef9b | ||
|
|
066a4b7b35 | ||
|
|
a6f2dee7fb | ||
|
|
a7e397556b | ||
|
|
c084f0ea75 | ||
|
|
5cdaf0e05b | ||
|
|
200e0742b8 | ||
|
|
fe60431f53 | ||
|
|
160ba1cb95 | ||
|
|
058f0df44d | ||
|
|
ff926f2b01 | ||
|
|
bee5c35f44 | ||
|
|
8971b5cdea | ||
|
|
b2e3f2fa04 | ||
|
|
0c1e275cdf | ||
|
|
a2400fbe30 | ||
|
|
211f7d6466 | ||
|
|
6dee5b3e07 | ||
|
|
9d1f38c3e3 | ||
|
|
33647e79c8 | ||
|
|
f440a6ef41 | ||
|
|
c086de021c | ||
|
|
97eb71a629 | ||
|
|
e62b40c808 | ||
|
|
234fb04984 | ||
|
|
1b7d424507 | ||
|
|
5797625e42 | ||
|
|
987422a01f | ||
|
|
5f6b71f3f2 | ||
|
|
f6f0891fff | ||
|
|
27c5ada57e | ||
|
|
5f2f5b63c3 | ||
|
|
59f7320bdd | ||
|
|
00546e5e21 | ||
|
|
a63563bd9a | ||
|
|
1d99884b08 | ||
|
|
8bd533d76e | ||
|
|
23d61a10c2 | ||
|
|
0ee8df700b | ||
|
|
50a950f2b1 | ||
|
|
c74640849e | ||
|
|
861b34625c | ||
|
|
0958b92b37 | ||
|
|
6d9ae4aa16 | ||
|
|
965128fe34 | ||
|
|
ebc5b27c8c | ||
|
|
3916ce9d4c | ||
|
|
4bd227bc12 | ||
|
|
84e92af6dc | ||
|
|
15ca940ca7 | ||
|
|
525bc7c9b5 | ||
|
|
6adf3b8c6c | ||
|
|
3d14dd6bc9 | ||
|
|
41afeeec2b | ||
|
|
623c1cbe5b | ||
|
|
60ef39d24a | ||
|
|
889454ec06 | ||
|
|
752ab085d6 | ||
|
|
c019848148 | ||
|
|
fd1c7c2fb3 | ||
|
|
8f2d19b951 | ||
|
|
f2bea640bb | ||
|
|
d818803502 | ||
|
|
e0437fdf58 | ||
|
|
8163234efd | ||
|
|
f796ad762c | ||
|
|
0185dd6477 | ||
|
|
07d10b8a58 | ||
|
|
bc28cd1ac8 | ||
|
|
9350513d16 | ||
|
|
4fb5d04b2f | ||
|
|
f287d8cb0f | ||
|
|
0c2e553e8f | ||
|
|
915c6abe66 | ||
|
|
0070244914 | ||
|
|
17ebc3cd20 | ||
|
|
5e9e003379 | ||
|
|
2aed1acbd1 | ||
|
|
81a1a91361 | ||
|
|
9a19e4cba0 | ||
|
|
c2d6c48dd9 | ||
|
|
d383707870 | ||
|
|
c33f97005c | ||
|
|
3f126895fb | ||
|
|
d848f30c45 | ||
|
|
d860a2c3a4 | ||
|
|
009f2adf3d | ||
|
|
5684ad8d94 | ||
|
|
774c402365 | ||
|
|
740d1811bc | ||
|
|
451ab6927c | ||
|
|
f302557ad5 | ||
|
|
d061b31460 | ||
|
|
783aea7d3a | ||
|
|
34c17bad36 | ||
|
|
1e62f5ac76 | ||
|
|
afad6ffbb4 | ||
|
|
d72d5f8b7a | ||
|
|
c46c774126 | ||
|
|
ba3bf9b61f | ||
|
|
82bddf4dca | ||
|
|
e10479f3d7 | ||
|
|
c10c796a46 | ||
|
|
582824087d | ||
|
|
da4296c06f | ||
|
|
0dec640514 | ||
|
|
d2b490f552 | ||
|
|
4cfafc3002 | ||
|
|
191c6d2137 | ||
|
|
7eab500306 | ||
|
|
88731d9d93 | ||
|
|
aec5846c12 | ||
|
|
05fb0c0810 | ||
|
|
a47b03577b | ||
|
|
fda71d6d4c | ||
|
|
7070acfea1 | ||
|
|
ddd130e532 | ||
|
|
324ca57f3d | ||
|
|
ae7b32a706 | ||
|
|
5eecd400b7 | ||
|
|
3f19b90244 | ||
|
|
11f1a88c12 | ||
|
|
9fd3e86565 | ||
|
|
dc4782f595 | ||
|
|
cc984c4e6e | ||
|
|
64bf3c8f4a | ||
|
|
064f7e5513 | ||
|
|
6597872335 | ||
|
|
5044035ec0 | ||
|
|
b6b0d1b8dd | ||
|
|
1ddb66bfda | ||
|
|
6b17a1e25a |
@@ -1,3 +1,74 @@
|
||||
A NOTE ON THE CHANGELOG:
|
||||
Starting in early 2011, Tcl source code has been under the management of
|
||||
fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline"
|
||||
view of changes made that is superior in every way to a hand edited log file.
|
||||
Because of this, many Tcl developers are now out of the habit of maintaining
|
||||
this log file. You may still find useful things in it, but the Timeline is
|
||||
a better first place to look now.
|
||||
============================================================================
|
||||
|
||||
2013-09-19 Don Porter <dgp@users.sourceforge.net>
|
||||
|
||||
*** 8.6.1 TAGGED FOR RELEASE ***
|
||||
|
||||
* generic/tcl.h: Bump version number to 8.6.1.
|
||||
* library/init.tcl:
|
||||
* unix/configure.in:
|
||||
* win/configure.in:
|
||||
* unix/tcl.spec:
|
||||
* README:
|
||||
|
||||
* unix/configure: autoconf-2.59
|
||||
* win/configure:
|
||||
|
||||
2013-09-19 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected
|
||||
description of method search order.
|
||||
|
||||
2013-09-18 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
Bump TclOO version to 1.0.1 for release.
|
||||
|
||||
2013-09-17 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
|
||||
Corrected implementation of the core of uuencode handling so that the
|
||||
line length processing is correctly applied.
|
||||
***POTENTIAL INCOMPATIBILITY***
|
||||
Existing code that was using the old versions and working around the
|
||||
limitations will now need to do far less. The -maxlen option now has
|
||||
strict limits on the range of supported lengths; this is a limitation
|
||||
of the format itself.
|
||||
|
||||
2013-09-09 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
|
||||
the internal representation of method bodies during cloning in order
|
||||
to ensure that any bound references to instance variables are removed.
|
||||
|
||||
2013-09-01 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that
|
||||
whitespace at the end of a string don't cause the decoder to drop the
|
||||
last decoded byte.
|
||||
|
||||
2013-08-03 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
|
||||
by the autoloading mechanism.
|
||||
|
||||
2013-08-02 Donal Fellows <dkf@users.sf.net>
|
||||
|
||||
* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
|
||||
crashes when emptying the superclass slot, even when doing elaborate
|
||||
things with metaclasses.
|
||||
|
||||
2013-08-01 Harald Oehlmann <oehhar@users.sf.net>
|
||||
|
||||
* tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
|
||||
thread again if we were forked, to solve Rivet bug 55153.
|
||||
|
||||
2013-07-05 Kevin B. Kenny <kennykb@acm.org>
|
||||
|
||||
* library/tzdata/Africa/Casablanca:
|
||||
@@ -20,12 +91,13 @@
|
||||
|
||||
2013-06-27 Jan Nijtmans <nijtmans@users.sf.net>
|
||||
|
||||
* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs initialized
|
||||
* generic/tclMain.c: encodings.
|
||||
* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs
|
||||
* generic/tclMain.c: initialized encodings.
|
||||
|
||||
2013-06-18 Jan Nijtmans <nijtmans@users.sf.net>
|
||||
|
||||
* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread issue.
|
||||
* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
|
||||
issue.
|
||||
|
||||
2013-06-17 Jan Nijtmans <nijtmans@users.sf.net>
|
||||
|
||||
@@ -137,10 +209,10 @@
|
||||
|
||||
* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
|
||||
* generic/tclDecls.h: "long" type. Binary compatibility with win64
|
||||
requires that all stub entries use 32-bit long's, therefore the
|
||||
need for various wrapper functions/macros. For Tcl 9 a better
|
||||
solution is needed, but that cannot be done without introducing
|
||||
binary incompatibility.
|
||||
requires that all stub entries use 32-bit long's, therefore the need
|
||||
for various wrapper functions/macros. For Tcl 9 a better solution is
|
||||
needed, but that cannot be done without introducing binary
|
||||
incompatibility.
|
||||
|
||||
2013-04-30 Andreas Kupries <andreask@activestate.com>
|
||||
|
||||
@@ -158,8 +230,8 @@
|
||||
|
||||
* generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
|
||||
and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
|
||||
and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same,
|
||||
it only eliminates code duplication.
|
||||
and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it
|
||||
only eliminates code duplication.
|
||||
* generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's
|
||||
exactly the same as TCL_WIDE_INT_IS_LONG
|
||||
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.6.0 source distribution.
|
||||
This is the Tcl 8.6.1 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
|
||||
@@ -8164,6 +8164,143 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
|
||||
|
||||
--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---
|
||||
|
||||
2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann)
|
||||
2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)
|
||||
|
||||
2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)
|
||||
|
||||
2013-01-04 (bug fix) memleak in [format] compiler (fellows)
|
||||
|
||||
2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points
|
||||
|
||||
2013-01-09 (bug fix)[3599395] status line processing (nijtmans)
|
||||
2013-01-23 (bug fix)[2911139] repair async connection management (fellows)
|
||||
=> http 2.8.6
|
||||
|
||||
2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans)
|
||||
|
||||
2013-01-28 (enhancement) improve ensemble bytecode (fellows)
|
||||
|
||||
2013-01-30 (enhancement) selected script code improvements (fradin)
|
||||
=> tcltest 2.3.6
|
||||
|
||||
2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries)
|
||||
=> platform 1.0.11
|
||||
|
||||
2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff)
|
||||
|
||||
2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin)
|
||||
|
||||
2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows)
|
||||
|
||||
2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows)
|
||||
|
||||
2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans)
|
||||
=> msgcat 1.5.1
|
||||
|
||||
2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick)
|
||||
|
||||
2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter)
|
||||
|
||||
2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max)
|
||||
|
||||
2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane)
|
||||
|
||||
2013-03-03 (bug fix)[3606258] major serial port update (english)
|
||||
|
||||
2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
|
||||
(grathwohl,lane,porter)
|
||||
|
||||
2013-03-12 (enhancement) better build support for Debian arch (shadura)
|
||||
|
||||
2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)
|
||||
|
||||
2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin)
|
||||
|
||||
2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter
|
||||
|
||||
2013-04-04 (bug fix) Support URLs with query but no path (max)
|
||||
=> http 2.8.7
|
||||
|
||||
2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas)
|
||||
|
||||
2013-04-29 (enhancement) [array set] compile improvement (fellows)
|
||||
|
||||
2013-04-30 (enhancement) broaden glibc version detection (kupries)
|
||||
=> platform 1.0.12
|
||||
|
||||
2013-05-06 (platform support) Cygwin64 (nijtmans)
|
||||
|
||||
2013-05-15 (enhancement) Improved [list {*}...] compile (fellows)
|
||||
|
||||
2013-05-16 (platform support) mingw-4.0 (nijtmans)
|
||||
|
||||
2013-05-19 (platform support) FreeBSD updates (cerutti)
|
||||
|
||||
2013-05-20 (bug fix)[3613567] access error temp file creation (keene)
|
||||
|
||||
2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene)
|
||||
|
||||
2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows)
|
||||
|
||||
2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann)
|
||||
=> msgcat 1.5.2
|
||||
|
||||
2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)
|
||||
|
||||
2013-06-03 Restored lost performance appending to long strings (elby,porter)
|
||||
|
||||
2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
|
||||
|
||||
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
|
||||
|
||||
2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
|
||||
|
||||
2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)
|
||||
|
||||
2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)
|
||||
|
||||
2013-07-06 tzdata updated to Olson's tzdata2013d (kenny)
|
||||
|
||||
2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter)
|
||||
|
||||
2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter)
|
||||
|
||||
2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane)
|
||||
|
||||
2013-07-29 [string is space \u202f] => 1 (nijtmans)
|
||||
|
||||
2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans)
|
||||
|
||||
2013-08-01 (bug fix)[1905562] RE recursion limit increased to support
|
||||
reported usage of large expressions (porter)
|
||||
|
||||
2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)
|
||||
|
||||
2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows)
|
||||
|
||||
2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter)
|
||||
|
||||
2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter)
|
||||
|
||||
2013-08-15 Errors from execution traces become errors of the command (porter)
|
||||
|
||||
2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)
|
||||
|
||||
2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)
|
||||
|
||||
2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)
|
||||
|
||||
2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter)
|
||||
|
||||
2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows)
|
||||
=> TclOO 1.0.1
|
||||
|
||||
2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows)
|
||||
|
||||
2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter)
|
||||
|
||||
2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter)
|
||||
|
||||
Many optmizations, improvements, and tightened stack management in bytecode.
|
||||
|
||||
--- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
+6
-6
@@ -176,16 +176,16 @@ these return options.
|
||||
The \fB\-errorinfo\fR option holds a stack trace of the
|
||||
operations that were in progress when an error occurred,
|
||||
and is intended to be human-readable.
|
||||
The \fB\-errorcode\fR option holds a list of items that
|
||||
The \fB\-errorcode\fR option holds a Tcl list of items that
|
||||
are intended to be machine-readable.
|
||||
The first item in the \fB\-errorcode\fR value identifies the class of
|
||||
error that occurred
|
||||
(e.g. POSIX means an error occurred in a POSIX system call)
|
||||
(e.g., POSIX means an error occurred in a POSIX system call)
|
||||
and additional elements hold additional pieces
|
||||
of information that depend on the class.
|
||||
See the \fBtclvars\fR manual entry for details on the various
|
||||
formats for the \fB\-errorcode\fR option used by
|
||||
Tcl's built-in commands.
|
||||
See the manual entry on the \fBerrorCode\fR variable for details on the
|
||||
various formats for the \fB\-errorcode\fR option used by Tcl's built-in
|
||||
commands.
|
||||
.PP
|
||||
The \fB\-errorinfo\fR option value is gradually built up as an
|
||||
error unwinds through the nested operations.
|
||||
@@ -307,6 +307,6 @@ so they continue to hold a record of information about the
|
||||
most recent error seen in an interpreter.
|
||||
.SH "SEE ALSO"
|
||||
Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
|
||||
Tcl_SetErrno(3), tclvars(n)
|
||||
Tcl_SetErrno(3), errorCode(n), errorInfo(n)
|
||||
.SH KEYWORDS
|
||||
error, value, value result, stack, trace, variable
|
||||
|
||||
+4
-3
@@ -41,8 +41,9 @@ may only be passed to Tcl routines called from the same thread as
|
||||
the original \fBTcl_CreateInterp\fR call. It is not safe for multiple
|
||||
threads to pass the same token to Tcl's routines.
|
||||
The new interpreter is initialized with the built-in Tcl commands
|
||||
and with the variables documented in the \fBtclvars\fR manual page. To bind in
|
||||
additional commands, call \fBTcl_CreateCommand\fR.
|
||||
and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To
|
||||
bind in additional commands, call \fBTcl_CreateCommand\fR, and to
|
||||
create additional variables, call \fBTcl_SetVar\fR.
|
||||
.PP
|
||||
\fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter
|
||||
will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have
|
||||
@@ -144,6 +145,6 @@ should be used to determine when an interpreter is a candidate for deletion
|
||||
due to inactivity.
|
||||
.VE 8.6
|
||||
.SH "SEE ALSO"
|
||||
Tcl_Preserve(3), Tcl_Release(3), tclvars(n)
|
||||
Tcl_Preserve(3), Tcl_Release(3)
|
||||
.SH KEYWORDS
|
||||
command, create, delete, interpreter
|
||||
|
||||
+1
-1
@@ -33,6 +33,6 @@ Tcl-based applications using \fBputenv\fR should redefine it to
|
||||
\fBTcl_PutEnv\fR so that they will interface properly to the Tcl
|
||||
runtime.
|
||||
.SH "SEE ALSO"
|
||||
tclvars(n)
|
||||
env(n)
|
||||
.SH KEYWORDS
|
||||
environment, variable
|
||||
|
||||
+3
-2
@@ -172,8 +172,9 @@ typedef struct {
|
||||
.PP
|
||||
The \fIversion\fR field allows for future expansion of the structure, and
|
||||
should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The
|
||||
\fIname\fR field provides a human-readable name for the type, and is reserved
|
||||
for debugging.
|
||||
\fIname\fR field provides a human-readable name for the type, and is the value
|
||||
that is exposed via the \fBinfo class methodtype\fR and
|
||||
\fBinfo object methodtype\fR Tcl commands.
|
||||
.PP
|
||||
The \fIcallProc\fR field gives a function that is called when the method is
|
||||
invoked; it must never be NULL.
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
|
||||
Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -207,7 +207,7 @@ is something like:
|
||||
.PP
|
||||
.CS
|
||||
int
|
||||
\fITheCmdObjProc\fR(
|
||||
\fITheCmdOldObjProc\fR(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
@@ -225,7 +225,7 @@ int
|
||||
return result;
|
||||
}
|
||||
\fBTcl_CreateObjCommand\fR(interp, "theCommand",
|
||||
\fITheCmdObjProc\fR, clientData, TheCmdDeleteProc);
|
||||
\fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
|
||||
.CE
|
||||
.PP
|
||||
To enable a command like this one for trampoline-based evaluation,
|
||||
@@ -255,8 +255,8 @@ int
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
return \fBTcl_NRCallObjProc\fR(interp, name,
|
||||
\fITheCmdNRObjProc\fR, clientData, objc, objv);
|
||||
return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
|
||||
clientData, objc, objv);
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
@@ -317,7 +317,7 @@ and the second is for use when there is already a trampoline in place.
|
||||
.PP
|
||||
.CS
|
||||
\fBTcl_NRCreateCommand\fR(interp, "theCommand",
|
||||
\fITheCmdObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
|
||||
\fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
|
||||
TheCmdDeleteProc);
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
|
||||
+4
-1
@@ -85,6 +85,9 @@ proc bgerror {message} {
|
||||
}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
after(n), interp(n), tclvars(n)
|
||||
after(n), errorCode(n), errorInfo(n), interp(n)
|
||||
.SH KEYWORDS
|
||||
background error, reporting
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
|
||||
+21
-5
@@ -36,6 +36,13 @@ The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
|
||||
binary data to or from string encodings such as base64 (used in MIME
|
||||
messages for example).
|
||||
.VE 8.6
|
||||
.PP
|
||||
Note that other operations on binary data, such as taking a subsequence of it,
|
||||
getting its length, or reinterpreting it as a string in some encoding, are
|
||||
done by other Tcl commands (respectively \fBstring range\fR,
|
||||
\fBstring length\fR and \fBencoding convertfrom\fR in the example cases). A
|
||||
binary string in Tcl is merely one where all the characters it contains are in
|
||||
the range \eu0000\-\eu00FF.
|
||||
.SH "BINARY ENCODE AND DECODE"
|
||||
.VS 8.6
|
||||
.PP
|
||||
@@ -95,13 +102,14 @@ between Unix systems and on USENET, but is less common these days, having been
|
||||
largely superseded by the \fBbase64\fR binary encoding.
|
||||
.RS
|
||||
.PP
|
||||
During encoding, the following options are supported:
|
||||
'\" This is wrong! The uuencode format had more complexity than this!
|
||||
During encoding, the following options are supported (though changing them may
|
||||
produce files that other implementations of decoders cannot process):
|
||||
.TP
|
||||
\fB\-maxlen \fIlength\fR
|
||||
.
|
||||
Indicates that the output should be split into lines of no more than
|
||||
\fIlength\fR characters. By default, lines are not split.
|
||||
\fIlength\fR characters. By default, lines are split every 61 characters, and
|
||||
this must be in the range 3 to 85 due to limitations in the encoding.
|
||||
.TP
|
||||
\fB\-wrapchar \fIcharacter\fR
|
||||
.
|
||||
@@ -114,7 +122,11 @@ During decoding, the following options are supported:
|
||||
.TP
|
||||
\fB\-strict\fR
|
||||
.
|
||||
Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
|
||||
Instructs the decoder to throw an error if it encounters unexpected whitespace
|
||||
characters. Otherwise it ignores them.
|
||||
.PP
|
||||
Note that neither the encoder nor the decoder handle the header and footer of
|
||||
the uuencode format.
|
||||
.RE
|
||||
.VE 8.6
|
||||
.SH "BINARY FORMAT"
|
||||
@@ -855,6 +867,7 @@ architectures, use their textual representation (as produced by
|
||||
.PP
|
||||
This is a procedure to write a Tcl string to a binary-encoded channel as
|
||||
UTF-8 data preceded by a length word:
|
||||
.PP
|
||||
.CS
|
||||
proc \fIwriteString\fR {channel string} {
|
||||
set data [encoding convertto utf-8 $string]
|
||||
@@ -865,6 +878,7 @@ proc \fIwriteString\fR {channel string} {
|
||||
.PP
|
||||
This procedure reads a string from a channel that was written by the
|
||||
previously presented \fIwriteString\fR procedure:
|
||||
.PP
|
||||
.CS
|
||||
proc \fIreadString\fR {channel} {
|
||||
if {![\fBbinary scan\fR [read $channel 4] I length]} {
|
||||
@@ -877,6 +891,7 @@ proc \fIreadString\fR {channel} {
|
||||
.PP
|
||||
This converts the contents of a file (named in the variable \fIfilename\fR) to
|
||||
base64 and prints them:
|
||||
.PP
|
||||
.CS
|
||||
set f [open $filename rb]
|
||||
set data [read $f]
|
||||
@@ -884,9 +899,10 @@ close $f
|
||||
puts [\fBbinary encode\fR base64 \-maxlen 64 $data]
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
format(n), scan(n), tclvars(n)
|
||||
encoding(n), format(n), scan(n), string(n), tcl_platform(n)
|
||||
.SH KEYWORDS
|
||||
binary, format, scan
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" fill-column: 78
|
||||
'\" End:
|
||||
|
||||
+2
-1
@@ -115,7 +115,8 @@ if { [\fBcatch\fR {open $someFile w} fid] } {
|
||||
There are more complex examples of \fBcatch\fR usage in the
|
||||
documentation for the \fBreturn\fR command.
|
||||
.SH "SEE ALSO"
|
||||
break(n), continue(n), dict(n), error(n), info(n), return(n), tclvars(n)
|
||||
break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n),
|
||||
return(n)
|
||||
.SH KEYWORDS
|
||||
catch, error, exception
|
||||
'\" Local Variables:
|
||||
|
||||
+2
-1
@@ -75,7 +75,8 @@ However, the last line would now normally be written without
|
||||
set var [linsert $var 0 {*}$args]
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n)
|
||||
catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n),
|
||||
namespace(n), subst(n), uplevel(n)
|
||||
.SH KEYWORDS
|
||||
concatenate, evaluate, script
|
||||
'\" Local Variables:
|
||||
|
||||
+1
-1
@@ -484,7 +484,7 @@ not the effective ones.
|
||||
.TP
|
||||
\fBWindows\fR\0\0\0\0
|
||||
.
|
||||
The \fbfile owned\fR subcommand currently always reports that the current user
|
||||
The \fBfile owned\fR subcommand currently always reports that the current user
|
||||
is the owner of the file, without regard for what the operating system
|
||||
believes to be true, making an ownership test useless. This issue (#3613671)
|
||||
may be fixed in a future release of Tcl.
|
||||
|
||||
+6
-6
@@ -296,7 +296,6 @@ Returns the name of the library directory in which standard Tcl
|
||||
scripts are stored.
|
||||
This is actually the value of the \fBtcl_library\fR
|
||||
variable and may be changed by setting \fBtcl_library\fR.
|
||||
See the \fBtclvars\fR manual entry for more information.
|
||||
.TP
|
||||
\fBinfo loaded \fR?\fIinterp\fR?
|
||||
.
|
||||
@@ -336,8 +335,8 @@ described in \fBOBJECT INTROSPECTION\fR below.
|
||||
.TP
|
||||
\fBinfo patchlevel\fR
|
||||
.
|
||||
Returns the value of the global variable \fBtcl_patchLevel\fR; see
|
||||
the \fBtclvars\fR manual entry for more information.
|
||||
Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
|
||||
the exact version of the Tcl library by default.
|
||||
.TP
|
||||
\fBinfo procs \fR?\fIpattern\fR?
|
||||
.
|
||||
@@ -374,8 +373,8 @@ string is returned.
|
||||
.TP
|
||||
\fBinfo tclversion\fR
|
||||
.
|
||||
Returns the value of the global variable \fBtcl_version\fR; see
|
||||
the \fBtclvars\fR manual entry for more information.
|
||||
Returns the value of the global variable \fBtcl_version\fR, which holds the
|
||||
major and minor version of the Tcl library by default.
|
||||
.TP
|
||||
\fBinfo vars\fR ?\fIpattern\fR?
|
||||
.
|
||||
@@ -763,8 +762,9 @@ proc getDef {obj method} {
|
||||
.VE 8.6
|
||||
.SH "SEE ALSO"
|
||||
.VS 8.6
|
||||
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n)
|
||||
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
|
||||
.VE 8.6
|
||||
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
|
||||
.SH KEYWORDS
|
||||
command, information, interpreter, introspection, level, namespace,
|
||||
.VS 8.6
|
||||
|
||||
+7
-3
@@ -262,13 +262,17 @@ If set to any value, then \fBunknown\fR will not attempt to auto-load
|
||||
any commands.
|
||||
.TP
|
||||
\fBauto_path\fR
|
||||
.
|
||||
If set, then it must contain a valid Tcl list giving directories to
|
||||
search during auto-load operations.
|
||||
search during auto-load operations (including for package index
|
||||
files when using the default \fBpackage unknown\fR handler).
|
||||
This variable is initialized during startup to contain, in order:
|
||||
the directories listed in the \fBTCLLIBPATH\fR environment variable,
|
||||
the directory named by the \fBtcl_library\fR variable,
|
||||
the directory named by the \fBtcl_library\fR global variable,
|
||||
the parent directory of \fBtcl_library\fR,
|
||||
the directories listed in the \fBtcl_pkgPath\fR variable.
|
||||
Additional locations to look for files and package indices should
|
||||
normally be added to this variable using \fBlappend\fR.
|
||||
.TP
|
||||
\fBenv(TCL_LIBRARY)\fR
|
||||
If set, then it specifies the location of the directory containing
|
||||
@@ -306,7 +310,7 @@ considered to be a word character. On Windows platforms, words are
|
||||
comprised of any character that is not a space, tab, or newline. Under
|
||||
Unix, words are comprised of numbers, letters or underscores.
|
||||
.SH "SEE ALSO"
|
||||
info(n), re_syntax(n), tclvars(n)
|
||||
env(n), info(n), re_syntax(n)
|
||||
.SH KEYWORDS
|
||||
auto-exec, auto-load, library, unknown, word, whitespace
|
||||
'\"Local Variables:
|
||||
|
||||
+7
-4
@@ -62,14 +62,14 @@ The method chain is cached for future use.
|
||||
When constructing the method chain, method implementations are searched for in
|
||||
the following order:
|
||||
.IP [1]
|
||||
In the object.
|
||||
.IP [2]
|
||||
In the classes mixed into the object, in class traversal order. The list of
|
||||
mixins is checked in natural order.
|
||||
.IP [3]
|
||||
.IP [2]
|
||||
In the classes mixed into the classes of the object, with sources of mixing in
|
||||
being searched in class traversal order. Within each class, the list of mixins
|
||||
is processed in natural order.
|
||||
.IP [3]
|
||||
In the object itself.
|
||||
.IP [4]
|
||||
In the object's class.
|
||||
.IP [5]
|
||||
@@ -77,7 +77,10 @@ In the superclasses of the class, following each superclass in a depth-first
|
||||
fashion in the natural order of the superclass list.
|
||||
.PP
|
||||
Any particular method implementation always comes as \fIlate\fR in the
|
||||
resulting list of implementations as possible.
|
||||
resulting list of implementations as possible; this means that if some class,
|
||||
A, is both mixed into a class, B, and is also a superclass of B, the instances
|
||||
of B will always treat A as a superclass from the perspective of inheritance.
|
||||
This is true even when the multiple inheritance is processed indirectly.
|
||||
.SS FILTERS
|
||||
.PP
|
||||
When an object has a list of filter names set upon it, or is an instance of a
|
||||
|
||||
+2
-2
@@ -317,8 +317,8 @@ proc myReturn {args} {
|
||||
}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
break(n), catch(n), continue(n), dict(n), error(n), proc(n),
|
||||
source(n), tclvars(n), throw(n), try(n)
|
||||
break(n), catch(n), continue(n), dict(n), error(n), errorCode(n),
|
||||
errorInfo(n), proc(n), source(n), throw(n), try(n)
|
||||
.SH KEYWORDS
|
||||
break, catch, continue, error, exception, procedure, result, return
|
||||
.\" Local Variables:
|
||||
|
||||
+5
-3
@@ -102,7 +102,9 @@ but also the disadvantage of making it harder to write scripts that
|
||||
start up uniformly across different versions of Tcl.
|
||||
.SH "VARIABLES"
|
||||
.PP
|
||||
\fBTclsh\fR sets the following Tcl variables:
|
||||
\fBTclsh\fR sets the following global Tcl variables in addition to those
|
||||
created by the Tcl library itself (such as \fBenv\fR, which maps
|
||||
environment variables such as \fBPATH\fR into Tcl):
|
||||
.TP 15
|
||||
\fBargc\fR
|
||||
.
|
||||
@@ -129,7 +131,7 @@ device), 0 otherwise.
|
||||
When \fBtclsh\fR is invoked interactively it normally prompts for each
|
||||
command with
|
||||
.QW "\fB% \fR" .
|
||||
You can change the prompt by setting the
|
||||
You can change the prompt by setting the global
|
||||
variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable
|
||||
\fBtcl_prompt1\fR exists then it must consist of a Tcl script
|
||||
to output a prompt; instead of outputting a prompt \fBtclsh\fR
|
||||
@@ -142,6 +144,6 @@ incomplete commands.
|
||||
.PP
|
||||
See \fBTcl_StandardChannels\fR for more explanations.
|
||||
.SH "SEE ALSO"
|
||||
encoding(n), fconfigure(n), tclvars(n)
|
||||
auto_path(n), encoding(n), env(n), fconfigure(n)
|
||||
.SH KEYWORDS
|
||||
application, argument, interpreter, prompt, script file, shell
|
||||
|
||||
+1
-1
@@ -40,7 +40,7 @@ The following produces an error that is identical to that produced by
|
||||
\fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero}
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
catch(n), error(n), return(n), tclvars(n), try(n)
|
||||
catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n)
|
||||
.SH "KEYWORDS"
|
||||
error, exception
|
||||
'\" Local Variables:
|
||||
|
||||
+1
-1
@@ -824,7 +824,7 @@ duptraverse(
|
||||
* make all normal tests (not reg-33.14) pass.
|
||||
*/
|
||||
#ifndef DUPTRAVERSE_MAX_DEPTH
|
||||
#define DUPTRAVERSE_MAX_DEPTH 700
|
||||
#define DUPTRAVERSE_MAX_DEPTH 15000
|
||||
#endif
|
||||
|
||||
if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
|
||||
|
||||
+1
-6
@@ -504,12 +504,7 @@ complicatedFindLoop(
|
||||
return er;
|
||||
}
|
||||
if ((shorter) ? end == estop : end == begin) {
|
||||
/*
|
||||
* No point in trying again.
|
||||
*/
|
||||
|
||||
*coldp = cold;
|
||||
return REG_NOMATCH;
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+2
-2
@@ -56,10 +56,10 @@ extern "C" {
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 6
|
||||
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 0
|
||||
#define TCL_RELEASE_SERIAL 1
|
||||
|
||||
#define TCL_VERSION "8.6"
|
||||
#define TCL_PATCH_LEVEL "8.6.0"
|
||||
#define TCL_PATCH_LEVEL "8.6.1"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
|
||||
+30
-11
@@ -930,6 +930,10 @@ TclCompileAssembleCmd(
|
||||
{
|
||||
Tcl_Token *tokenPtr; /* Token in the input script */
|
||||
|
||||
int numCommands = envPtr->numCommands;
|
||||
int offset = envPtr->codeNext - envPtr->codeStart;
|
||||
int depth = envPtr->currStackDepth;
|
||||
|
||||
/*
|
||||
* Make sure that the command has a single arg that is a simple word.
|
||||
*/
|
||||
@@ -943,10 +947,23 @@ TclCompileAssembleCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* Compile the code and return any error from the compilation.
|
||||
* Compile the code and convert any error from the compilation into
|
||||
* bytecode reporting the error;
|
||||
*/
|
||||
|
||||
return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
|
||||
if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
|
||||
tokenPtr[1].size, TCL_EVAL_DIRECT)) {
|
||||
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (\"%.*s\" body, line %d)",
|
||||
parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
|
||||
Tcl_GetErrorLine(interp)));
|
||||
envPtr->numCommands = numCommands;
|
||||
envPtr->codeNext = envPtr->codeStart + offset;
|
||||
envPtr->currStackDepth = depth;
|
||||
TclCompileSyntaxError(interp, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -985,8 +1002,6 @@ TclAssembleCode(
|
||||
|
||||
const char* instPtr = codePtr;
|
||||
/* Where to start looking for a line of code */
|
||||
int instLen; /* Length in bytes of the current line of
|
||||
* code */
|
||||
const char* nextPtr; /* Pointer to the end of the line of code */
|
||||
int bytesLeft = codeLen; /* Number of bytes of source code remaining to
|
||||
* be parsed */
|
||||
@@ -1000,10 +1015,6 @@ TclAssembleCode(
|
||||
*/
|
||||
|
||||
status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
|
||||
instLen = parsePtr->commandSize;
|
||||
if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
|
||||
--instLen;
|
||||
}
|
||||
|
||||
/*
|
||||
* Report errors in the parse.
|
||||
@@ -1012,7 +1023,7 @@ TclAssembleCode(
|
||||
if (status != TCL_OK) {
|
||||
if (flags & TCL_EVAL_DIRECT) {
|
||||
Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
|
||||
instLen);
|
||||
parsePtr->term + 1 - parsePtr->commandStart);
|
||||
}
|
||||
FreeAssemblyEnv(assemEnvPtr);
|
||||
return TCL_ERROR;
|
||||
@@ -1032,6 +1043,13 @@ TclAssembleCode(
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords > 0) {
|
||||
int instLen = parsePtr->commandSize;
|
||||
/* Length in bytes of the current command */
|
||||
|
||||
if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
|
||||
--instLen;
|
||||
}
|
||||
|
||||
/*
|
||||
* If tracing, show each line assembled as it happens.
|
||||
*/
|
||||
@@ -1107,7 +1125,7 @@ NewAssemblyEnv(
|
||||
|
||||
assemEnvPtr->envPtr = envPtr;
|
||||
assemEnvPtr->parsePtr = parsePtr;
|
||||
assemEnvPtr->cmdLine = envPtr->line;
|
||||
assemEnvPtr->cmdLine = 1;
|
||||
assemEnvPtr->clNext = envPtr->clNext;
|
||||
|
||||
/*
|
||||
@@ -2599,6 +2617,7 @@ AllocBB(
|
||||
bb->minStackDepth = 0;
|
||||
bb->maxStackDepth = 0;
|
||||
bb->finalStackDepth = 0;
|
||||
bb->catchDepth = 0;
|
||||
bb->enclosingCatch = NULL;
|
||||
bb->foreignExceptionBase = -1;
|
||||
bb->foreignExceptionCount = 0;
|
||||
@@ -3029,7 +3048,7 @@ ResolveJumpTableTargets(
|
||||
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
|
||||
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
|
||||
bbPtr, bbPtr->jumpOffset, auxDataIndex);
|
||||
realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
|
||||
realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
|
||||
realJumpHashPtr = &realJumpTablePtr->hashTable;
|
||||
|
||||
/*
|
||||
|
||||
+346
-467
File diff suppressed because it is too large
Load Diff
+251
-55
@@ -87,10 +87,13 @@ static int BinaryDecodeHex(ClientData clientData,
|
||||
static int BinaryEncode64(ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int BinaryDecodeUu(ClientData clientData,
|
||||
static int BinaryDecode64(ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
static int BinaryDecode64(ClientData clientData,
|
||||
static int BinaryEncodeUu(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int BinaryDecodeUu(ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
@@ -139,9 +142,9 @@ static const EnsembleImplMap binaryMap[] = {
|
||||
{ NULL, NULL, NULL, NULL, NULL, 0 }
|
||||
};
|
||||
static const EnsembleImplMap encodeMap[] = {
|
||||
{ "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, (ClientData)HexDigits, 0 },
|
||||
{ "uuencode", BinaryEncode64, NULL, NULL, (ClientData)UueDigits, 0 },
|
||||
{ "base64", BinaryEncode64, NULL, NULL, (ClientData)B64Digits, 0 },
|
||||
{ "hex", BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
|
||||
{ "uuencode", BinaryEncodeUu, NULL, NULL, NULL, 0 },
|
||||
{ "base64", BinaryEncode64, NULL, NULL, NULL, 0 },
|
||||
{ NULL, NULL, NULL, NULL, NULL, 0 }
|
||||
};
|
||||
static const EnsembleImplMap decodeMap[] = {
|
||||
@@ -2312,7 +2315,6 @@ BinaryEncodeHex(
|
||||
Tcl_Obj *resultObj = NULL;
|
||||
unsigned char *data = NULL;
|
||||
unsigned char *cursor = NULL;
|
||||
const char *digits = clientData;
|
||||
int offset = 0, count = 0;
|
||||
|
||||
if (objc != 2) {
|
||||
@@ -2324,8 +2326,8 @@ BinaryEncodeHex(
|
||||
data = Tcl_GetByteArrayFromObj(objv[1], &count);
|
||||
cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
|
||||
for (offset = 0; offset < count; ++offset) {
|
||||
*cursor++ = digits[((data[offset] >> 4) & 0x0f)];
|
||||
*cursor++ = digits[(data[offset] & 0x0f)];
|
||||
*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
|
||||
*cursor++ = HexDigits[(data[offset] & 0x0f)];
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -2386,29 +2388,32 @@ BinaryDecodeHex(
|
||||
while (data < dataend) {
|
||||
value = 0;
|
||||
for (i=0 ; i<2 ; i++) {
|
||||
if (data < dataend) {
|
||||
c = *data++;
|
||||
|
||||
if (!isxdigit((int) c)) {
|
||||
if (strict || !isspace(c)) {
|
||||
goto badChar;
|
||||
}
|
||||
i--;
|
||||
continue;
|
||||
}
|
||||
if (data >= dataend) {
|
||||
value <<= 4;
|
||||
c -= '0';
|
||||
if (c > 9) {
|
||||
c += ('0' - 'A') + 10;
|
||||
}
|
||||
if (c > 16) {
|
||||
c += ('A' - 'a');
|
||||
}
|
||||
value |= (c & 0xf);
|
||||
} else {
|
||||
value <<= 4;
|
||||
cut++;
|
||||
break;
|
||||
}
|
||||
|
||||
c = *data++;
|
||||
if (!isxdigit((int) c)) {
|
||||
if (strict || !isspace(c)) {
|
||||
goto badChar;
|
||||
}
|
||||
i--;
|
||||
continue;
|
||||
}
|
||||
|
||||
value <<= 4;
|
||||
c -= '0';
|
||||
if (c > 9) {
|
||||
c += ('0' - 'A') + 10;
|
||||
}
|
||||
if (c > 16) {
|
||||
c += ('A' - 'a');
|
||||
}
|
||||
value |= (c & 0xf);
|
||||
}
|
||||
if (i < 2) {
|
||||
cut++;
|
||||
}
|
||||
*cursor++ = UCHAR(value);
|
||||
value = 0;
|
||||
@@ -2436,7 +2441,7 @@ BinaryDecodeHex(
|
||||
* This implements a generic 6 bit binary encoding. Input is broken into
|
||||
* 6 bit chunks and a lookup table passed in via clientData is used to
|
||||
* turn these values into output characters. This is used to implement
|
||||
* base64 and uuencode binary encodings.
|
||||
* base64 binary encodings.
|
||||
*
|
||||
* Results:
|
||||
* Interp result set to an encoded byte array object
|
||||
@@ -2472,7 +2477,6 @@ BinaryEncode64(
|
||||
{
|
||||
Tcl_Obj *resultObj;
|
||||
unsigned char *data, *cursor, *limit;
|
||||
const char *digits = clientData;
|
||||
int maxlen = 0;
|
||||
const char *wrapchar = "\n";
|
||||
int wrapcharlen = 1;
|
||||
@@ -2495,6 +2499,12 @@ BinaryEncode64(
|
||||
if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (maxlen < 0) {
|
||||
Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
|
||||
Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
|
||||
"LINE_LENGTH", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
case OPT_WRAPCHAR:
|
||||
wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
|
||||
@@ -2525,17 +2535,17 @@ BinaryEncode64(
|
||||
for (i = 0; i < 3 && offset+i < count; ++i) {
|
||||
d[i] = data[offset + i];
|
||||
}
|
||||
OUTPUT(digits[d[0] >> 2]);
|
||||
OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
|
||||
OUTPUT(B64Digits[d[0] >> 2]);
|
||||
OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
|
||||
if (offset+1 < count) {
|
||||
OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
|
||||
OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
|
||||
} else {
|
||||
OUTPUT(digits[64]);
|
||||
OUTPUT(B64Digits[64]);
|
||||
}
|
||||
if (offset+2 < count) {
|
||||
OUTPUT(digits[d[2] & 0x3f]);
|
||||
OUTPUT(B64Digits[d[2] & 0x3f]);
|
||||
} else {
|
||||
OUTPUT(digits[64]);
|
||||
OUTPUT(B64Digits[64]);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -2544,6 +2554,124 @@ BinaryEncode64(
|
||||
}
|
||||
#undef OUTPUT
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* BinaryEncodeUu --
|
||||
*
|
||||
* This implements the uuencode binary encoding. Input is broken into 6
|
||||
* bit chunks and a lookup table is used to turn these values into output
|
||||
* characters. This differs from the generic code above in that line
|
||||
* lengths are also encoded.
|
||||
*
|
||||
* Results:
|
||||
* Interp result set to an encoded byte array object
|
||||
*
|
||||
* Side effects:
|
||||
* None
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
BinaryEncodeUu(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Tcl_Obj *resultObj;
|
||||
unsigned char *data, *start, *cursor;
|
||||
int offset, count, rawLength, n, i, j, bits, index;
|
||||
int lineLength = 61;
|
||||
const unsigned char SingleNewline[] = { (unsigned char) '\n' };
|
||||
const unsigned char *wrapchar = SingleNewline;
|
||||
int wrapcharlen = sizeof(SingleNewline);
|
||||
enum { OPT_MAXLEN, OPT_WRAPCHAR };
|
||||
static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
|
||||
|
||||
if (objc < 2 || objc%2 != 0) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"?-maxlen len? ?-wrapchar char? data");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
for (i = 1; i < objc-1; i += 2) {
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
|
||||
TCL_EXACT, &index) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
switch (index) {
|
||||
case OPT_MAXLEN:
|
||||
if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (lineLength < 3 || lineLength > 85) {
|
||||
Tcl_SetResult(interp, "line length out of range", TCL_STATIC);
|
||||
Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
|
||||
"LINE_LENGTH", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
case OPT_WRAPCHAR:
|
||||
wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Allocate the buffer. This is a little bit too long, but is "good
|
||||
* enough".
|
||||
*/
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
offset = 0;
|
||||
data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
|
||||
rawLength = (lineLength - 1) * 3 / 4;
|
||||
start = cursor = Tcl_SetByteArrayLength(resultObj,
|
||||
(lineLength + wrapcharlen) *
|
||||
((count + (rawLength - 1)) / rawLength));
|
||||
n = bits = 0;
|
||||
|
||||
/*
|
||||
* Encode the data. Each output line first has the length of raw data
|
||||
* encoded by the output line described in it by one encoded byte, then
|
||||
* the encoded data follows (encoding each 6 bits as one character).
|
||||
* Encoded lines are always terminated by a newline.
|
||||
*/
|
||||
|
||||
while (offset < count) {
|
||||
int lineLen = count - offset;
|
||||
|
||||
if (lineLen > rawLength) {
|
||||
lineLen = rawLength;
|
||||
}
|
||||
*cursor++ = UueDigits[lineLen];
|
||||
for (i=0 ; i<lineLen ; i++) {
|
||||
n <<= 8;
|
||||
n |= data[offset++];
|
||||
for (bits += 8; bits > 6 ; bits -= 6) {
|
||||
*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
|
||||
}
|
||||
}
|
||||
if (bits > 0) {
|
||||
n <<= 8;
|
||||
*cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
|
||||
bits = 0;
|
||||
}
|
||||
for (j=0 ; j<wrapcharlen ; ++j) {
|
||||
*cursor++ = wrapchar[j];
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Fix the length of the output bytearray.
|
||||
*/
|
||||
|
||||
Tcl_SetByteArrayLength(resultObj, cursor-start);
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2570,8 +2698,8 @@ BinaryDecodeUu(
|
||||
Tcl_Obj *resultObj = NULL;
|
||||
unsigned char *data, *datastart, *dataend;
|
||||
unsigned char *begin, *cursor;
|
||||
int i, index, size, count = 0, cut = 0, strict = 0;
|
||||
char c;
|
||||
int i, index, size, count = 0, strict = 0, lineLen;
|
||||
unsigned char c;
|
||||
enum {OPT_STRICT };
|
||||
static const char *const optStrings[] = { "-strict", NULL };
|
||||
|
||||
@@ -2597,44 +2725,112 @@ BinaryDecodeUu(
|
||||
dataend = data + count;
|
||||
size = ((count + 3) & ~3) * 3 / 4;
|
||||
begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
|
||||
lineLen = -1;
|
||||
|
||||
/*
|
||||
* The decoding loop. First, we get the length of line (strictly, the
|
||||
* number of data bytes we expect to generate from the line) we're
|
||||
* processing this time round if it is not already known (i.e., when the
|
||||
* lineLen variable is set to the magic value, -1).
|
||||
*/
|
||||
|
||||
while (data < dataend) {
|
||||
char d[4] = {0, 0, 0, 0};
|
||||
|
||||
if (lineLen < 0) {
|
||||
c = *data++;
|
||||
if (c < 32 || c > 96) {
|
||||
if (strict || !isspace(c)) {
|
||||
goto badUu;
|
||||
}
|
||||
i--;
|
||||
continue;
|
||||
}
|
||||
lineLen = (c - 32) & 0x3f;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now we read a four-character grouping.
|
||||
*/
|
||||
|
||||
for (i=0 ; i<4 ; i++) {
|
||||
if (data < dataend) {
|
||||
d[i] = c = *data++;
|
||||
if (c < 33 || c > 96) {
|
||||
if (strict || !isspace(UCHAR(c))) {
|
||||
goto badUu;
|
||||
if (c < 32 || c > 96) {
|
||||
if (strict) {
|
||||
if (!isspace(c)) {
|
||||
goto badUu;
|
||||
} else if (c == '\n') {
|
||||
goto shortUu;
|
||||
}
|
||||
}
|
||||
i--;
|
||||
continue;
|
||||
}
|
||||
} else {
|
||||
cut++;
|
||||
}
|
||||
}
|
||||
if (cut > 3) {
|
||||
cut = 3;
|
||||
|
||||
/*
|
||||
* Translate that grouping into (up to) three binary bytes output.
|
||||
*/
|
||||
|
||||
if (lineLen > 0) {
|
||||
*cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
|
||||
| (((d[1] - 0x20) & 0x3f) >> 4);
|
||||
if (--lineLen > 0) {
|
||||
*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
|
||||
| (((d[2] - 0x20) & 0x3f) >> 2);
|
||||
if (--lineLen > 0) {
|
||||
*cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
|
||||
| (((d[3] - 0x20) & 0x3f));
|
||||
lineLen--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* If we've reached the end of the line, skip until we process a
|
||||
* newline.
|
||||
*/
|
||||
|
||||
if (lineLen == 0 && data < dataend) {
|
||||
lineLen = -1;
|
||||
do {
|
||||
c = *data++;
|
||||
if (c == '\n') {
|
||||
break;
|
||||
} else if (c >= 32 && c <= 96) {
|
||||
data--;
|
||||
break;
|
||||
} else if (strict || !isspace(c)) {
|
||||
goto badUu;
|
||||
}
|
||||
} while (data < dataend);
|
||||
}
|
||||
*cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
|
||||
| (((d[1] - 0x20) & 0x3f) >> 4);
|
||||
*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
|
||||
| (((d[2] - 0x20) & 0x3f) >> 2);
|
||||
*cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
|
||||
| (((d[3] - 0x20) & 0x3f));
|
||||
}
|
||||
if (cut > size) {
|
||||
cut = size;
|
||||
|
||||
/*
|
||||
* Sanity check, clean up and finish.
|
||||
*/
|
||||
|
||||
if (lineLen > 0 && strict) {
|
||||
goto shortUu;
|
||||
}
|
||||
Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
|
||||
Tcl_SetByteArrayLength(resultObj, cursor - begin);
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
|
||||
shortUu:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
|
||||
Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
|
||||
TclDecrRefCount(resultObj);
|
||||
return TCL_ERROR;
|
||||
|
||||
badUu:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"invalid uuencode character \"%c\" at position %d",
|
||||
c, (int) (data - datastart - 1)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
|
||||
TclDecrRefCount(resultObj);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
+8
-26
@@ -1302,28 +1302,12 @@ TclInfoFrame(
|
||||
*/
|
||||
|
||||
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
|
||||
ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
|
||||
ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
|
||||
framePtr->cmd.str.len));
|
||||
break;
|
||||
|
||||
case TCL_LOCATION_EVAL_LIST:
|
||||
/*
|
||||
* List optimized evaluation. Type, line, cmd, the latter through
|
||||
* listPtr, possibly a frame.
|
||||
*/
|
||||
|
||||
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
|
||||
ADD_PAIR("line", Tcl_NewIntObj(1));
|
||||
|
||||
/*
|
||||
* We put a duplicate of the command list obj into the result to
|
||||
* ensure that the 'pure List'-property of the command itself is not
|
||||
* destroyed. Otherwise the query here would disable the list
|
||||
* optimization path in Tcl_EvalObjEx.
|
||||
*/
|
||||
|
||||
ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
|
||||
if (framePtr->line) {
|
||||
ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
|
||||
} else {
|
||||
ADD_PAIR("line", Tcl_NewIntObj(1));
|
||||
}
|
||||
ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
|
||||
break;
|
||||
|
||||
case TCL_LOCATION_PREBC:
|
||||
@@ -1371,8 +1355,7 @@ TclInfoFrame(
|
||||
Tcl_DecrRefCount(fPtr->data.eval.path);
|
||||
}
|
||||
|
||||
ADD_PAIR("cmd",
|
||||
Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
|
||||
ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
|
||||
TclStackFree(interp, fPtr);
|
||||
break;
|
||||
}
|
||||
@@ -1391,8 +1374,7 @@ TclInfoFrame(
|
||||
* the result list object.
|
||||
*/
|
||||
|
||||
ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
|
||||
framePtr->cmd.str.len));
|
||||
ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
|
||||
break;
|
||||
|
||||
case TCL_LOCATION_PROC:
|
||||
|
||||
+44
-66
@@ -87,6 +87,7 @@ TclCompileAppendCmd(
|
||||
int isScalar, localIndex, numWords, i;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
numWords = parsePtr->numWords;
|
||||
if (numWords == 1) {
|
||||
return TCL_ERROR;
|
||||
@@ -544,7 +545,6 @@ TclCompileCatchCmd(
|
||||
JumpFixup jumpFixup;
|
||||
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
|
||||
int resultIndex, optsIndex, range;
|
||||
int initStackDepth = envPtr->currStackDepth;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/*
|
||||
@@ -610,12 +610,12 @@ TclCompileCatchCmd(
|
||||
* begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
|
||||
*/
|
||||
|
||||
SetLineInformation(1);
|
||||
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
CompileBody(envPtr, cmdTokenPtr, interp);
|
||||
BODY(cmdTokenPtr, 1);
|
||||
} else {
|
||||
SetLineInformation(1);
|
||||
CompileTokens(envPtr, cmdTokenPtr, interp);
|
||||
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
@@ -742,15 +742,6 @@ TclCompileCatchCmd(
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Result of all this, on either branch, should have been to leave one
|
||||
* operand -- the return code -- on the stack.
|
||||
*/
|
||||
|
||||
if (envPtr->currStackDepth != initStackDepth + 1) {
|
||||
Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
|
||||
envPtr->currStackDepth, initStackDepth+1);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -848,7 +839,7 @@ TclCompileDictSetCmd(
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
int numWords, i, dictVarIndex;
|
||||
int i, dictVarIndex;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Token *varTokenPtr;
|
||||
|
||||
@@ -877,8 +868,7 @@ TclCompileDictSetCmd(
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(varTokenPtr);
|
||||
numWords = parsePtr->numWords-1;
|
||||
for (i=1 ; i<numWords ; i++) {
|
||||
for (i=2 ; i< parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
@@ -887,7 +877,7 @@ TclCompileDictSetCmd(
|
||||
* Now emit the instruction to do the dict manipulation.
|
||||
*/
|
||||
|
||||
TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr);
|
||||
TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3, envPtr);
|
||||
TclEmitInt4( dictVarIndex, envPtr);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
return TCL_OK;
|
||||
@@ -959,7 +949,7 @@ TclCompileDictIncrCmd(
|
||||
* Emit the key and the code to actually do the increment.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, keyTokenPtr, interp, 3);
|
||||
CompileWord(envPtr, keyTokenPtr, interp, 2);
|
||||
TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr);
|
||||
TclEmitInt4( dictVarIndex, envPtr);
|
||||
return TCL_OK;
|
||||
@@ -975,7 +965,7 @@ TclCompileDictGetCmd(
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
int numWords, i;
|
||||
int i;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/*
|
||||
@@ -983,21 +973,21 @@ TclCompileDictGetCmd(
|
||||
* case is legal, but too special and magic for us to deal with here).
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
numWords = parsePtr->numWords-1;
|
||||
|
||||
/*
|
||||
* Only compile this because we need INST_DICT_GET anyway.
|
||||
*/
|
||||
|
||||
for (i=0 ; i<numWords ; i++) {
|
||||
for (i=1 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr);
|
||||
TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1012,7 +1002,7 @@ TclCompileDictExistsCmd(
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
int numWords, i;
|
||||
int i;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/*
|
||||
@@ -1020,21 +1010,21 @@ TclCompileDictExistsCmd(
|
||||
* case is legal, but too special and magic for us to deal with here).
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
numWords = parsePtr->numWords-1;
|
||||
|
||||
/*
|
||||
* Now we do the code generation.
|
||||
*/
|
||||
|
||||
for (i=0 ; i<numWords ; i++) {
|
||||
for (i=1 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr);
|
||||
TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1057,6 +1047,7 @@ TclCompileDictUnsetCmd(
|
||||
* compile to bytecode.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1202,6 +1193,7 @@ TclCompileDictMergeCmd(
|
||||
* argument, the only thing to do is to verify the dict-ness.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. (less likely) */
|
||||
if (parsePtr->numWords < 2) {
|
||||
PushStringLiteral(envPtr, "");
|
||||
return TCL_OK;
|
||||
@@ -1431,7 +1423,7 @@ CompileDictEachCmd(
|
||||
* this point.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, dictTokenPtr, interp, 3);
|
||||
CompileWord(envPtr, dictTokenPtr, interp, 2);
|
||||
|
||||
/*
|
||||
* Now we catch errors from here on so that we can finalize the search
|
||||
@@ -1467,8 +1459,7 @@ CompileDictEachCmd(
|
||||
* Compile the loop body itself. It should be stack-neutral.
|
||||
*/
|
||||
|
||||
SetLineInformation(3);
|
||||
CompileBody(envPtr, bodyTokenPtr, interp);
|
||||
BODY(bodyTokenPtr, 3);
|
||||
if (collect == TCL_EACH_COLLECT) {
|
||||
Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr);
|
||||
TclEmitInstInt4(INST_OVER, 1, envPtr);
|
||||
@@ -1641,7 +1632,7 @@ TclCompileDictUpdateCmd(
|
||||
infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
|
||||
|
||||
for (i=0 ; i<numVars ; i++) {
|
||||
CompileWord(envPtr, keyTokenPtrs[i], interp, i);
|
||||
CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, numVars, envPtr);
|
||||
TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
|
||||
@@ -1651,8 +1642,7 @@ TclCompileDictUpdateCmd(
|
||||
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
|
||||
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
SetLineInformation(parsePtr->numWords - 1);
|
||||
CompileBody(envPtr, bodyTokenPtr, interp);
|
||||
BODY(bodyTokenPtr, parsePtr->numWords - 1);
|
||||
ExceptionRangeEnds(envPtr, range);
|
||||
|
||||
/*
|
||||
@@ -1724,6 +1714,7 @@ TclCompileDictAppendCmd(
|
||||
* speed quite so much. ;-)
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords<4 || parsePtr->numWords>100) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1776,6 +1767,8 @@ TclCompileDictLappendCmd(
|
||||
* There must be three arguments after the command.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
/* Probably not. Why is INST_DICT_LAPPEND limited to one value? */
|
||||
if (parsePtr->numWords != 4) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1796,8 +1789,8 @@ TclCompileDictLappendCmd(
|
||||
* Issue the implementation.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, keyTokenPtr, interp, 3);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 4);
|
||||
CompileWord(envPtr, keyTokenPtr, interp, 2);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 3);
|
||||
TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1822,6 +1815,7 @@ TclCompileDictWithCmd(
|
||||
* There must be at least one argument after the command.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1881,7 +1875,7 @@ TclCompileDictWithCmd(
|
||||
|
||||
tokenPtr = TokenAfter(varTokenPtr);
|
||||
for (i=2 ; i<parsePtr->numWords-1 ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i-1);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
|
||||
@@ -1908,7 +1902,7 @@ TclCompileDictWithCmd(
|
||||
|
||||
tokenPtr = varTokenPtr;
|
||||
for (i=1 ; i<parsePtr->numWords-1 ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i-1);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
|
||||
@@ -1922,7 +1916,7 @@ TclCompileDictWithCmd(
|
||||
* Case: Direct dict in non-simple var with empty body.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, varTokenPtr, interp, 0);
|
||||
CompileWord(envPtr, varTokenPtr, interp, 1);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LOAD_STK, envPtr);
|
||||
PushStringLiteral(envPtr, "");
|
||||
@@ -1957,13 +1951,13 @@ TclCompileDictWithCmd(
|
||||
*/
|
||||
|
||||
if (dictVar == -1) {
|
||||
CompileWord(envPtr, varTokenPtr, interp, 0);
|
||||
CompileWord(envPtr, varTokenPtr, interp, 1);
|
||||
Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr);
|
||||
}
|
||||
tokenPtr = TokenAfter(varTokenPtr);
|
||||
if (gotPath) {
|
||||
for (i=2 ; i<parsePtr->numWords-1 ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i-1);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr);
|
||||
@@ -1992,8 +1986,7 @@ TclCompileDictWithCmd(
|
||||
TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr);
|
||||
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
SetLineInformation(parsePtr->numWords-1);
|
||||
CompileBody(envPtr, tokenPtr, interp);
|
||||
BODY(tokenPtr, parsePtr->numWords - 1);
|
||||
ExceptionRangeEnds(envPtr, range);
|
||||
|
||||
/*
|
||||
@@ -2232,7 +2225,7 @@ TclCompileForCmd(
|
||||
{
|
||||
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
|
||||
JumpFixup jumpEvalCondFixup;
|
||||
int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
|
||||
int bodyCodeOffset, nextCodeOffset, jumpDist;
|
||||
int bodyRange, nextRange;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
@@ -2268,8 +2261,7 @@ TclCompileForCmd(
|
||||
* Inline compile the initial command.
|
||||
*/
|
||||
|
||||
SetLineInformation(1);
|
||||
CompileBody(envPtr, startTokenPtr, interp);
|
||||
BODY(startTokenPtr, 1);
|
||||
TclEmitOpcode(INST_POP, envPtr);
|
||||
|
||||
/*
|
||||
@@ -2292,8 +2284,7 @@ TclCompileForCmd(
|
||||
|
||||
bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
|
||||
bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
|
||||
SetLineInformation(4);
|
||||
CompileBody(envPtr, bodyTokenPtr, interp);
|
||||
BODY(bodyTokenPtr, 4);
|
||||
ExceptionRangeEnds(envPtr, bodyRange);
|
||||
TclEmitOpcode(INST_POP, envPtr);
|
||||
|
||||
@@ -2306,8 +2297,7 @@ TclCompileForCmd(
|
||||
nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
|
||||
envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
|
||||
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
|
||||
SetLineInformation(3);
|
||||
CompileBody(envPtr, nextTokenPtr, interp);
|
||||
BODY(nextTokenPtr, 3);
|
||||
ExceptionRangeEnds(envPtr, nextRange);
|
||||
TclEmitOpcode(INST_POP, envPtr);
|
||||
|
||||
@@ -2316,13 +2306,9 @@ TclCompileForCmd(
|
||||
* terminates the for.
|
||||
*/
|
||||
|
||||
testCodeOffset = CurrentOffset(envPtr);
|
||||
|
||||
jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
|
||||
if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
|
||||
if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
|
||||
bodyCodeOffset += 3;
|
||||
nextCodeOffset += 3;
|
||||
testCodeOffset += 3;
|
||||
}
|
||||
|
||||
SetLineInformation(2);
|
||||
@@ -2542,7 +2528,7 @@ CompileEachloopCmd(
|
||||
|
||||
Tcl_DStringInit(&varList);
|
||||
TclDStringAppendToken(&varList, &tokenPtr[1]);
|
||||
code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
|
||||
code = Tcl_SplitList(NULL, Tcl_DStringValue(&varList),
|
||||
&varcList[loopIndex], &varvList[loopIndex]);
|
||||
Tcl_DStringFree(&varList);
|
||||
if (code != TCL_OK) {
|
||||
@@ -2644,8 +2630,7 @@ CompileEachloopCmd(
|
||||
i < numWords-1;
|
||||
i++, tokenPtr = TokenAfter(tokenPtr)) {
|
||||
if ((i%2 == 0) && (i > 0)) {
|
||||
SetLineInformation(i);
|
||||
CompileTokens(envPtr, tokenPtr, interp);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tempVar = (firstValueTemp + loopIndex);
|
||||
Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
@@ -2682,9 +2667,8 @@ CompileEachloopCmd(
|
||||
* Inline compile the loop body.
|
||||
*/
|
||||
|
||||
SetLineInformation(numWords - 1);
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
CompileBody(envPtr, bodyTokenPtr, interp);
|
||||
BODY(bodyTokenPtr, numWords - 1);
|
||||
ExceptionRangeEnds(envPtr, range);
|
||||
|
||||
if (collect == TCL_EACH_COLLECT) {
|
||||
@@ -2986,7 +2970,8 @@ TclCompileFormatCmd(
|
||||
ckfree(objv);
|
||||
Tcl_DecrRefCount(formatObj);
|
||||
if (tmpObj == NULL) {
|
||||
return TCL_ERROR;
|
||||
TclCompileSyntaxError(interp, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3164,10 +3149,7 @@ TclPushVarName(
|
||||
CompileEnv *envPtr, /* Holds resulting instructions. */
|
||||
int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
|
||||
int *localIndexPtr, /* Must not be NULL. */
|
||||
int *isScalarPtr, /* Must not be NULL. */
|
||||
int line, /* Line the token starts on. */
|
||||
int *clNext) /* Reference to offset of next hidden cont.
|
||||
* line. */
|
||||
int *isScalarPtr) /* Must not be NULL. */
|
||||
{
|
||||
register const char *p;
|
||||
const char *name, *elName;
|
||||
@@ -3347,8 +3329,6 @@ TclPushVarName(
|
||||
|
||||
if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
|
||||
if (elNameChars) {
|
||||
envPtr->line = line;
|
||||
envPtr->clNext = clNext;
|
||||
TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
|
||||
envPtr);
|
||||
} else {
|
||||
@@ -3360,8 +3340,6 @@ TclPushVarName(
|
||||
* The var name isn't simple: compile and push it.
|
||||
*/
|
||||
|
||||
envPtr->line = line;
|
||||
envPtr->clNext = clNext;
|
||||
CompileTokens(envPtr, varTokenPtr, interp);
|
||||
}
|
||||
|
||||
|
||||
+28
-19
@@ -60,6 +60,7 @@ TclCompileGlobalCmd(
|
||||
int localIndex, numWords, i;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
numWords = parsePtr->numWords;
|
||||
if (numWords < 2) {
|
||||
return TCL_ERROR;
|
||||
@@ -84,14 +85,17 @@ TclCompileGlobalCmd(
|
||||
*/
|
||||
|
||||
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
for (i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
|
||||
for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
|
||||
localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
|
||||
|
||||
if (localIndex < 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
CompileWord(envPtr, varTokenPtr, interp, 1);
|
||||
/* TODO: Consider what value can pass throug the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
|
||||
}
|
||||
|
||||
@@ -264,8 +268,7 @@ TclCompileIfCmd(
|
||||
*/
|
||||
|
||||
if (compileScripts) {
|
||||
SetLineInformation(wordIdx);
|
||||
CompileBody(envPtr, tokenPtr, interp);
|
||||
BODY(tokenPtr, wordIdx);
|
||||
}
|
||||
|
||||
if (realCond) {
|
||||
@@ -345,8 +348,7 @@ TclCompileIfCmd(
|
||||
* Compile the else command body.
|
||||
*/
|
||||
|
||||
SetLineInformation(wordIdx);
|
||||
CompileBody(envPtr, tokenPtr, interp);
|
||||
BODY(tokenPtr, wordIdx);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -585,6 +587,7 @@ TclCompileInfoCommandsCmd(
|
||||
* that the result needs to be list-ified.
|
||||
*/
|
||||
|
||||
/* TODO: Just push the known value */
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
@@ -701,8 +704,7 @@ TclCompileInfoLevelCmd(
|
||||
* list of arguments.
|
||||
*/
|
||||
|
||||
SetLineInformation(1);
|
||||
CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp);
|
||||
CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
|
||||
TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -823,6 +825,7 @@ TclCompileLappendCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
numWords = parsePtr->numWords;
|
||||
if (numWords == 1) {
|
||||
return TCL_ERROR;
|
||||
@@ -1064,6 +1067,7 @@ TclCompileLindexCmd(
|
||||
* Quit if too few args.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (numWords <= 1) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1586,6 +1590,7 @@ TclCompileLsetCmd(
|
||||
* Check argument count.
|
||||
*/
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
/*
|
||||
* Fail at run time, not in compilation.
|
||||
@@ -1898,13 +1903,13 @@ TclCompileNamespaceUpvarCmd(
|
||||
*/
|
||||
|
||||
localTokenPtr = tokenPtr;
|
||||
for (i=3; i<=numWords; i+=2) {
|
||||
for (i=2; i<numWords; i+=2) {
|
||||
otherTokenPtr = TokenAfter(localTokenPtr);
|
||||
localTokenPtr = TokenAfter(otherTokenPtr);
|
||||
|
||||
CompileWord(envPtr, otherTokenPtr, interp, 1);
|
||||
CompileWord(envPtr, otherTokenPtr, interp, i);
|
||||
PushVarNameWord(interp, localTokenPtr, envPtr, 0,
|
||||
&localIndex, &isScalar, 1);
|
||||
&localIndex, &isScalar, i+1);
|
||||
|
||||
if ((localIndex < 0) || !isScalar) {
|
||||
return TCL_ERROR;
|
||||
@@ -2534,6 +2539,7 @@ TclCompileSyntaxError(
|
||||
TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
|
||||
TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2566,16 +2572,14 @@ TclCompileUpvarCmd(
|
||||
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
|
||||
int isScalar, localIndex, numWords, i;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
if (envPtr->procPtr == NULL) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
numWords = parsePtr->numWords;
|
||||
if (numWords < 3) {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -2583,6 +2587,7 @@ TclCompileUpvarCmd(
|
||||
* Push the frame index if it is known at compile time
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
|
||||
CallFrame *framePtr;
|
||||
@@ -2601,16 +2606,17 @@ TclCompileUpvarCmd(
|
||||
if (numWords%2) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/* TODO: Push the known value instead? */
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
otherTokenPtr = TokenAfter(tokenPtr);
|
||||
i = 4;
|
||||
i = 2;
|
||||
} else {
|
||||
if (!(numWords%2)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
PushStringLiteral(envPtr, "1");
|
||||
otherTokenPtr = tokenPtr;
|
||||
i = 3;
|
||||
i = 1;
|
||||
}
|
||||
} else {
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
@@ -2623,12 +2629,12 @@ TclCompileUpvarCmd(
|
||||
* be called at runtime.
|
||||
*/
|
||||
|
||||
for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
|
||||
for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
|
||||
localTokenPtr = TokenAfter(otherTokenPtr);
|
||||
|
||||
CompileWord(envPtr, otherTokenPtr, interp, 1);
|
||||
CompileWord(envPtr, otherTokenPtr, interp, i);
|
||||
PushVarNameWord(interp, localTokenPtr, envPtr, 0,
|
||||
&localIndex, &isScalar, 1);
|
||||
&localIndex, &isScalar, i+1);
|
||||
|
||||
if ((localIndex < 0) || !isScalar) {
|
||||
return TCL_ERROR;
|
||||
@@ -2704,6 +2710,9 @@ TclCompileVariableCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Consider what value can pass throug the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
|
||||
|
||||
|
||||
+78
-33
@@ -85,8 +85,6 @@ const AuxDataType tclJumptableInfoType = {
|
||||
TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
|
||||
#define OP44(name,val1,val2) \
|
||||
TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
|
||||
#define BODY(token,index) \
|
||||
SetLineInformation((index));CompileBody(envPtr,(token),interp)
|
||||
#define PUSH(str) \
|
||||
PushStringLiteral(envPtr, str)
|
||||
#define JUMP4(name,var) \
|
||||
@@ -745,6 +743,9 @@ TclSubstCompile(
|
||||
Tcl_InterpState state = NULL;
|
||||
|
||||
TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
|
||||
if (state != NULL) {
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
|
||||
/*
|
||||
* Tricky point! If the first token does not result in a *guaranteed* push
|
||||
@@ -990,9 +991,6 @@ TclSubstCompile(
|
||||
* Instructions are added to envPtr to execute the "switch" command at
|
||||
* runtime.
|
||||
*
|
||||
* FIXME:
|
||||
* Stack depths are probably not calculated correctly.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
@@ -1284,8 +1282,7 @@ TclCompileSwitchCmd(
|
||||
*/
|
||||
|
||||
/* Both methods push the value to match against onto the stack. */
|
||||
SetLineInformation(valueIndex);
|
||||
CompileTokens(envPtr, valueTokenPtr, interp);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
|
||||
|
||||
if (mode == Switch_Exact) {
|
||||
IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
|
||||
@@ -1499,7 +1496,7 @@ IssueSwitchChainedTests(
|
||||
}
|
||||
|
||||
/*
|
||||
* Now do the actual compilation. Note that we do not use CompileBody
|
||||
* Now do the actual compilation. Note that we do not use BODY()
|
||||
* because we may have synthesized the tokens in a non-standard
|
||||
* pattern.
|
||||
*/
|
||||
@@ -1867,6 +1864,7 @@ TclCompileTailcallCmd(
|
||||
}
|
||||
|
||||
/* make room for the nsObjPtr */
|
||||
/* TODO: Doesn't this have to be a known value? */
|
||||
CompileWord(envPtr, tokenPtr, interp, 0);
|
||||
for (i=1 ; i<parsePtr->numWords ; i++) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
@@ -2817,38 +2815,81 @@ TclCompileUnsetCmd(
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *varTokenPtr;
|
||||
int isScalar, localIndex, numWords, flags, i;
|
||||
Tcl_Obj *leadingWord;
|
||||
int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
numWords = parsePtr->numWords-1;
|
||||
flags = 1;
|
||||
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
leadingWord = Tcl_NewObj();
|
||||
if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
|
||||
int len;
|
||||
const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
|
||||
if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
|
||||
flags = 0;
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
numWords--;
|
||||
} else if (len == 2 && !strncmp("--", bytes, 2)) {
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
numWords--;
|
||||
/*
|
||||
* Verify that all words - except the first non-option one - are known at
|
||||
* compile time so that we can handle them without needing to do a nasty
|
||||
* push/rotate. [Bug 3970f54c4e]
|
||||
*/
|
||||
|
||||
for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
|
||||
Tcl_Obj *leadingWord = Tcl_NewObj();
|
||||
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
|
||||
TclDecrRefCount(leadingWord);
|
||||
|
||||
/*
|
||||
* We can tolerate non-trivial substitutions in the first variable
|
||||
* to be unset. If a '--' or '-nocomplain' was present, anything
|
||||
* goes in that one place! (All subsequent variable names must be
|
||||
* constants since we don't want to have to push them all first.)
|
||||
*/
|
||||
|
||||
if (varCount == 0) {
|
||||
if (haveFlags) {
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* In fact, we're OK as long as we're the first argument *and*
|
||||
* we provably don't start with a '-'. If that is true, then
|
||||
* even if everything else is varying, we still can't be a
|
||||
* flag. Otherwise we'll spill to runtime to place a limit on
|
||||
* the trickiness.
|
||||
*/
|
||||
|
||||
if (varTokenPtr->type == TCL_TOKEN_WORD
|
||||
&& varTokenPtr[1].type == TCL_TOKEN_TEXT
|
||||
&& varTokenPtr[1].size > 0
|
||||
&& varTokenPtr[1].start[0] != '-') {
|
||||
continue;
|
||||
}
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Cannot guarantee that the first word is not '-nocomplain' at
|
||||
* evaluation with reasonable effort, so spill to interpreted version.
|
||||
*/
|
||||
if (i == 1) {
|
||||
const char *bytes;
|
||||
int len;
|
||||
|
||||
bytes = Tcl_GetStringFromObj(leadingWord, &len);
|
||||
if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
|
||||
flags = 0;
|
||||
haveFlags = 1;
|
||||
} else if (len == 2 && !strncmp("--", bytes, 2)) {
|
||||
haveFlags = 1;
|
||||
} else {
|
||||
varCount++;
|
||||
}
|
||||
} else {
|
||||
varCount++;
|
||||
}
|
||||
TclDecrRefCount(leadingWord);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclDecrRefCount(leadingWord);
|
||||
|
||||
for (i=0 ; i<numWords ; i++) {
|
||||
/*
|
||||
* Issue instructions to unset each of the named variables.
|
||||
*/
|
||||
|
||||
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
if (haveFlags) {
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
}
|
||||
for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
|
||||
/*
|
||||
* Decide if we can use a frame slot for the var/array name or if we
|
||||
* need to emit code to compute and push the name at runtime. We use a
|
||||
@@ -2858,7 +2899,7 @@ TclCompileUnsetCmd(
|
||||
*/
|
||||
|
||||
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
|
||||
&localIndex, &isScalar, 1);
|
||||
&localIndex, &isScalar, i);
|
||||
|
||||
/*
|
||||
* Emit instructions to unset the variable.
|
||||
@@ -3176,6 +3217,7 @@ CompileAssociativeBinaryOpCmd(
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int words;
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
for (words=1 ; words<parsePtr->numWords ; words++) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, words);
|
||||
@@ -3259,6 +3301,7 @@ CompileComparisonOpCmd(
|
||||
Tcl_Token *tokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords < 3) {
|
||||
PUSH("1");
|
||||
} else if (parsePtr->numWords == 3) {
|
||||
@@ -3596,6 +3639,7 @@ TclCompileMinusOpCmd(
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int words;
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords == 1) {
|
||||
/*
|
||||
* Fallback to direct eval to report syntax error.
|
||||
@@ -3641,6 +3685,7 @@ TclCompileDivOpCmd(
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int words;
|
||||
|
||||
/* TODO: Consider support for compiling expanded args. */
|
||||
if (parsePtr->numWords == 1) {
|
||||
/*
|
||||
* Fallback to direct eval to report syntax error.
|
||||
|
||||
+39
-62
@@ -490,13 +490,6 @@ typedef struct JumpList {
|
||||
JumpFixup jump; /* Pass this argument to matching calls of
|
||||
* TclEmitForwardJump() and
|
||||
* TclFixupForwardJump(). */
|
||||
int depth; /* Remember the currStackDepth of the
|
||||
* CompileEnv here. */
|
||||
int offset; /* Data used to compute jump lengths to pass
|
||||
* to TclFixupForwardJump() */
|
||||
int convert; /* Temporary storage used to compute whether
|
||||
* numeric conversion will be needed following
|
||||
* the operator we're compiling. */
|
||||
struct JumpList *next; /* Point to next item on the stack */
|
||||
} JumpList;
|
||||
|
||||
@@ -2261,30 +2254,8 @@ CompileExprTree(
|
||||
if (nodePtr->mark == MARK_LEFT) {
|
||||
next = nodePtr->left;
|
||||
|
||||
switch (nodePtr->lexeme) {
|
||||
case QUESTION:
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
jumpPtr->depth = envPtr->currStackDepth;
|
||||
if (nodePtr->lexeme == QUESTION) {
|
||||
convert = 1;
|
||||
break;
|
||||
case AND:
|
||||
case OR:
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
jumpPtr->depth = envPtr->currStackDepth;
|
||||
break;
|
||||
}
|
||||
} else if (nodePtr->mark == MARK_RIGHT) {
|
||||
next = nodePtr->right;
|
||||
@@ -2317,25 +2288,35 @@ CompileExprTree(
|
||||
break;
|
||||
}
|
||||
case QUESTION:
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
|
||||
break;
|
||||
case COLON:
|
||||
CLANG_ASSERT(jumpPtr);
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
|
||||
&jumpPtr->next->jump);
|
||||
envPtr->currStackDepth = jumpPtr->depth;
|
||||
jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
|
||||
jumpPtr->convert = convert;
|
||||
&jumpPtr->jump);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
if (convert) {
|
||||
jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
|
||||
}
|
||||
convert = 1;
|
||||
break;
|
||||
case AND:
|
||||
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
|
||||
break;
|
||||
case OR:
|
||||
TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump);
|
||||
newJump = TclStackAlloc(interp, sizeof(JumpList));
|
||||
newJump->next = jumpPtr;
|
||||
jumpPtr = newJump;
|
||||
TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
|
||||
? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
|
||||
break;
|
||||
}
|
||||
} else {
|
||||
int pc1, pc2, target;
|
||||
|
||||
switch (nodePtr->lexeme) {
|
||||
case START:
|
||||
case QUESTION:
|
||||
@@ -2375,18 +2356,20 @@ CompileExprTree(
|
||||
break;
|
||||
case COLON:
|
||||
CLANG_ASSERT(jumpPtr);
|
||||
if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump,
|
||||
(envPtr->codeNext - envPtr->codeStart)
|
||||
- jumpPtr->next->jump.codeOffset, 127)) {
|
||||
jumpPtr->offset += 3;
|
||||
if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
|
||||
jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
|
||||
convert = 1;
|
||||
}
|
||||
target = jumpPtr->jump.codeOffset + 2;
|
||||
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
|
||||
target += 3;
|
||||
}
|
||||
TclFixupForwardJump(envPtr, &jumpPtr->jump,
|
||||
jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
|
||||
convert |= jumpPtr->convert;
|
||||
envPtr->currStackDepth = jumpPtr->depth + 1;
|
||||
freePtr = jumpPtr;
|
||||
jumpPtr = jumpPtr->next;
|
||||
TclStackFree(interp, freePtr);
|
||||
TclFixupForwardJump(envPtr, &jumpPtr->jump,
|
||||
target - jumpPtr->jump.codeOffset, 127);
|
||||
|
||||
freePtr = jumpPtr;
|
||||
jumpPtr = jumpPtr->next;
|
||||
TclStackFree(interp, freePtr);
|
||||
@@ -2394,30 +2377,24 @@ CompileExprTree(
|
||||
case AND:
|
||||
case OR:
|
||||
CLANG_ASSERT(jumpPtr);
|
||||
TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
|
||||
? TCL_FALSE_JUMP : TCL_TRUE_JUMP,
|
||||
&jumpPtr->next->jump);
|
||||
pc1 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
|
||||
: INST_JUMP_TRUE1, 0, envPtr);
|
||||
TclEmitPush(TclRegisterNewLiteral(envPtr,
|
||||
(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
|
||||
&jumpPtr->next->next->jump);
|
||||
pc2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1(INST_JUMP1, 0, envPtr);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
|
||||
envPtr->codeStart + pc1 + 1);
|
||||
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
|
||||
jumpPtr->next->next->jump.codeOffset += 3;
|
||||
pc2 += 3;
|
||||
}
|
||||
TclEmitPush(TclRegisterNewLiteral(envPtr,
|
||||
(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
|
||||
TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump,
|
||||
127);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
|
||||
envPtr->codeStart + pc2 + 1);
|
||||
convert = 0;
|
||||
envPtr->currStackDepth = jumpPtr->depth + 1;
|
||||
freePtr = jumpPtr;
|
||||
jumpPtr = jumpPtr->next;
|
||||
TclStackFree(interp, freePtr);
|
||||
freePtr = jumpPtr;
|
||||
jumpPtr = jumpPtr->next;
|
||||
TclStackFree(interp, freePtr);
|
||||
freePtr = jumpPtr;
|
||||
jumpPtr = jumpPtr->next;
|
||||
TclStackFree(interp, freePtr);
|
||||
|
||||
+416
-547
File diff suppressed because it is too large
Load Diff
+28
-28
@@ -193,13 +193,6 @@ typedef struct ExtCmdLoc {
|
||||
ECL *loc; /* Command word locations (lines). */
|
||||
int nloc; /* Number of allocated entries in 'loc'. */
|
||||
int nuloc; /* Number of used entries in 'loc'. */
|
||||
Tcl_HashTable litInfo; /* Indexed by bytecode 'PC', to have the
|
||||
* information accessible per command and
|
||||
* argument, not per whole bytecode. Value is
|
||||
* index of command in 'loc', giving us the
|
||||
* literals to associate with line information
|
||||
* as command argument, see
|
||||
* TclArgumentBCEnter() */
|
||||
} ExtCmdLoc;
|
||||
|
||||
/*
|
||||
@@ -372,10 +365,6 @@ typedef struct CompileEnv {
|
||||
* encountered that have not yet been paired
|
||||
* with a corresponding
|
||||
* INST_INVOKE_EXPANDED. */
|
||||
ContLineLoc *clLoc; /* If not NULL, the table holding the
|
||||
* locations of the invisible continuation
|
||||
* lines in the input script, to adjust the
|
||||
* line counter. */
|
||||
int *clNext; /* If not NULL, it refers to the next slot in
|
||||
* clLoc to check for an invisible
|
||||
* continuation line. */
|
||||
@@ -991,6 +980,9 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
|
||||
CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
|
||||
MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
|
||||
ExceptionAux *auxPtr);
|
||||
@@ -1002,6 +994,9 @@ MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
|
||||
MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
|
||||
Tcl_Token *tokenPtr, int numWords,
|
||||
CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
|
||||
Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
|
||||
CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
|
||||
const char *script, int numBytes,
|
||||
CompileEnv *envPtr);
|
||||
@@ -1074,7 +1069,7 @@ MODULE_SCOPE void TclPrintSource(FILE *outFile,
|
||||
MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
|
||||
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
|
||||
int flags, int *localIndexPtr,
|
||||
int *isScalarPtr, int line, int *clNext);
|
||||
int *isScalarPtr);
|
||||
MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr,
|
||||
char *bytes, int length, int flags);
|
||||
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
@@ -1114,6 +1109,15 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/*
|
||||
* Simplified form to access AuxData.
|
||||
*
|
||||
* ClientData TclFetchAuxData(CompileEng *envPtr, int index);
|
||||
*/
|
||||
|
||||
#define TclFetchAuxData(envPtr, index) \
|
||||
(envPtr)->auxDataArrayPtr[(index)].clientData
|
||||
|
||||
#define LITERAL_ON_HEAP 0x01
|
||||
#define LITERAL_CMD_NAME 0x02
|
||||
|
||||
@@ -1407,16 +1411,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
|
||||
#define TclMax(i, j) ((((int) i) > ((int) j))? (i) : (j))
|
||||
|
||||
/*
|
||||
* Convenience macro for use when compiling bodies of commands. The ANSI C
|
||||
* "prototype" for this macro is:
|
||||
* Convenience macros for use when compiling bodies of commands. The ANSI C
|
||||
* "prototype" for these macros are:
|
||||
*
|
||||
* static void CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
|
||||
* Tcl_Interp *interp);
|
||||
* static void BODY(Tcl_Token *tokenPtr, int word);
|
||||
*/
|
||||
|
||||
#define CompileBody(envPtr, tokenPtr, interp) \
|
||||
TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
|
||||
(envPtr))
|
||||
#define BODY(tokenPtr, word) \
|
||||
SetLineInformation((word)); \
|
||||
TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \
|
||||
envPtr)
|
||||
|
||||
/*
|
||||
* Convenience macro for use when compiling tokens to be pushed. The ANSI C
|
||||
@@ -1515,13 +1519,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
|
||||
|
||||
#define CompileWord(envPtr, tokenPtr, interp, word) \
|
||||
if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
|
||||
TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
|
||||
(tokenPtr)[1].size), (envPtr)); \
|
||||
PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size); \
|
||||
} else { \
|
||||
envPtr->line = mapPtr->loc[eclIndex].line[word]; \
|
||||
envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
|
||||
TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
|
||||
(envPtr)); \
|
||||
SetLineInformation((word)); \
|
||||
CompileTokens((envPtr), (tokenPtr), (interp)); \
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1542,9 +1543,8 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
|
||||
envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
|
||||
|
||||
#define PushVarNameWord(i,v,e,f,l,sc,word) \
|
||||
TclPushVarName(i,v,e,f,l,sc, \
|
||||
mapPtr->loc[eclIndex].line[(word)], \
|
||||
mapPtr->loc[eclIndex].next[(word)])
|
||||
SetLineInformation(word); \
|
||||
TclPushVarName(i,v,e,f,l,sc)
|
||||
|
||||
/*
|
||||
* Often want to issue one of two versions of an instruction based on whether
|
||||
|
||||
+57
-117
@@ -35,9 +35,6 @@ static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
|
||||
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
|
||||
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
|
||||
static int CompileToCompiledCommand(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
|
||||
CompileEnv *envPtr);
|
||||
static void CompileToInvokedCommand(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Tcl_Obj *replacements,
|
||||
Command *cmdPtr, CompileEnv *envPtr);
|
||||
@@ -1527,6 +1524,14 @@ TclMakeEnsemble(
|
||||
cmdName = nameParts[nameCount - 1];
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Switch on compilation always for core ensembles now that we can do
|
||||
* nice bytecode things with them. Do it now. Waiting until later will
|
||||
* just cause pointless epoch bumps.
|
||||
*/
|
||||
|
||||
ensembleFlags |= ENSEMBLE_COMPILE;
|
||||
ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
|
||||
|
||||
/*
|
||||
@@ -1578,14 +1583,6 @@ TclMakeEnsemble(
|
||||
}
|
||||
}
|
||||
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
|
||||
|
||||
/*
|
||||
* Switch on compilation always for core ensembles now that we can do
|
||||
* nice bytecode things with them.
|
||||
*/
|
||||
|
||||
Tcl_SetEnsembleFlags(interp, ensemble,
|
||||
ensembleFlags | ENSEMBLE_COMPILE);
|
||||
}
|
||||
|
||||
Tcl_DStringFree(&buf);
|
||||
@@ -2994,8 +2991,8 @@ TclCompileEnsemble(
|
||||
*/
|
||||
|
||||
invokeAnyway = 1;
|
||||
if (CompileToCompiledCommand(interp, parsePtr, depth, cmdPtr,
|
||||
envPtr) == TCL_OK) {
|
||||
if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
|
||||
envPtr)) {
|
||||
ourResult = TCL_OK;
|
||||
goto cleanup;
|
||||
}
|
||||
@@ -3029,24 +3026,16 @@ TclCompileEnsemble(
|
||||
return ourResult;
|
||||
}
|
||||
|
||||
/*
|
||||
* How to compile a subcommand using its own command compiler. To do that, we
|
||||
* have to perform some trickery to rewrite the arguments, as compilers *must*
|
||||
* have parse tokens that refer to addresses in the original script.
|
||||
*/
|
||||
|
||||
static int
|
||||
CompileToCompiledCommand(
|
||||
int
|
||||
TclAttemptCompileProc(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr,
|
||||
int depth,
|
||||
Command *cmdPtr,
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Parse synthetic;
|
||||
Tcl_Token *tokenPtr;
|
||||
int result, i;
|
||||
int savedNumCmds = envPtr->numCommands;
|
||||
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
|
||||
int savedStackDepth = envPtr->currStackDepth;
|
||||
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
|
||||
DefineLineInformation;
|
||||
@@ -3055,47 +3044,17 @@ CompileToCompiledCommand(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
TclParseInit(interp, NULL, 0, &synthetic);
|
||||
synthetic.numWords = parsePtr->numWords - depth + 1;
|
||||
TclGrowParseTokenArray(&synthetic, 2);
|
||||
synthetic.numTokens = 2;
|
||||
|
||||
/*
|
||||
* Now we have the space to work in, install something rewritten. The
|
||||
* first word will "officially" be the bytes of the structured ensemble
|
||||
* name. That's technically wrong, but nobody will care; we just need
|
||||
* *something* here...
|
||||
* Advance parsePtr->tokenPtr so that it points at the last subcommand.
|
||||
* This will be wrong, but it will not matter, and it will put the
|
||||
* tokens for the arguments in the right place without the needed to
|
||||
* allocate a synthetic Tcl_Parse struct, or copy tokens around.
|
||||
*/
|
||||
|
||||
synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD;
|
||||
synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start;
|
||||
synthetic.tokenPtr[0].numComponents = 1;
|
||||
synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT;
|
||||
synthetic.tokenPtr[1].start = parsePtr->tokenPtr[0].start;
|
||||
synthetic.tokenPtr[1].numComponents = 0;
|
||||
for (i=0,tokenPtr=parsePtr->tokenPtr ; i<depth ; i++) {
|
||||
int sclen = (tokenPtr->start - synthetic.tokenPtr[0].start)
|
||||
+ tokenPtr->size;
|
||||
|
||||
synthetic.tokenPtr[0].size = sclen;
|
||||
synthetic.tokenPtr[1].size = sclen;
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy over the real argument tokens.
|
||||
*/
|
||||
|
||||
for (i=1; i<synthetic.numWords; i++) {
|
||||
int toCopy;
|
||||
|
||||
toCopy = tokenPtr->numComponents + 1;
|
||||
TclGrowParseTokenArray(&synthetic, toCopy);
|
||||
memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
|
||||
sizeof(Tcl_Token) * toCopy);
|
||||
synthetic.numTokens += toCopy;
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
for (i = 0; i < depth - 1; i++) {
|
||||
parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
}
|
||||
parsePtr->numWords -= (depth - 1);
|
||||
|
||||
/*
|
||||
* Shift the line information arrays to account for different word
|
||||
@@ -3109,7 +3068,7 @@ CompileToCompiledCommand(
|
||||
* Hand off compilation to the subcommand compiler. At last!
|
||||
*/
|
||||
|
||||
result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
|
||||
result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);
|
||||
|
||||
/*
|
||||
* Undo the shift.
|
||||
@@ -3118,22 +3077,37 @@ CompileToCompiledCommand(
|
||||
mapPtr->loc[eclIndex].line -= (depth - 1);
|
||||
mapPtr->loc[eclIndex].next -= (depth - 1);
|
||||
|
||||
parsePtr->numWords += (depth - 1);
|
||||
parsePtr->tokenPtr = saveTokenPtr;
|
||||
|
||||
/*
|
||||
* If our target fails to compile, revert the number of commands and the
|
||||
* pointer to the place to issue the next instruction. [Bug 3600328]
|
||||
* If our target failed to compile, revert any data from failed partial
|
||||
* compiles. Note that envPtr->numCommands need not be checked because
|
||||
* we avoid compiling subcommands that recursively call TclCompileScript().
|
||||
*/
|
||||
|
||||
if (result != TCL_OK) {
|
||||
envPtr->numCommands = savedNumCmds;
|
||||
envPtr->currStackDepth = savedStackDepth;
|
||||
envPtr->codeNext = envPtr->codeStart + savedCodeNext;
|
||||
#ifdef TCL_COMPILE_DEBUG
|
||||
} else {
|
||||
/*
|
||||
* Confirm that the command compiler generated a single value on
|
||||
* the stack as its result. This is only done in debugging mode,
|
||||
* as it *should* be correct and normal users have no reasonable
|
||||
* way to fix it anyway.
|
||||
*/
|
||||
|
||||
int diff = envPtr->currStackDepth - savedStackDepth;
|
||||
|
||||
if (diff != 1) {
|
||||
Tcl_Panic("bad stack adjustment when compiling"
|
||||
" %.*s (was %d instead of 1)", parsePtr->tokenPtr->size,
|
||||
parsePtr->tokenPtr->start, diff);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
* Clean up if necessary.
|
||||
*/
|
||||
|
||||
Tcl_FreeParse(&synthetic);
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -3163,12 +3137,16 @@ CompileToInvokedCommand(
|
||||
*/
|
||||
|
||||
Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
|
||||
for (i=0,tokPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
|
||||
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
|
||||
i++, tokPtr = TokenAfter(tokPtr)) {
|
||||
if (i > 0 && i < numWords+1) {
|
||||
bytes = Tcl_GetStringFromObj(words[i-1], &length);
|
||||
PushLiteral(envPtr, bytes, length);
|
||||
} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
/* TODO: Check about registering Cmd Literals here */
|
||||
continue;
|
||||
}
|
||||
|
||||
SetLineInformation(i);
|
||||
if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
int literal = TclRegisterNewLiteral(envPtr,
|
||||
tokPtr[1].start, tokPtr[1].size);
|
||||
|
||||
@@ -3176,14 +3154,12 @@ CompileToInvokedCommand(
|
||||
TclContinuationsEnterDerived(
|
||||
TclFetchLiteral(envPtr, literal),
|
||||
tokPtr[1].start - envPtr->source,
|
||||
mapPtr->loc[eclIndex].next[i]);
|
||||
envPtr->clNext);
|
||||
}
|
||||
TclEmitPush(literal, envPtr);
|
||||
} else {
|
||||
SetLineInformation(i);
|
||||
CompileTokens(envPtr, tokPtr, interp);
|
||||
}
|
||||
tokPtr = TokenAfter(tokPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3229,49 +3205,13 @@ CompileBasicNArgCommand(
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
char *bytes;
|
||||
int length, i, literal;
|
||||
DefineLineInformation;
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
|
||||
/*
|
||||
* Push the name of the command we're actually dispatching to as part of
|
||||
* the implementation.
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
|
||||
bytes = Tcl_GetStringFromObj(objPtr, &length);
|
||||
literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
|
||||
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
|
||||
TclEmitPush(literal, envPtr);
|
||||
TclDecrRefCount(objPtr);
|
||||
|
||||
/*
|
||||
* Push the words of the command.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
for (i=1 ; i<parsePtr->numWords ; i++) {
|
||||
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
|
||||
} else {
|
||||
SetLineInformation(i);
|
||||
CompileTokens(envPtr, tokenPtr, interp);
|
||||
}
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Do the standard dispatch.
|
||||
*/
|
||||
|
||||
if (i <= 255) {
|
||||
TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
|
||||
}
|
||||
TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
|
||||
parsePtr->numWords, envPtr);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
@@ -1171,8 +1171,6 @@ Tcl_Finalize(void)
|
||||
|
||||
TclFinalizeEncodingSubsystem();
|
||||
|
||||
Tcl_SetPanicProc(NULL);
|
||||
|
||||
/*
|
||||
* Repeat finalization of the thread local storage once more. Although
|
||||
* this step is already done by the Tcl_FinalizeThread call above, series
|
||||
|
||||
+73
-41
@@ -721,7 +721,7 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
|
||||
int catchOnly, ByteCode *codePtr);
|
||||
static const char * GetSrcInfoForPc(const unsigned char *pc,
|
||||
ByteCode *codePtr, int *lengthPtr,
|
||||
const unsigned char **pcBeg);
|
||||
const unsigned char **pcBeg, int *cmdIdxPtr);
|
||||
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth,
|
||||
int move);
|
||||
static void IllegalExprOperandType(Tcl_Interp *interp,
|
||||
@@ -1426,17 +1426,12 @@ Tcl_NRExprObj(
|
||||
Tcl_Obj *resultPtr)
|
||||
{
|
||||
ByteCode *codePtr;
|
||||
Tcl_InterpState state = Tcl_SaveInterpState(interp, TCL_OK);
|
||||
|
||||
/* TODO: consider saving whole state? */
|
||||
Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
|
||||
|
||||
Tcl_IncrRefCount(saveObjPtr);
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
codePtr = CompileExprObj(interp, objPtr);
|
||||
|
||||
/* TODO: Confirm reset not required? */
|
||||
/*Tcl_ResetResult(interp);*/
|
||||
Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr,
|
||||
Tcl_NRAddCallback(interp, ExprObjCallback, state, resultPtr,
|
||||
NULL, NULL);
|
||||
return TclNRExecuteByteCode(interp, codePtr);
|
||||
}
|
||||
@@ -1447,14 +1442,15 @@ ExprObjCallback(
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
Tcl_Obj *saveObjPtr = data[0];
|
||||
Tcl_InterpState state = data[0];
|
||||
Tcl_Obj *resultPtr = data[1];
|
||||
|
||||
if (result == TCL_OK) {
|
||||
TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
|
||||
Tcl_SetObjResult(interp, saveObjPtr);
|
||||
(void) Tcl_RestoreInterpState(interp, state);
|
||||
} else {
|
||||
Tcl_DiscardInterpState(state);
|
||||
}
|
||||
TclDecrRefCount(saveObjPtr);
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -2002,7 +1998,6 @@ TclNRExecuteByteCode(
|
||||
bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
|
||||
? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
|
||||
bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
|
||||
bcFramePtr->numLevels = iPtr->numLevels;
|
||||
bcFramePtr->framePtr = iPtr->framePtr;
|
||||
bcFramePtr->nextPtr = iPtr->cmdFramePtr;
|
||||
bcFramePtr->nline = 0;
|
||||
@@ -2010,8 +2005,9 @@ TclNRExecuteByteCode(
|
||||
bcFramePtr->litarg = NULL;
|
||||
bcFramePtr->data.tebc.codePtr = codePtr;
|
||||
bcFramePtr->data.tebc.pc = NULL;
|
||||
bcFramePtr->cmd.str.cmd = NULL;
|
||||
bcFramePtr->cmd.str.len = 0;
|
||||
bcFramePtr->cmdObj = NULL;
|
||||
bcFramePtr->cmd = NULL;
|
||||
bcFramePtr->len = 0;
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
iPtr->stats.numExecutions++;
|
||||
@@ -2134,6 +2130,11 @@ TEBCresume(
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
|
||||
if (bcFramePtr->cmdObj) {
|
||||
Tcl_DecrRefCount(bcFramePtr->cmdObj);
|
||||
bcFramePtr->cmdObj = NULL;
|
||||
bcFramePtr->cmd = NULL;
|
||||
}
|
||||
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
|
||||
if (iPtr->flags & INTERP_DEBUG_FRAME) {
|
||||
TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
|
||||
@@ -2435,8 +2436,11 @@ TEBCresume(
|
||||
iPtr->cmdFramePtr = bcFramePtr;
|
||||
|
||||
if (iPtr->flags & INTERP_DEBUG_FRAME) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, pc - codePtr->codeStart);
|
||||
int cmd;
|
||||
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
|
||||
}
|
||||
}
|
||||
|
||||
pc++;
|
||||
@@ -2889,8 +2893,11 @@ TEBCresume(
|
||||
iPtr->cmdFramePtr = bcFramePtr;
|
||||
|
||||
if (iPtr->flags & INTERP_DEBUG_FRAME) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, pc - codePtr->codeStart);
|
||||
int cmd;
|
||||
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
|
||||
}
|
||||
}
|
||||
|
||||
DECACHE_STACK_INFO();
|
||||
@@ -2898,7 +2905,7 @@ TEBCresume(
|
||||
pc += pcAdjustment;
|
||||
TEBC_YIELD();
|
||||
return TclNREvalObjv(interp, objc, objv,
|
||||
TCL_EVAL_NOERR, NULL);
|
||||
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
|
||||
|
||||
#if TCL_SUPPORT_84_BYTECODE
|
||||
case INST_CALL_BUILTIN_FUNC1:
|
||||
@@ -3035,8 +3042,11 @@ TEBCresume(
|
||||
bcFramePtr->data.tebc.pc = (char *) pc;
|
||||
iPtr->cmdFramePtr = bcFramePtr;
|
||||
if (iPtr->flags & INTERP_DEBUG_FRAME) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, pc - codePtr->codeStart);
|
||||
int cmd;
|
||||
if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
|
||||
TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
|
||||
codePtr, bcFramePtr, cmd, pc - codePtr->codeStart);
|
||||
}
|
||||
}
|
||||
iPtr->ensembleRewrite.sourceObjs = objv;
|
||||
iPtr->ensembleRewrite.numRemovedObjs = opnd;
|
||||
@@ -4728,7 +4738,7 @@ TEBCresume(
|
||||
if (listPtr->refCount == 1) {
|
||||
TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
|
||||
TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
|
||||
for (index=toIdx+1 ; index<objc-1 ; index++) {
|
||||
for (index=toIdx+1; index<objc ; index++) {
|
||||
TclDecrRefCount(objv[index]);
|
||||
}
|
||||
listPtr->elemCount = toIdx+1;
|
||||
@@ -6971,7 +6981,7 @@ TEBCresume(
|
||||
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
|
||||
const unsigned char *pcBeg;
|
||||
|
||||
bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
|
||||
bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
|
||||
DECACHE_STACK_INFO();
|
||||
TclLogCommandInfo(interp, codePtr->source, bytes,
|
||||
bytes ? length : 0, pcBeg, tosPtr);
|
||||
@@ -7153,7 +7163,7 @@ TEBCresume(
|
||||
}
|
||||
|
||||
codePtr->flags |= TCL_BYTECODE_RECOMPILE;
|
||||
bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
|
||||
bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
|
||||
opnd = TclGetUInt4AtPtr(pc+1);
|
||||
pc += (opnd-1);
|
||||
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
|
||||
@@ -8646,7 +8656,7 @@ ValidatePcAndStackTop(
|
||||
if (checkStack &&
|
||||
((stackTop < 0) || (stackTop > stackUpperBound))) {
|
||||
int numChars;
|
||||
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
|
||||
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
|
||||
|
||||
fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
|
||||
stackTop, relativePc, stackUpperBound);
|
||||
@@ -8730,7 +8740,7 @@ IllegalExprOperandType(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
|
||||
* TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
|
||||
*
|
||||
* Given a program counter value, finds the closest command in the
|
||||
* bytecode code unit's CmdLocation array and returns information about
|
||||
@@ -8751,16 +8761,26 @@ IllegalExprOperandType(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
const char *
|
||||
TclGetSrcInfoForCmd(
|
||||
Interp *iPtr,
|
||||
int *lenPtr)
|
||||
Tcl_Obj *
|
||||
TclGetSourceFromFrame(
|
||||
CmdFrame *cfPtr,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
CmdFrame *cfPtr = iPtr->cmdFramePtr;
|
||||
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
|
||||
if (cfPtr == NULL) {
|
||||
return Tcl_NewListObj(objc, objv);
|
||||
}
|
||||
if (cfPtr->cmdObj == NULL) {
|
||||
if (cfPtr->cmd == NULL) {
|
||||
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
|
||||
|
||||
return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
|
||||
codePtr, lenPtr, NULL);
|
||||
cfPtr->cmd = GetSrcInfoForPc((unsigned char *)
|
||||
cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL);
|
||||
}
|
||||
cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len);
|
||||
Tcl_IncrRefCount(cfPtr->cmdObj);
|
||||
}
|
||||
return cfPtr->cmdObj;
|
||||
}
|
||||
|
||||
void
|
||||
@@ -8769,13 +8789,16 @@ TclGetSrcInfoForPc(
|
||||
{
|
||||
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
|
||||
|
||||
if (cfPtr->cmd.str.cmd == NULL) {
|
||||
cfPtr->cmd.str.cmd = GetSrcInfoForPc(
|
||||
assert(cfPtr->type == TCL_LOCATION_BC);
|
||||
|
||||
if (cfPtr->cmd == NULL) {
|
||||
|
||||
cfPtr->cmd = GetSrcInfoForPc(
|
||||
(unsigned char *) cfPtr->data.tebc.pc, codePtr,
|
||||
&cfPtr->cmd.str.len, NULL);
|
||||
&cfPtr->len, NULL, NULL);
|
||||
}
|
||||
|
||||
if (cfPtr->cmd.str.cmd != NULL) {
|
||||
if (cfPtr->cmd != NULL) {
|
||||
/*
|
||||
* We now have the command. We can get the srcOffset back and from
|
||||
* there find the list of word locations for this command.
|
||||
@@ -8792,7 +8815,7 @@ TclGetSrcInfoForPc(
|
||||
return;
|
||||
}
|
||||
|
||||
srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
|
||||
srcOffset = cfPtr->cmd - codePtr->source;
|
||||
eclPtr = Tcl_GetHashValue(hePtr);
|
||||
|
||||
for (i=0; i < eclPtr->nuloc; i++) {
|
||||
@@ -8832,9 +8855,12 @@ GetSrcInfoForPc(
|
||||
int *lengthPtr, /* If non-NULL, the location where the length
|
||||
* of the command's source should be stored.
|
||||
* If NULL, no length is stored. */
|
||||
const unsigned char **pcBeg)/* If non-NULL, the bytecode location
|
||||
const unsigned char **pcBeg,/* If non-NULL, the bytecode location
|
||||
* where the current instruction starts.
|
||||
* If NULL; no pointer is stored. */
|
||||
int *cmdIdxPtr) /* If non-NULL, the location where the index
|
||||
* of the command containing the pc should
|
||||
* be stored. */
|
||||
{
|
||||
register int pcOffset = (pc - codePtr->codeStart);
|
||||
int numCmds = codePtr->numCommands;
|
||||
@@ -8844,6 +8870,7 @@ GetSrcInfoForPc(
|
||||
int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */
|
||||
int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
|
||||
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
|
||||
int bestCmdIdx = -1;
|
||||
|
||||
if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
|
||||
if (pcBeg != NULL) *pcBeg = NULL;
|
||||
@@ -8911,6 +8938,7 @@ GetSrcInfoForPc(
|
||||
bestDist = dist;
|
||||
bestSrcOffset = srcOffset;
|
||||
bestSrcLength = srcLen;
|
||||
bestCmdIdx = i;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -8940,6 +8968,10 @@ GetSrcInfoForPc(
|
||||
*lengthPtr = bestSrcLength;
|
||||
}
|
||||
|
||||
if (cmdIdxPtr != NULL) {
|
||||
*cmdIdxPtr = bestCmdIdx;
|
||||
}
|
||||
|
||||
return (codePtr->source + bestSrcOffset);
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -1944,7 +1944,7 @@ TclNREvalFile(
|
||||
iPtr->evalFlags |= TCL_EVAL_FILE;
|
||||
TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
|
||||
NULL);
|
||||
return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
|
||||
return TclNREvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, INT_MIN);
|
||||
}
|
||||
|
||||
static int
|
||||
|
||||
+30
-39
@@ -1175,29 +1175,27 @@ typedef struct CmdFrame {
|
||||
*
|
||||
* EXECUTION CONTEXTS and usage of CmdFrame
|
||||
*
|
||||
* Field TEBC EvalEx EvalObjEx
|
||||
* ======= ==== ====== =========
|
||||
* level yes yes yes
|
||||
* type BC/PREBC SRC/EVAL EVAL_LIST
|
||||
* line0 yes yes yes
|
||||
* framePtr yes yes yes
|
||||
* ======= ==== ====== =========
|
||||
* Field TEBC EvalEx
|
||||
* ======= ==== ======
|
||||
* level yes yes
|
||||
* type BC/PREBC SRC/EVAL
|
||||
* line0 yes yes
|
||||
* framePtr yes yes
|
||||
* ======= ==== ======
|
||||
*
|
||||
* ======= ==== ====== ========= union data
|
||||
* line1 - yes -
|
||||
* line3 - yes -
|
||||
* path - yes -
|
||||
* ------- ---- ------ ---------
|
||||
* codePtr yes - -
|
||||
* pc yes - -
|
||||
* ======= ==== ====== =========
|
||||
* ======= ==== ========= union data
|
||||
* line1 - yes
|
||||
* line3 - yes
|
||||
* path - yes
|
||||
* ------- ---- ------
|
||||
* codePtr yes -
|
||||
* pc yes -
|
||||
* ======= ==== ======
|
||||
*
|
||||
* ======= ==== ====== ========= | union cmd
|
||||
* listPtr - - yes |
|
||||
* ------- ---- ------ --------- |
|
||||
* cmd yes yes - |
|
||||
* cmdlen yes yes - |
|
||||
* ------- ---- ------ --------- |
|
||||
* ======= ==== ========= union cmd
|
||||
* str.cmd yes yes
|
||||
* str.len yes yes
|
||||
* ------- ---- ------
|
||||
*/
|
||||
|
||||
union {
|
||||
@@ -1210,15 +1208,9 @@ typedef struct CmdFrame {
|
||||
const char *pc; /* ... and instruction pointer. */
|
||||
} tebc;
|
||||
} data;
|
||||
union {
|
||||
struct {
|
||||
const char *cmd; /* The executed command, if possible... */
|
||||
int len; /* ... and its length. */
|
||||
} str;
|
||||
Tcl_Obj *listPtr; /* Tcl_EvalObjEx, cmd list. */
|
||||
} cmd;
|
||||
int numLevels; /* Value of interp's numLevels when the frame
|
||||
* was pushed. */
|
||||
Tcl_Obj *cmdObj;
|
||||
const char *cmd; /* The executed command, if possible... */
|
||||
int len; /* ... and its length. */
|
||||
const struct CFWordBC *litarg;
|
||||
/* Link to set of literal arguments which have
|
||||
* ben pushed on the lineLABCPtr stack by
|
||||
@@ -1282,8 +1274,6 @@ typedef struct ContLineLoc {
|
||||
* location data referenced via the 'baseLocPtr'.
|
||||
*
|
||||
* TCL_LOCATION_EVAL : Frame is for a script evaluated by EvalEx.
|
||||
* TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
|
||||
* optimization path of EvalObjEx.
|
||||
* TCL_LOCATION_BC : Frame is for bytecode.
|
||||
* TCL_LOCATION_PREBC : Frame is for precompiled bytecode.
|
||||
* TCL_LOCATION_SOURCE : Frame is for a script evaluated by EvalEx, from a
|
||||
@@ -1295,8 +1285,6 @@ typedef struct ContLineLoc {
|
||||
*/
|
||||
|
||||
#define TCL_LOCATION_EVAL (0) /* Location in a dynamic eval script. */
|
||||
#define TCL_LOCATION_EVAL_LIST (1) /* Location in a dynamic eval script,
|
||||
* list-path. */
|
||||
#define TCL_LOCATION_BC (2) /* Location in byte code. */
|
||||
#define TCL_LOCATION_PREBC (3) /* Location in precompiled byte code, no
|
||||
* location. */
|
||||
@@ -2210,9 +2198,10 @@ typedef struct Interp {
|
||||
* other than these should be turned into errors.
|
||||
*/
|
||||
|
||||
#define TCL_ALLOW_EXCEPTIONS 4
|
||||
#define TCL_EVAL_FILE 2
|
||||
#define TCL_EVAL_CTX 8
|
||||
#define TCL_ALLOW_EXCEPTIONS 0x04
|
||||
#define TCL_EVAL_FILE 0x02
|
||||
#define TCL_EVAL_SOURCE_IN_FRAME 0x10
|
||||
#define TCL_EVAL_NORESOLVE 0x20
|
||||
|
||||
/*
|
||||
* Flag bits for Interp structures:
|
||||
@@ -2737,6 +2726,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
|
||||
|
||||
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
|
||||
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
|
||||
@@ -2828,7 +2818,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp,
|
||||
Tcl_Obj *objv[], int objc);
|
||||
MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp,
|
||||
Tcl_Obj *objv[], int objc,
|
||||
void *codePtr, CmdFrame *cfPtr, int pc);
|
||||
void *codePtr, CmdFrame *cfPtr, int cmd, int pc);
|
||||
MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
|
||||
CmdFrame *cfPtr);
|
||||
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
|
||||
@@ -2919,7 +2909,8 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
|
||||
const char *modeString, int *seekFlagPtr,
|
||||
int *binaryPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
|
||||
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
|
||||
Tcl_Obj *unquotedPrefix, int globFlags,
|
||||
Tcl_GlobTypeData *types);
|
||||
|
||||
+52
-4
@@ -279,6 +279,12 @@ static void DeleteScriptLimitCallback(ClientData clientData);
|
||||
static void RunLimitHandlers(LimitHandler *handlerPtr,
|
||||
Tcl_Interp *interp);
|
||||
static void TimeLimitCallback(ClientData clientData);
|
||||
|
||||
/* NRE enabling */
|
||||
static Tcl_NRPostProc NRPostInvokeHidden;
|
||||
static Tcl_ObjCmdProc NRInterpCmd;
|
||||
static Tcl_ObjCmdProc NRSlaveCmd;
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -481,7 +487,8 @@ TclInterpInit(
|
||||
slavePtr->interpCmd = NULL;
|
||||
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
|
||||
|
||||
Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
|
||||
Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
|
||||
NULL, NULL);
|
||||
|
||||
Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
|
||||
return TCL_OK;
|
||||
@@ -589,6 +596,16 @@ Tcl_InterpObjCmd(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
|
||||
}
|
||||
|
||||
static int
|
||||
NRInterpCmd(
|
||||
ClientData clientData, /* Unused. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Interp *slaveInterp;
|
||||
int index;
|
||||
@@ -2372,8 +2389,8 @@ SlaveCreate(
|
||||
slavePtr->masterInterp = masterInterp;
|
||||
slavePtr->slaveEntryPtr = hPtr;
|
||||
slavePtr->slaveInterp = slaveInterp;
|
||||
slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
|
||||
SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
|
||||
slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
|
||||
SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
|
||||
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
|
||||
Tcl_SetHashValue(hPtr, slavePtr);
|
||||
Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
|
||||
@@ -2461,6 +2478,16 @@ SlaveObjCmd(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
return Tcl_NRCallObjProc(interp, NRSlaveCmd, clientData, objc, objv);
|
||||
}
|
||||
|
||||
static int
|
||||
NRSlaveCmd(
|
||||
ClientData clientData, /* Slave interpreter. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Interp *slaveInterp = clientData;
|
||||
int index;
|
||||
@@ -3052,7 +3079,11 @@ SlaveInvokeHidden(
|
||||
Tcl_AllowExceptions(slaveInterp);
|
||||
|
||||
if (namespaceName == NULL) {
|
||||
result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
|
||||
NRE_callback *rootPtr = TOP_CB(slaveInterp);
|
||||
|
||||
Tcl_NRAddCallback(interp, NRPostInvokeHidden, slaveInterp,
|
||||
rootPtr, NULL, NULL);
|
||||
return TclNRInvoke(NULL, slaveInterp, objc, objv);
|
||||
} else {
|
||||
Namespace *nsPtr, *dummy1, *dummy2;
|
||||
const char *tail;
|
||||
@@ -3071,6 +3102,23 @@ SlaveInvokeHidden(
|
||||
Tcl_Release(slaveInterp);
|
||||
return result;
|
||||
}
|
||||
|
||||
static int
|
||||
NRPostInvokeHidden(
|
||||
ClientData data[],
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
Tcl_Interp *slaveInterp = (Tcl_Interp *)data[0];
|
||||
NRE_callback *rootPtr = (NRE_callback *)data[1];
|
||||
|
||||
if (interp != slaveInterp) {
|
||||
result = TclNRRunCallbacks(slaveInterp, result, rootPtr);
|
||||
Tcl_TransferResult(slaveInterp, result, interp);
|
||||
}
|
||||
Tcl_Release(slaveInterp);
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
+1
-1
@@ -1942,7 +1942,7 @@ InvokeImportedNRCmd(
|
||||
Command *realCmdPtr = dataPtr->realCmdPtr;
|
||||
|
||||
TclSkipTailcall(interp);
|
||||
return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
|
||||
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
|
||||
}
|
||||
|
||||
static int
|
||||
|
||||
+1
-1
@@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs(
|
||||
* win/tclooConfig.sh
|
||||
*/
|
||||
|
||||
#define TCLOO_VERSION "1.0"
|
||||
#define TCLOO_VERSION "1.0.1"
|
||||
#define TCLOO_PATCHLEVEL TCLOO_VERSION
|
||||
|
||||
/*
|
||||
|
||||
+10
-6
@@ -4,7 +4,7 @@
|
||||
* This file contains implementations of the "simple" commands and
|
||||
* methods from the object-system core.
|
||||
*
|
||||
* Copyright (c) 2005-2012 by Donal K. Fellows
|
||||
* Copyright (c) 2005-2013 by Donal K. Fellows
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -88,7 +88,7 @@ TclOO_Class_Constructor(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
Tcl_Obj *invoke[3];
|
||||
Tcl_Obj **invoke;
|
||||
|
||||
if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
|
||||
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
||||
@@ -102,6 +102,7 @@ TclOO_Class_Constructor(
|
||||
* Delegate to [oo::define] to do the work.
|
||||
*/
|
||||
|
||||
invoke = ckalloc(3 * sizeof(Tcl_Obj *));
|
||||
invoke[0] = oPtr->fPtr->defineName;
|
||||
invoke[1] = TclOOObjectName(interp, oPtr);
|
||||
invoke[2] = objv[objc-1];
|
||||
@@ -115,7 +116,7 @@ TclOO_Class_Constructor(
|
||||
Tcl_IncrRefCount(invoke[1]);
|
||||
Tcl_IncrRefCount(invoke[2]);
|
||||
TclNRAddCallback(interp, DecrRefsPostClassConstructor,
|
||||
invoke[0], invoke[1], invoke[2], NULL);
|
||||
invoke, NULL, NULL, NULL);
|
||||
|
||||
/*
|
||||
* Tricky point: do not want the extra reported level in the Tcl stack
|
||||
@@ -131,9 +132,12 @@ DecrRefsPostClassConstructor(
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
TclDecrRefCount((Tcl_Obj *) data[0]);
|
||||
TclDecrRefCount((Tcl_Obj *) data[1]);
|
||||
TclDecrRefCount((Tcl_Obj *) data[2]);
|
||||
Tcl_Obj **invoke = data[0];
|
||||
|
||||
TclDecrRefCount(invoke[0]);
|
||||
TclDecrRefCount(invoke[1]);
|
||||
TclDecrRefCount(invoke[2]);
|
||||
ckfree(invoke);
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
+32
-19
@@ -4,7 +4,7 @@
|
||||
* This file contains the implementation of the ::oo::define command,
|
||||
* part of the object-system core (NB: not Tcl_Obj, but ::oo).
|
||||
*
|
||||
* Copyright (c) 2006-2012 by Donal K. Fellows
|
||||
* Copyright (c) 2006-2013 by Donal K. Fellows
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -2206,29 +2206,42 @@ ClassSuperSet(
|
||||
|
||||
/*
|
||||
* Parse the arguments to get the class to use as superclasses.
|
||||
*
|
||||
* Note that zero classes is special, as it is equivalent to just the
|
||||
* class of objects. [Bug 9d61624b3d]
|
||||
*/
|
||||
|
||||
for (i=0 ; i<superc ; i++) {
|
||||
superclasses[i] = GetClassInOuterContext(interp, superv[i],
|
||||
"only a class can be a superclass");
|
||||
if (superclasses[i] == NULL) {
|
||||
goto failedAfterAlloc;
|
||||
if (superc == 0) {
|
||||
superclasses = ckrealloc(superclasses, sizeof(Class *));
|
||||
superclasses[0] = oPtr->fPtr->objectCls;
|
||||
superc = 1;
|
||||
if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
|
||||
superclasses[0] = oPtr->fPtr->classCls;
|
||||
}
|
||||
for (j=0 ; j<i ; j++) {
|
||||
if (superclasses[j] == superclasses[i]) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"class should only be a direct superclass once", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
|
||||
} else {
|
||||
for (i=0 ; i<superc ; i++) {
|
||||
superclasses[i] = GetClassInOuterContext(interp, superv[i],
|
||||
"only a class can be a superclass");
|
||||
if (superclasses[i] == NULL) {
|
||||
goto failedAfterAlloc;
|
||||
}
|
||||
}
|
||||
if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"attempt to form circular dependency graph", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
|
||||
failedAfterAlloc:
|
||||
ckfree((char *) superclasses);
|
||||
return TCL_ERROR;
|
||||
for (j=0 ; j<i ; j++) {
|
||||
if (superclasses[j] == superclasses[i]) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"class should only be a direct superclass once",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
|
||||
goto failedAfterAlloc;
|
||||
}
|
||||
}
|
||||
if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"attempt to form circular dependency graph", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
|
||||
failedAfterAlloc:
|
||||
ckfree((char *) superclasses);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -122,12 +122,6 @@ typedef struct ForwardMethod {
|
||||
Tcl_Obj *prefixObj; /* The list of values to use to replace the
|
||||
* object and method name with. Will be a
|
||||
* non-empty list. */
|
||||
int fullyQualified; /* If 1, the command name is fully qualified
|
||||
* and we should let the default Tcl mechanism
|
||||
* handle the command lookup because it is
|
||||
* more efficient. If 0, we need to do a
|
||||
* specialized lookup based on the current
|
||||
* object's namespace. */
|
||||
} ForwardMethod;
|
||||
|
||||
/*
|
||||
|
||||
+55
-18
@@ -513,8 +513,8 @@ TclOOMakeProcInstanceMethod(
|
||||
cfPtr->data.eval.path = context.data.eval.path;
|
||||
Tcl_IncrRefCount(cfPtr->data.eval.path);
|
||||
|
||||
cfPtr->cmd.str.cmd = NULL;
|
||||
cfPtr->cmd.str.len = 0;
|
||||
cfPtr->cmd = NULL;
|
||||
cfPtr->len = 0;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
|
||||
(char *) procPtr, &isNew);
|
||||
@@ -626,8 +626,8 @@ TclOOMakeProcMethod(
|
||||
cfPtr->data.eval.path = context.data.eval.path;
|
||||
Tcl_IncrRefCount(cfPtr->data.eval.path);
|
||||
|
||||
cfPtr->cmd.str.cmd = NULL;
|
||||
cfPtr->cmd.str.len = 0;
|
||||
cfPtr->cmd = NULL;
|
||||
cfPtr->len = 0;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
|
||||
(char *) procPtr, &isNew);
|
||||
@@ -1290,11 +1290,57 @@ CloneProcedureMethod(
|
||||
ClientData *newClientData)
|
||||
{
|
||||
ProcedureMethod *pmPtr = clientData;
|
||||
ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
|
||||
ProcedureMethod *pm2Ptr;
|
||||
Tcl_Obj *bodyObj, *argsObj;
|
||||
CompiledLocal *localPtr;
|
||||
|
||||
/*
|
||||
* Copy the argument list.
|
||||
*/
|
||||
|
||||
argsObj = Tcl_NewObj();
|
||||
for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
|
||||
localPtr=localPtr->nextPtr) {
|
||||
if (TclIsVarArgument(localPtr)) {
|
||||
Tcl_Obj *argObj = Tcl_NewObj();
|
||||
|
||||
Tcl_ListObjAppendElement(NULL, argObj,
|
||||
Tcl_NewStringObj(localPtr->name, -1));
|
||||
if (localPtr->defValuePtr != NULL) {
|
||||
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Must strip the internal representation in order to ensure that any
|
||||
* bound references to instance variables are removed. [Bug 3609693]
|
||||
*/
|
||||
|
||||
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
|
||||
TclFreeIntRep(bodyObj);
|
||||
|
||||
/*
|
||||
* Create the actual copy of the method record, manufacturing a new proc
|
||||
* record.
|
||||
*/
|
||||
|
||||
pm2Ptr = ckalloc(sizeof(ProcedureMethod));
|
||||
memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
|
||||
pm2Ptr->refCount = 1;
|
||||
pm2Ptr->procPtr->refCount++;
|
||||
Tcl_IncrRefCount(argsObj);
|
||||
Tcl_IncrRefCount(bodyObj);
|
||||
if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
|
||||
&pm2Ptr->procPtr) != TCL_OK) {
|
||||
Tcl_DecrRefCount(argsObj);
|
||||
Tcl_DecrRefCount(bodyObj);
|
||||
ckfree(pm2Ptr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_DecrRefCount(argsObj);
|
||||
Tcl_DecrRefCount(bodyObj);
|
||||
|
||||
if (pmPtr->cloneClientdataProc) {
|
||||
pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
|
||||
}
|
||||
@@ -1338,7 +1384,6 @@ TclOONewForwardInstanceMethod(
|
||||
fmPtr = ckalloc(sizeof(ForwardMethod));
|
||||
fmPtr->prefixObj = prefixObj;
|
||||
Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
|
||||
fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
|
||||
Tcl_IncrRefCount(prefixObj);
|
||||
return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
|
||||
nameObj, flags, &fwdMethodType, fmPtr);
|
||||
@@ -1380,7 +1425,6 @@ TclOONewForwardMethod(
|
||||
fmPtr = ckalloc(sizeof(ForwardMethod));
|
||||
fmPtr->prefixObj = prefixObj;
|
||||
Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
|
||||
fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
|
||||
Tcl_IncrRefCount(prefixObj);
|
||||
return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
|
||||
flags, &fwdMethodType, fmPtr);
|
||||
@@ -1409,7 +1453,6 @@ InvokeForwardMethod(
|
||||
ForwardMethod *fmPtr = clientData;
|
||||
Tcl_Obj **argObjs, **prefixObjs;
|
||||
int numPrefixes, len, skip = contextPtr->skip;
|
||||
Command *cmdPtr;
|
||||
|
||||
/*
|
||||
* Build the real list of arguments to use. Note that we know that the
|
||||
@@ -1421,15 +1464,10 @@ InvokeForwardMethod(
|
||||
Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
|
||||
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
|
||||
numPrefixes, prefixObjs, &len);
|
||||
|
||||
if (fmPtr->fullyQualified) {
|
||||
cmdPtr = NULL;
|
||||
} else {
|
||||
cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(argObjs[0]),
|
||||
contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
|
||||
}
|
||||
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
|
||||
return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
|
||||
((Interp *)interp)->lookupNsPtr
|
||||
= (Namespace *) contextPtr->oPtr->namespacePtr;
|
||||
return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
|
||||
}
|
||||
|
||||
static int
|
||||
@@ -1474,7 +1512,6 @@ CloneForwardMethod(
|
||||
ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
|
||||
|
||||
fm2Ptr->prefixObj = fmPtr->prefixObj;
|
||||
fm2Ptr->fullyQualified = fmPtr->fullyQualified;
|
||||
Tcl_IncrRefCount(fm2Ptr->prefixObj);
|
||||
*newClientData = fm2Ptr;
|
||||
return TCL_OK;
|
||||
|
||||
+3
-35
@@ -97,7 +97,6 @@ typedef struct ThreadSpecificData {
|
||||
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
static void ContLineLocFree(char *clientData);
|
||||
static void TclThreadFinalizeContLines(ClientData clientData);
|
||||
static ThreadSpecificData *TclGetContLineTable(void);
|
||||
|
||||
@@ -805,14 +804,7 @@ TclThreadFinalizeContLines(
|
||||
|
||||
for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
|
||||
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
|
||||
/*
|
||||
* We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
|
||||
* here we can be sure that the compiler will not hold references to
|
||||
* the data in the hashtable, and using TEF might bork the
|
||||
* finalization sequence.
|
||||
*/
|
||||
|
||||
ContLineLocFree(Tcl_GetHashValue(hPtr));
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
|
||||
@@ -820,30 +812,6 @@ TclThreadFinalizeContLines(
|
||||
tsdPtr->lineCLPtr = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* ContLineLocFree --
|
||||
*
|
||||
* The freProc for continuation line location tables.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Releases memory.
|
||||
*
|
||||
* TIP #280
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
ContLineLocFree(
|
||||
char *clientData)
|
||||
{
|
||||
ckfree(clientData);
|
||||
}
|
||||
|
||||
/*
|
||||
*--------------------------------------------------------------
|
||||
*
|
||||
@@ -1405,7 +1373,7 @@ TclFreeObj(
|
||||
if (tsdPtr->lineCLPtr) {
|
||||
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
|
||||
if (hPtr) {
|
||||
Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
}
|
||||
@@ -1496,7 +1464,7 @@ TclFreeObj(
|
||||
if (tsdPtr->lineCLPtr) {
|
||||
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
|
||||
if (hPtr) {
|
||||
Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
}
|
||||
|
||||
+7
-8
@@ -15,6 +15,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclParse.h"
|
||||
#include <assert.h>
|
||||
|
||||
/*
|
||||
* The following table provides parsing information about each possible 8-bit
|
||||
@@ -1567,6 +1568,7 @@ Tcl_ParseVar(
|
||||
|
||||
code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
|
||||
NULL, 1, NULL, NULL);
|
||||
Tcl_FreeParse(parsePtr);
|
||||
TclStackFree(interp, parsePtr);
|
||||
if (code != TCL_OK) {
|
||||
return NULL;
|
||||
@@ -1577,16 +1579,13 @@ Tcl_ParseVar(
|
||||
* At this point we should have an object containing the value of a
|
||||
* variable. Just return the string from that object.
|
||||
*
|
||||
* This should have returned the object for the user to manage, but
|
||||
* instead we have some weak reference to the string value in the object,
|
||||
* which is why we make sure the object exists after resetting the result.
|
||||
* This isn't ideal, but it's the best we can do with the current
|
||||
* documented interface. -- hobbs
|
||||
* Since TclSubstTokens above returned TCL_OK, we know that objPtr
|
||||
* is shared. It is in both the interp result and the value of the
|
||||
* variable. Returning the string relies on that to be true.
|
||||
*/
|
||||
|
||||
if (!Tcl_IsShared(objPtr)) {
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
}
|
||||
assert( Tcl_IsShared(objPtr) );
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
return TclGetString(objPtr);
|
||||
}
|
||||
|
||||
+4
-4
@@ -271,8 +271,8 @@ Tcl_ProcObjCmd(
|
||||
cfPtr->data.eval.path = contextPtr->data.eval.path;
|
||||
Tcl_IncrRefCount(cfPtr->data.eval.path);
|
||||
|
||||
cfPtr->cmd.str.cmd = NULL;
|
||||
cfPtr->cmd.str.len = 0;
|
||||
cfPtr->cmd = NULL;
|
||||
cfPtr->len = 0;
|
||||
|
||||
hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
|
||||
procPtr, &isNew);
|
||||
@@ -2595,8 +2595,8 @@ SetLambdaFromAny(
|
||||
cfPtr->data.eval.path = contextPtr->data.eval.path;
|
||||
Tcl_IncrRefCount(cfPtr->data.eval.path);
|
||||
|
||||
cfPtr->cmd.str.cmd = NULL;
|
||||
cfPtr->cmd.str.len = 0;
|
||||
cfPtr->cmd = NULL;
|
||||
cfPtr->len = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+23
-5
@@ -1555,14 +1555,14 @@ DelCallbackProc(
|
||||
*
|
||||
* TestdelCmd --
|
||||
*
|
||||
* This procedure implements the "testdcall" command. It is used
|
||||
* to test Tcl_CallWhenDeleted.
|
||||
* This procedure implements the "testdel" command. It is used
|
||||
* to test calling of command deletion callbacks.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* Creates and deletes interpreters.
|
||||
* Creates a command.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -4408,8 +4408,26 @@ TestseterrorcodeCmd(
|
||||
Tcl_SetResult(interp, "too many args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
|
||||
argv[5], NULL);
|
||||
switch (argc) {
|
||||
case 1:
|
||||
Tcl_SetErrorCode(interp, "NONE", NULL);
|
||||
break;
|
||||
case 2:
|
||||
Tcl_SetErrorCode(interp, argv[1], NULL);
|
||||
break;
|
||||
case 3:
|
||||
Tcl_SetErrorCode(interp, argv[1], argv[2], NULL);
|
||||
break;
|
||||
case 4:
|
||||
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL);
|
||||
break;
|
||||
case 5:
|
||||
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL);
|
||||
break;
|
||||
case 6:
|
||||
Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4],
|
||||
argv[5], NULL);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -1558,7 +1558,7 @@ Tcl_UniCharIsSpace(
|
||||
return TclIsSpaceProc((char) ch);
|
||||
} else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
|
||||
|| (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
|
||||
|| (Tcl_UniChar) ch == 0xfeff) {
|
||||
|| (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
|
||||
return 1;
|
||||
} else {
|
||||
return ((SPACE_BITS >> GetCategory(ch)) & 1);
|
||||
|
||||
+1
-2
@@ -3580,10 +3580,9 @@ UpdateStringOfEndOffset(
|
||||
register Tcl_Obj *objPtr)
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE + 5];
|
||||
register int len;
|
||||
register int len = 3;
|
||||
|
||||
memcpy(buffer, "end", 4);
|
||||
len = sizeof("end") - 1;
|
||||
if (objPtr->internalRep.longValue != 0) {
|
||||
buffer[len++] = '-';
|
||||
len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
|
||||
|
||||
+48
-17
@@ -513,6 +513,32 @@ proc auto_mkindex_parser::fullname {name} {
|
||||
return [string map [list \0 \$] $name]
|
||||
}
|
||||
|
||||
# auto_mkindex_parser::indexEntry --
|
||||
#
|
||||
# Used by commands like "proc" within the auto_mkindex parser to add a
|
||||
# correctly-quoted entry to the index. This is shared code so it is done
|
||||
# *right*, in one place.
|
||||
#
|
||||
# Arguments:
|
||||
# name - Name that is being added to index.
|
||||
|
||||
proc auto_mkindex_parser::indexEntry {name} {
|
||||
variable index
|
||||
variable scriptFile
|
||||
|
||||
# We convert all metacharacters to their backslashed form, and pre-split
|
||||
# the file name that we know about (which will be a proper list, and so
|
||||
# correctly quoted).
|
||||
|
||||
set name [string range [list \}[fullname $name]] 2 end]
|
||||
set filenameParts [file split $scriptFile]
|
||||
|
||||
append index [format \
|
||||
{set auto_index(%s) [list source [file join $dir %s]]%s} \
|
||||
$name $filenameParts \n]
|
||||
return
|
||||
}
|
||||
|
||||
if {[llength $::auto_mkindex_parser::initCommands]} {
|
||||
return
|
||||
}
|
||||
@@ -524,15 +550,7 @@ if {[llength $::auto_mkindex_parser::initCommands]} {
|
||||
# Adds an entry to the auto index list for the given procedure name.
|
||||
|
||||
auto_mkindex_parser::command proc {name args} {
|
||||
variable index
|
||||
variable scriptFile
|
||||
# Do some fancy reformatting on the "source" call to handle platform
|
||||
# differences with respect to pathnames. Use format just so that the
|
||||
# command is a little easier to read (otherwise it'd be full of
|
||||
# backslashed dollar signs, etc.
|
||||
append index [list set auto_index([fullname $name])] \
|
||||
[format { [list source [file join $dir %s]]} \
|
||||
[file split $scriptFile]] "\n"
|
||||
indexEntry $name
|
||||
}
|
||||
|
||||
# Conditionally add support for Tcl byte code files. There are some tricky
|
||||
@@ -559,14 +577,7 @@ auto_mkindex_parser::hook {
|
||||
# procedure name.
|
||||
|
||||
auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
|
||||
variable index
|
||||
variable scriptFile
|
||||
# Do some nice reformatting of the "source" call, to get around
|
||||
# path differences on different platforms. We use the format
|
||||
# command just so that the code is a little easier to read.
|
||||
append index [list set auto_index([fullname $name])] \
|
||||
[format { [list source [file join $dir %s]]} \
|
||||
[file split $scriptFile]] "\n"
|
||||
indexEntry $name
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -610,6 +621,13 @@ auto_mkindex_parser::command namespace {op args} {
|
||||
variable contextStack
|
||||
if {[lindex $args 0] eq "create"} {
|
||||
set name ::[join [lreverse $contextStack] ::]
|
||||
catch {
|
||||
set name [dict get [lrange $args 1 end] -command]
|
||||
if {![string match ::* $name]} {
|
||||
set name ::[join [lreverse $contextStack] ::]$name
|
||||
}
|
||||
regsub -all ::+ $name :: name
|
||||
}
|
||||
# create artifical proc to force an entry in the tclIndex
|
||||
$parser eval [list ::proc $name {} {}]
|
||||
}
|
||||
@@ -617,4 +635,17 @@ auto_mkindex_parser::command namespace {op args} {
|
||||
}
|
||||
}
|
||||
|
||||
# AUTO MKINDEX: oo::class create name ?definition?
|
||||
# Adds an entry to the auto index list for the given class name.
|
||||
auto_mkindex_parser::command oo::class {op name {body ""}} {
|
||||
if {$op eq "create"} {
|
||||
indexEntry $name
|
||||
}
|
||||
}
|
||||
auto_mkindex_parser::command class {op name {body ""}} {
|
||||
if {$op eq "create"} {
|
||||
indexEntry $name
|
||||
}
|
||||
}
|
||||
|
||||
return
|
||||
|
||||
+1
-1
@@ -324,7 +324,7 @@ proc ::tcl::clock::Initialize {} {
|
||||
{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
|
||||
{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
|
||||
{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires
|
||||
{-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Brasilia
|
||||
{-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
|
||||
{-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
|
||||
{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha
|
||||
{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores
|
||||
|
||||
+7
-4
@@ -16,7 +16,7 @@
|
||||
if {[info commands package] == ""} {
|
||||
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
|
||||
}
|
||||
package require -exact Tcl 8.6.0
|
||||
package require -exact Tcl 8.6.1
|
||||
|
||||
# Compute the auto path to use in this interpreter.
|
||||
# The values on the path come from several locations:
|
||||
@@ -250,7 +250,8 @@ proc unknown args {
|
||||
# Make sure we're not trying to load the same proc twice.
|
||||
#
|
||||
if {[info exists UnknownPending($name)]} {
|
||||
return -code error "self-referential recursion\
|
||||
return -code error -errorcode [list TCL LOOKUP COMMAND $name] \
|
||||
"self-referential recursion\
|
||||
in \"unknown\" for command \"$name\""
|
||||
}
|
||||
set UnknownPending($name) pending
|
||||
@@ -399,10 +400,12 @@ proc unknown args {
|
||||
return -options $::tcl::UnknownOptions $::tcl::UnknownResult
|
||||
}
|
||||
if {[llength $cmds]} {
|
||||
return -code error "ambiguous command name \"$name\": [lsort $cmds]"
|
||||
return -code error -errorcode [list TCL LOOKUP COMMAND $name] \
|
||||
"ambiguous command name \"$name\": [lsort $cmds]"
|
||||
}
|
||||
}
|
||||
return -code error "invalid command name \"$name\""
|
||||
return -code error -errorcode [list TCL LOOKUP COMMAND $name] \
|
||||
"invalid command name \"$name\""
|
||||
}
|
||||
|
||||
# auto_load --
|
||||
|
||||
@@ -9,4 +9,4 @@
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]]
|
||||
package ifneeded tcltest 2.3.6 [list source [file join $dir tcltest.tcl]]
|
||||
|
||||
@@ -22,7 +22,7 @@ namespace eval tcltest {
|
||||
# When the version number changes, be sure to update the pkgIndex.tcl file,
|
||||
# and the install directory in the Makefiles. When the minor version
|
||||
# changes (new feature) be sure to update the man page as well.
|
||||
variable Version 2.3.5
|
||||
variable Version 2.3.6
|
||||
|
||||
# Compatibility support for dumb variables defined in tcltest 1
|
||||
# Do not use these. Call [package provide Tcl] and [info patchlevel]
|
||||
|
||||
@@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} {
|
||||
continue
|
||||
}
|
||||
|
||||
if {[package ifneeded $pkgname $pkgversion] ne {}} {
|
||||
# There's already a provide script registered for
|
||||
# this version of this package. Since all units of
|
||||
# code claiming to be the same version of the same
|
||||
# package ought to be identical, just stick with
|
||||
# the one we already have.
|
||||
continue
|
||||
}
|
||||
|
||||
# We have found a candidate, generate a "provide script"
|
||||
# for it, and remember it. Note that we are using ::list
|
||||
# to do this; locally [list] means something else without
|
||||
|
||||
+1
-1
@@ -39,7 +39,7 @@ needs to conform to the following conventions.
|
||||
distclean: Delete all generated files.
|
||||
|
||||
dist: Produce a copy of the package's source code distribution.
|
||||
Must respect the DIST_ROOT variable determing where to
|
||||
Must respect the DIST_ROOT variable determining where to
|
||||
write the generated directory.
|
||||
|
||||
Packages that are written to make use of the Tcl Extension Architecture (TEA)
|
||||
|
||||
+1
-2
@@ -175,8 +175,7 @@ test assemble-4.1 {syntax error} {
|
||||
-match glob
|
||||
-result {1 {extra characters after close-brace} {extra characters after close-brace
|
||||
while executing
|
||||
"{}extra
|
||||
"
|
||||
"{}e"
|
||||
("assemble" body, line 2)*}}
|
||||
}
|
||||
test assemble-4.2 {null command} {
|
||||
|
||||
+71
-32
@@ -2499,6 +2499,34 @@ test binary-71.9 {binary decode hex} -body {
|
||||
test binary-71.10 {binary decode hex} -body {
|
||||
string length [binary decode hex " "]
|
||||
} -result 0
|
||||
test binary-71.11 {binary decode hex: Bug b98fa55285} -body {
|
||||
apply {{} {
|
||||
set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n"
|
||||
set decoded [binary decode hex $str]
|
||||
list [string length $decoded] [scan [string index $decoded end] %c]
|
||||
}}
|
||||
} -result {29 38}
|
||||
test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body {
|
||||
apply {{} {
|
||||
set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n"
|
||||
set decoded [binary decode hex $str]
|
||||
list [string length $decoded] [scan [string index $decoded end] %c]
|
||||
}}
|
||||
} -result {28 140}
|
||||
test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body {
|
||||
apply {{} {
|
||||
set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n"
|
||||
set decoded [binary decode hex $str]
|
||||
list [string length $decoded] [scan [string index $decoded end] %c]
|
||||
}}
|
||||
} -result {28 140}
|
||||
test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body {
|
||||
apply {{} {
|
||||
set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n"
|
||||
set decoded [binary decode hex $str]
|
||||
list [string length $decoded] [scan [string index $decoded end] %c]
|
||||
}}
|
||||
} -result {28 140}
|
||||
|
||||
test binary-72.1 {binary encode base64} -body {
|
||||
binary encode base64
|
||||
@@ -2677,105 +2705,116 @@ test binary-74.1 {binary encode uuencode} -body {
|
||||
} -returnCodes error -match glob -result "wrong # args: *"
|
||||
test binary-74.2 {binary encode uuencode} -body {
|
||||
binary encode uuencode abc
|
||||
} -result {86)C}
|
||||
} -result {#86)C
|
||||
}
|
||||
test binary-74.3 {binary encode uuencode} -body {
|
||||
binary encode uuencode {}
|
||||
} -result {}
|
||||
test binary-74.4 {binary encode uuencode} -body {
|
||||
binary encode uuencode [string repeat abc 20]
|
||||
} -result [string repeat 86)C 20]
|
||||
} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
|
||||
test binary-74.5 {binary encode uuencode} -body {
|
||||
binary encode uuencode \0\1\2\3\4\0\1\2\3
|
||||
} -result "``\$\"`P0``0(#"
|
||||
} -result ")``\$\"`P0``0(#\n"
|
||||
test binary-74.6 {binary encode uuencode} -body {
|
||||
binary encode uuencode \0
|
||||
} -result {````}
|
||||
} -result {!``
|
||||
}
|
||||
test binary-74.7 {binary encode uuencode} -body {
|
||||
binary encode uuencode \0\0
|
||||
} -result {````}
|
||||
} -result "\"```
|
||||
"
|
||||
test binary-74.8 {binary encode uuencode} -body {
|
||||
binary encode uuencode \0\0\0
|
||||
} -result {````}
|
||||
} -result {#````
|
||||
}
|
||||
test binary-74.9 {binary encode uuencode} -body {
|
||||
binary encode uuencode \0\0\0\0
|
||||
} -result {````````}
|
||||
test binary-74.10 {binary encode uuencode} -body {
|
||||
binary encode uuencode -maxlen 0 -wrapchar | abcabcabc
|
||||
} -result {86)C86)C86)C}
|
||||
test binary-74.11 {binary encode uuencode} -body {
|
||||
binary encode uuencode -maxlen 1 -wrapchar | abcabcabc
|
||||
} -result {8|6|)|C|8|6|)|C|8|6|)|C}
|
||||
} -result {$``````
|
||||
}
|
||||
test binary-74.10 {binary encode uuencode} -returnCodes error -body {
|
||||
binary encode uuencode -foo 30 abcabcabc
|
||||
} -result {bad option "-foo": must be -maxlen or -wrapchar}
|
||||
test binary-74.11 {binary encode uuencode} -returnCodes error -body {
|
||||
binary encode uuencode -maxlen 1 abcabcabc
|
||||
} -result {line length out of range}
|
||||
test binary-74.12 {binary encode uuencode} -body {
|
||||
binary encode uuencode -maxlen 3 -wrapchar | abcabcabc
|
||||
} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|}
|
||||
|
||||
test binary-75.1 {binary decode uuencode} -body {
|
||||
binary decode uuencode
|
||||
} -returnCodes error -match glob -result "wrong # args: *"
|
||||
test binary-75.2 {binary decode uuencode} -body {
|
||||
binary decode uuencode 86)C
|
||||
binary decode uuencode "#86)C\n"
|
||||
} -result {abc}
|
||||
test binary-75.3 {binary decode uuencode} -body {
|
||||
binary decode uuencode {}
|
||||
} -result {}
|
||||
test binary-75.3.1 {binary decode uuencode} -body {
|
||||
binary decode uuencode `\n
|
||||
} -result {}
|
||||
test binary-75.4 {binary decode uuencode} -body {
|
||||
binary decode uuencode [string repeat "86)C" 20]
|
||||
binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
|
||||
} -result [string repeat abc 20]
|
||||
test binary-75.5 {binary decode uuencode} -body {
|
||||
binary decode uuencode "``\$\"`P0``0(#"
|
||||
binary decode uuencode ")``\$\"`P0``0(#"
|
||||
} -result "\0\1\2\3\4\0\1\2\3"
|
||||
test binary-75.6 {binary decode uuencode} -body {
|
||||
string length [binary decode uuencode {`}]
|
||||
string length [binary decode uuencode "`\n"]
|
||||
} -result 0
|
||||
test binary-75.7 {binary decode uuencode} -body {
|
||||
string length [binary decode uuencode {``}]
|
||||
string length [binary decode uuencode "!`\n"]
|
||||
} -result 1
|
||||
test binary-75.8 {binary decode uuencode} -body {
|
||||
string length [binary decode uuencode {```}]
|
||||
string length [binary decode uuencode "\"``\n"]
|
||||
} -result 2
|
||||
test binary-75.9 {binary decode uuencode} -body {
|
||||
string length [binary decode uuencode {````}]
|
||||
string length [binary decode uuencode "#```\n"]
|
||||
} -result 3
|
||||
test binary-75.10 {binary decode uuencode} -body {
|
||||
set s "[string repeat 86)C 10]\n[string repeat 86)C 10]"
|
||||
set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]"
|
||||
binary decode uuencode $s
|
||||
} -result [string repeat abc 20]
|
||||
test binary-75.11 {binary decode uuencode} -body {
|
||||
set s "[string repeat 86)C 10]\n [string repeat 86)C 10]"
|
||||
set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r"
|
||||
binary decode uuencode $s
|
||||
} -result [string repeat abc 20]
|
||||
test binary-75.12 {binary decode uuencode} -body {
|
||||
binary decode uuencode -strict "|86)C"
|
||||
} -returnCodes error -match glob -result {invalid uuencode character "|" at position 0}
|
||||
test binary-75.13 {binary decode uuencode} -body {
|
||||
set s "[string repeat 86)C 10]|[string repeat 86)C 10]"
|
||||
set s ">[string repeat 86)C 10]|[string repeat 86)C 10]"
|
||||
binary decode uuencode -strict $s
|
||||
} -returnCodes error -match glob -result {invalid uuencode character "|" at position 40}
|
||||
} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41}
|
||||
test binary-75.14 {binary decode uuencode} -body {
|
||||
set s "[string repeat 86)C 10]\n [string repeat 86)C 10]"
|
||||
set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]"
|
||||
binary decode uuencode -strict $s
|
||||
} -returnCodes error -match glob -result {invalid uuencode character *}
|
||||
test binary-75.20 {binary decode uuencode} -body {
|
||||
set r [binary decode uuencode 8]
|
||||
set r [binary decode uuencode " 8"]
|
||||
list [string length $r] $r
|
||||
} -result {0 {}}
|
||||
test binary-75.21 {binary decode uuencode} -body {
|
||||
set r [binary decode uuencode 86]
|
||||
set r [binary decode uuencode "!86"]
|
||||
list [string length $r] $r
|
||||
} -result {1 a}
|
||||
test binary-75.22 {binary decode uuencode} -body {
|
||||
set r [binary decode uuencode 86)]
|
||||
set r [binary decode uuencode "\"86)"]
|
||||
list [string length $r] $r
|
||||
} -result {2 ab}
|
||||
test binary-75.23 {binary decode uuencode} -body {
|
||||
set r [binary decode uuencode 86)C]
|
||||
set r [binary decode uuencode "#86)C"]
|
||||
list [string length $r] $r
|
||||
} -result {3 abc}
|
||||
test binary-75.24 {binary decode uuencode} -body {
|
||||
set s "04)\# "
|
||||
set s "#04)\# "
|
||||
binary decode uuencode $s
|
||||
} -result ABC
|
||||
test binary-75.25 {binary decode uuencode} -body {
|
||||
set s "04)\#z"
|
||||
set s "#04)\#z"
|
||||
binary decode uuencode $s
|
||||
} -returnCodes error -match glob -result {invalid uuencode character "z" at position 4}
|
||||
} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5}
|
||||
test binary-75.26 {binary decode uuencode} -body {
|
||||
string length [binary decode uuencode " "]
|
||||
} -result 0
|
||||
|
||||
@@ -609,6 +609,39 @@ test coroutine-7.3 {yielding between coroutines} -body {
|
||||
} -cleanup {
|
||||
catch {rename juggler ""}
|
||||
} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
|
||||
|
||||
test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
|
||||
proc foo {a b} {catch yield; return 1}
|
||||
} -cleanup {
|
||||
rename foo {}
|
||||
} -body {
|
||||
coroutine demo lsort -command foo {a b}
|
||||
} -result {b a}
|
||||
|
||||
test coroutine-7.5 {return codes} {
|
||||
set result {}
|
||||
foreach code {0 1 2 3 4 5} {
|
||||
lappend result [catch {coroutine demo return -level 0 -code $code}]
|
||||
}
|
||||
set result
|
||||
} {0 1 2 3 4 5}
|
||||
|
||||
test coroutine-7.6 {Early yield crashes} {
|
||||
proc foo args {}
|
||||
trace add execution foo enter {catch yield}
|
||||
coroutine demo foo
|
||||
rename foo {}
|
||||
} {}
|
||||
|
||||
test coroutine-7.7 {Bug 2486550} -setup {
|
||||
interp hide {} yield
|
||||
} -body {
|
||||
coroutine demo interp invokehidden {} yield ok
|
||||
} -cleanup {
|
||||
demo
|
||||
interp expose {} yield
|
||||
} -result ok
|
||||
|
||||
|
||||
# cleanup
|
||||
unset lambda
|
||||
|
||||
+73
-2
@@ -1604,7 +1604,7 @@ test dict-23.1 {dict compilation crash: Bug 3487626} {
|
||||
}
|
||||
}} [linenumber]}}
|
||||
} 5
|
||||
test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
|
||||
test dict-23.2 {dict compilation crash: Bug 3487626} {
|
||||
# Something isn't quite right in line number and continuation line
|
||||
# tracking; at time of writing, this test produces 7, not 5, which
|
||||
# indicates that the extra newlines in the non-script argument are
|
||||
@@ -1838,7 +1838,7 @@ test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
|
||||
}
|
||||
}} [linenumber]}}
|
||||
} 5
|
||||
test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug {
|
||||
test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
|
||||
apply {{} {apply {n {
|
||||
set e {}
|
||||
set k {}
|
||||
@@ -1865,6 +1865,77 @@ j
|
||||
}
|
||||
}} [linenumber]}}
|
||||
} 5
|
||||
test dict-23.3 {CompileWord OBOE} {
|
||||
# segfault when buggy
|
||||
apply {{} {tcl::dict::lappend foo bar \
|
||||
[format baz]}}
|
||||
} {bar baz}
|
||||
test dict-23.4 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict set foo {*}{
|
||||
} [return [incr n -[linenumber]]] val
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.5 {CompileWord OBOE} {
|
||||
# segfault when buggy
|
||||
apply {{} {tcl::dict::incr foo \
|
||||
[format bar]}}
|
||||
} {bar 1}
|
||||
test dict-23.6 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict get {a b} {*}{
|
||||
} [return [incr n -[linenumber]]]
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.7 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict for {a b} [return [incr n -[linenumber]]] {*}{
|
||||
} {}
|
||||
}} [linenumber]
|
||||
} 2
|
||||
test dict-23.8 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict update foo {*}{
|
||||
} [return [incr n -[linenumber]]] x {}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.9 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict exists {} {*}{
|
||||
} [return [incr n -[linenumber]]]
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.10 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict with foo {*}{
|
||||
} [return [incr n -[linenumber]]] {}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.11 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict with ::foo {*}{
|
||||
} [return [incr n -[linenumber]]] {}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.12 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict with {*}{
|
||||
} [return [incr n -[linenumber]]] {}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.13 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict with {*}{
|
||||
} [return [incr n -[linenumber]]] {bar}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
test dict-23.14 {CompileWord OBOE} {
|
||||
apply {n {
|
||||
dict with foo {*}{
|
||||
} [return [incr n -[linenumber]]] {bar}
|
||||
}} [linenumber]
|
||||
} 1
|
||||
|
||||
rename linenumber {}
|
||||
test dict-24.22 {dict map results (non-compiled)} {
|
||||
dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
|
||||
|
||||
@@ -182,6 +182,16 @@ test error-4.7 {errorstack via options dict } -body {
|
||||
catch {f 12} m d
|
||||
dict get $d -errorstack
|
||||
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
|
||||
test error-4.8 {errorstack from exec traces} -body {
|
||||
proc foo args {}
|
||||
proc goo {} foo
|
||||
trace add execution foo enter {error bar;#}
|
||||
catch goo m d
|
||||
dict get $d -errorstack
|
||||
} -cleanup {
|
||||
rename goo {}; rename foo {}
|
||||
unset -nocomplain m d
|
||||
} -result {INNER {error bar} CALL goo UP 1}
|
||||
|
||||
# Errors in error command itself
|
||||
|
||||
|
||||
@@ -254,6 +254,17 @@ test foreach-9.1 {compiled empty var list} {
|
||||
list [catch { foo } msg] $msg
|
||||
} {1 {foreach varlist is empty}}
|
||||
|
||||
test foreach-9.2 {line numbers} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
foreach x y {*}{
|
||||
} {return [incr n -[linenumber]]}
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
|
||||
test foreach-10.1 {foreach: [Bug 1671087]} -setup {
|
||||
proc demo {} {
|
||||
set vals {1 2 3 4}
|
||||
|
||||
@@ -2370,6 +2370,31 @@ test info-33.33 {{*}, literal, simple, bytecompiled} -body {
|
||||
namespace delete foo
|
||||
} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
namespace eval foo {}
|
||||
proc foo::bar {} {
|
||||
append x {*}{
|
||||
} [return [info frame 0]]
|
||||
}
|
||||
test info-33.34 {{*}, literal, simple, bytecompiled} -body {
|
||||
reduce [foo::bar]
|
||||
} -cleanup {
|
||||
namespace delete foo
|
||||
} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
namespace eval foo {}
|
||||
proc foo::bar {} {
|
||||
append {*}{
|
||||
} x([return [info frame 0]]) {*}{
|
||||
} a
|
||||
}
|
||||
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
|
||||
reduce [foo::bar]
|
||||
} -cleanup {
|
||||
namespace delete foo
|
||||
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
|
||||
|
||||
# -------------------------------------------------------------------------
|
||||
unset -nocomplain res
|
||||
|
||||
|
||||
@@ -1599,6 +1599,20 @@ test interp-20.50 {Bug 2486550} -setup {
|
||||
} -cleanup {
|
||||
interp delete slave
|
||||
} -returnCodes error -match glob -result *
|
||||
test interp-20.50.1 {Bug 2486550} -setup {
|
||||
interp create slave
|
||||
} -body {
|
||||
slave hide coroutine
|
||||
catch {slave invokehidden coroutine} m o
|
||||
dict get $o -errorinfo
|
||||
} -cleanup {
|
||||
unset -nocomplain m 0
|
||||
interp delete slave
|
||||
} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
|
||||
while executing
|
||||
"coroutine"
|
||||
invoked from within
|
||||
"slave invokehidden coroutine"}
|
||||
|
||||
test interp-21.1 {interp hidden} {
|
||||
interp hidden {}
|
||||
|
||||
+1
-6
@@ -59,12 +59,7 @@ test misc-1.2 {error in variable ref. in command in array reference} {
|
||||
missing close-brace for variable name
|
||||
missing close-brace for variable name
|
||||
while executing
|
||||
"set tst $a([winfo name $\{zz)
|
||||
# this is a bogus comment
|
||||
# this is a bogus comment
|
||||
# this is a bogus comment
|
||||
# this is a bogus comment
|
||||
# this is a ..."
|
||||
"set tst $a([winfo name $\{"
|
||||
(procedure "tstProc" line 4)
|
||||
invoked from within
|
||||
"tstProc"}]
|
||||
|
||||
+131
-2
@@ -2,12 +2,12 @@
|
||||
# Sourcing this file into Tcl runs the tests and generates output for errors.
|
||||
# No output means no errors were found.
|
||||
#
|
||||
# Copyright (c) 2006-2012 Donal K. Fellows
|
||||
# Copyright (c) 2006-2013 Donal K. Fellows
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require TclOO 1.0
|
||||
package require TclOO 1.0.1
|
||||
package require tcltest 2
|
||||
if {"::tcltest" in [namespace children]} {
|
||||
namespace import -force ::tcltest::*
|
||||
@@ -936,6 +936,69 @@ test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
|
||||
} -returnCodes error -cleanup {
|
||||
fooClass destroy
|
||||
} -result {wrong # args: should be "::foo len string"}
|
||||
test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup {
|
||||
oo::object create foo
|
||||
unset -nocomplain ::result
|
||||
set ::result {}
|
||||
} -body {
|
||||
proc ::my {method} {lappend ::result global}
|
||||
oo::objdefine foo {
|
||||
method target {} {lappend ::result instance}
|
||||
forward bar my target
|
||||
method bump {} {
|
||||
set ns [info object namespace ::foo]
|
||||
rename ${ns}::my ${ns}::
|
||||
rename ${ns}:: ${ns}::my
|
||||
}
|
||||
}
|
||||
proc harness {} {
|
||||
foo target
|
||||
foo bar
|
||||
foo target
|
||||
}
|
||||
trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
|
||||
foo target
|
||||
foo bar
|
||||
foo bump
|
||||
foo bar
|
||||
harness
|
||||
} -cleanup {
|
||||
catch {rename harness {}}
|
||||
catch {rename ::my {}}
|
||||
foo destroy
|
||||
} -result {instance instance instance instance instance instance}
|
||||
test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup {
|
||||
oo::class create fooClass
|
||||
fooClass create foo
|
||||
unset -nocomplain ::result
|
||||
set ::result {}
|
||||
} -body {
|
||||
proc ::my {method} {lappend ::result global}
|
||||
oo::define fooClass {
|
||||
method target {} {lappend ::result class}
|
||||
forward bar my target
|
||||
method bump {} {
|
||||
set ns [info object namespace [self]]
|
||||
rename ${ns}::my ${ns}::
|
||||
rename ${ns}:: ${ns}::my
|
||||
}
|
||||
}
|
||||
proc harness {} {
|
||||
foo target
|
||||
foo bar
|
||||
foo target
|
||||
}
|
||||
trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
|
||||
foo target
|
||||
foo bar
|
||||
foo bump
|
||||
foo bar
|
||||
harness
|
||||
} -cleanup {
|
||||
catch {rename harness {}}
|
||||
catch {rename ::my {}}
|
||||
fooClass destroy
|
||||
} -result {class class class class class class}
|
||||
|
||||
test oo-7.1 {OO: inheritance 101} -setup {
|
||||
oo::class create superClass
|
||||
@@ -1776,6 +1839,36 @@ test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
|
||||
} -returnCodes error -cleanup {
|
||||
Foo destroy
|
||||
} -result {wrong # args: should be "::bar <cloned> a b"}
|
||||
test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
|
||||
oo::class create FooClass
|
||||
set result {}
|
||||
} -body {
|
||||
set obj1 [FooClass new]
|
||||
oo::objdefine $obj1 {
|
||||
variable var
|
||||
method m {} {
|
||||
set var foo
|
||||
}
|
||||
method get {} {
|
||||
return $var
|
||||
}
|
||||
export eval
|
||||
}
|
||||
|
||||
$obj1 m
|
||||
lappend result [$obj1 get]
|
||||
set obj2 [oo::copy $obj1]
|
||||
$obj2 eval {
|
||||
set var bar
|
||||
}
|
||||
lappend result [$obj2 get]
|
||||
$obj1 eval {
|
||||
set var grill
|
||||
}
|
||||
lappend result [$obj1 get] [$obj2 get]
|
||||
} -cleanup {
|
||||
FooClass destroy
|
||||
} -result {foo bar grill bar}
|
||||
|
||||
test oo-16.1 {OO: object introspection} -body {
|
||||
info object
|
||||
@@ -3374,6 +3467,42 @@ test oo-34.8 {TIP 380: slots - presence} {
|
||||
test oo-34.9 {TIP 380: slots - presence} {
|
||||
getMethods oo::objdefine::variable
|
||||
} {{-append -clear -set} {Get Set}}
|
||||
|
||||
test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
|
||||
oo::class create fruit {
|
||||
method eat {} {}
|
||||
}
|
||||
set result {}
|
||||
} -body {
|
||||
lappend result [fruit create ::apple] [info class superclasses fruit]
|
||||
oo::define fruit superclass
|
||||
lappend result [info class superclasses fruit] \
|
||||
[info object class apple oo::object] \
|
||||
[info class call fruit destroy] \
|
||||
[catch { apple }]
|
||||
} -cleanup {
|
||||
unset -nocomplain result
|
||||
fruit destroy
|
||||
} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
|
||||
test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
|
||||
oo::class create fruitMetaclass {
|
||||
superclass oo::class
|
||||
method eat {} {}
|
||||
}
|
||||
set result {}
|
||||
} -body {
|
||||
lappend result [fruitMetaclass create ::appleClass] \
|
||||
[appleClass create orange] \
|
||||
[info class superclasses fruitMetaclass]
|
||||
oo::define fruitMetaclass superclass
|
||||
lappend result [info class superclasses fruitMetaclass] \
|
||||
[info object class appleClass oo::class] \
|
||||
[catch { orange }] [info object class orange] \
|
||||
[appleClass create pear]
|
||||
} -cleanup {
|
||||
unset -nocomplain result
|
||||
fruitMetaclass destroy
|
||||
} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
|
||||
|
||||
cleanupTests
|
||||
return
|
||||
|
||||
+1
-1
@@ -7,7 +7,7 @@
|
||||
# See the file "license.terms" for information on usage and redistribution of
|
||||
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require TclOO 1.0
|
||||
package require TclOO 1.0.1
|
||||
package require tcltest 2
|
||||
if {"::tcltest" in [namespace children]} {
|
||||
namespace import -force ::tcltest::*
|
||||
|
||||
@@ -27,6 +27,7 @@ testConstraint testparsevar [llength [info commands testparsevar]]
|
||||
testConstraint testasync [llength [info commands testasync]]
|
||||
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
|
||||
testConstraint testevent [llength [info commands testevent]]
|
||||
testConstraint memory [llength [info commands memory]]
|
||||
|
||||
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
|
||||
testparser [bytestring "foo\0 bar"] -1
|
||||
@@ -678,6 +679,26 @@ test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar
|
||||
unset -nocomplain abc
|
||||
list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
|
||||
} {1 {invalid command name "bogus"}}
|
||||
test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
|
||||
proc getbytes {} {
|
||||
return [lindex [split [memory info] \n] 3 3]
|
||||
}
|
||||
} -body {
|
||||
set a() foo
|
||||
set end [getbytes]
|
||||
for {set i 0} {$i < 5} {incr i} {
|
||||
set vn {}
|
||||
set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
|
||||
if {$res ne {foo bar}} {error "Unexpected result: $res"}
|
||||
|
||||
set tmp $end
|
||||
set end [getbytes]
|
||||
}
|
||||
expr {$end - $tmp}
|
||||
} -cleanup {
|
||||
unset -nocomplain a end i vn res tmp
|
||||
rename getbytes {}
|
||||
} -result 0
|
||||
|
||||
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
|
||||
testparser [bytestring "foo\0 bar"] -1
|
||||
@@ -1097,6 +1118,12 @@ test parse-21.0 {Bug 1884496} testevent {
|
||||
testevent queue a head $::script
|
||||
vwait done
|
||||
} {}
|
||||
test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
|
||||
testevent queue a head {testevent delete a; \
|
||||
set ::done [dict get [info frame 0] line]}
|
||||
vwait done
|
||||
set ::done
|
||||
} 2
|
||||
|
||||
cleanupTests
|
||||
}
|
||||
|
||||
@@ -1155,6 +1155,9 @@ test reg-33.15 {Bug 3603557 - an "in the wild" RE} {
|
||||
(.*) # ConditionalFields
|
||||
}] 0
|
||||
} 68
|
||||
test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} {
|
||||
lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
|
||||
} 1
|
||||
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
|
||||
@@ -876,6 +876,10 @@ test regexp-22.5 {Bug 3610026} -setup {
|
||||
} -cleanup {
|
||||
unset -nocomplain e cp
|
||||
} -returnCodes error -match glob -result {*too many colors*}
|
||||
test regexp-22.6 {Bug 6585b21ca8} {
|
||||
expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"}
|
||||
} rogr
|
||||
|
||||
|
||||
test regexp-23.1 {regexp -all and -line} {
|
||||
set string ""
|
||||
|
||||
@@ -140,6 +140,13 @@ test rename-4.7 {reentrancy issues with command deletion and renaming} testdel {
|
||||
if {[info exists env(value)]} {
|
||||
unset env(value)
|
||||
}
|
||||
test rename-4.8 {Bug a16752c252} testdel {
|
||||
set x broken
|
||||
testdel {} foo {set x ok}
|
||||
proc foo args {}
|
||||
rename foo {}
|
||||
return -level 0 $x[unset x]
|
||||
} ok
|
||||
|
||||
# Save the unknown procedure which is modified by the following test.
|
||||
|
||||
|
||||
@@ -425,6 +425,19 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
|
||||
} -returnCodes error -cleanup {
|
||||
safe::interpDelete $i
|
||||
} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
|
||||
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
|
||||
set i [safe::interpCreate]
|
||||
} -body {
|
||||
catch {interp eval $i {load {} Safepkg1}} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
|
||||
invoked from within
|
||||
"load {} Safepkg1"
|
||||
invoked from within
|
||||
"interp eval $i {load {} Safepkg1}"}
|
||||
test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
|
||||
set i [safe::interpCreate -nostatics]
|
||||
interp eval $i {load {} Safepkg1}
|
||||
@@ -444,6 +457,18 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl
|
||||
} -returnCodes error -cleanup {
|
||||
safe::interpDelete $i
|
||||
} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
|
||||
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
|
||||
set i [safe::interpCreate -nestedloadok]
|
||||
catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
|
||||
invoked from within
|
||||
"load {} Safepkg1 x"
|
||||
invoked from within
|
||||
"interp eval $i {interp create x; load {} Safepkg1 x}"}
|
||||
|
||||
test safe-11.1 {testing safe encoding} -setup {
|
||||
set i [safe::interpCreate]
|
||||
@@ -501,6 +526,23 @@ test safe-11.7 {testing safe encoding} -setup {
|
||||
} -returnCodes error -cleanup {
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
|
||||
test safe-11.7.1 {testing safe encoding} -setup {
|
||||
set i [safe::interpCreate]
|
||||
} -body {
|
||||
catch {interp eval $i encoding convertfrom} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
|
||||
while executing
|
||||
"encoding convertfrom"
|
||||
invoked from within
|
||||
"::interp invokehidden interp1 encoding convertfrom"
|
||||
invoked from within
|
||||
"encoding convertfrom"
|
||||
invoked from within
|
||||
"interp eval $i encoding convertfrom"}
|
||||
test safe-11.8 {testing safe encoding} -setup {
|
||||
set i [safe::interpCreate]
|
||||
} -body {
|
||||
@@ -508,6 +550,23 @@ test safe-11.8 {testing safe encoding} -setup {
|
||||
} -returnCodes error -cleanup {
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertto ?encoding? data"}
|
||||
test safe-11.8.1 {testing safe encoding} -setup {
|
||||
set i [safe::interpCreate]
|
||||
} -body {
|
||||
catch {interp eval $i encoding convertto} m o
|
||||
dict get $o -errorinfo
|
||||
} -returnCodes ok -cleanup {
|
||||
unset -nocomplain m o
|
||||
safe::interpDelete $i
|
||||
} -result {wrong # args: should be "encoding convertto ?encoding? data"
|
||||
while executing
|
||||
"encoding convertto"
|
||||
invoked from within
|
||||
"::interp invokehidden interp1 encoding convertto"
|
||||
invoked from within
|
||||
"encoding convertto"
|
||||
invoked from within
|
||||
"interp eval $i encoding convertto"}
|
||||
|
||||
test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
|
||||
set i [safe::interpCreate]
|
||||
@@ -715,8 +774,29 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup {
|
||||
lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
|
||||
lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
|
||||
} -cleanup {
|
||||
unset -nocomplain msg
|
||||
interp delete $i
|
||||
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
|
||||
test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
|
||||
set i [interp create -safe]
|
||||
} -body {
|
||||
set result [expr {"file" in [interp hidden $i]}]
|
||||
lappend result [interp eval $i {tcl::file::split a/b/c}]
|
||||
lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
|
||||
lappend result [interp invokehidden $i file split a/b/c]
|
||||
lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
|
||||
lappend result [catch {interp invokehidden $i file isdirectory .}]
|
||||
interp expose $i file
|
||||
lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
|
||||
lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo]
|
||||
} -cleanup {
|
||||
unset -nocomplain msg o
|
||||
interp delete $i
|
||||
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file
|
||||
while executing
|
||||
"file isdirectory ."
|
||||
invoked from within
|
||||
"interp eval $i {file isdirectory .}"}}
|
||||
|
||||
### ~ should have no special meaning in paths in safe interpreters
|
||||
test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
|
||||
|
||||
@@ -293,6 +293,10 @@ test subst-13.1 {Bug 3081065} -setup {
|
||||
} -cleanup {
|
||||
removeFile subst13.tcl
|
||||
}
|
||||
test subst-13.2 {Test for segfault} -body {
|
||||
subst {[}
|
||||
} -returnCodes error -result * -match glob
|
||||
|
||||
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
|
||||
@@ -2661,6 +2661,13 @@ test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
|
||||
rename dotrace {}
|
||||
rename foo {}
|
||||
} -result {3 | 0 1 1}
|
||||
|
||||
test trace-40.1 {execution trace errors become command errors} {
|
||||
proc foo args {}
|
||||
trace add execution foo enter {rename foo {}; error bar;#}
|
||||
catch foo m
|
||||
return -level 0 $m[unset m]
|
||||
} bar
|
||||
|
||||
# Delete procedures when done, so we don't clash with other tests
|
||||
# (e.g. foobar will clash with 'unknown' tests).
|
||||
|
||||
@@ -0,0 +1,45 @@
|
||||
# This file contains a collection of tests for the procedures in the file
|
||||
# tclUnixNotify.c. Sourcing this file into Tcl runs the tests and
|
||||
# generates output for errors. No output means no errors were found.
|
||||
#
|
||||
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
||||
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require tcltest 2
|
||||
namespace import -force ::tcltest::*
|
||||
|
||||
testConstraint testfork [llength [info commands testfork]]
|
||||
|
||||
# Test if the notifier thread is well initialized in a forked interpreter
|
||||
# by Tcl_InitNotifier
|
||||
test unixforkevent-1.1 {fork and test writeable event} \
|
||||
-constraints {testfork nonPortable} \
|
||||
-body {
|
||||
set myFolder [makeDirectory unixtestfork]
|
||||
set pid [testfork]
|
||||
if {$pid == 0} {
|
||||
# we are the forked process
|
||||
set result initialized
|
||||
set h [open [file join $myFolder test.txt] w]
|
||||
fileevent $h writable\
|
||||
"set result writable;\
|
||||
after cancel [after 1000 {set result timeout}]"
|
||||
vwait result
|
||||
close $h
|
||||
makeFile $result result.txt $myFolder
|
||||
exit
|
||||
}
|
||||
# we are the original process
|
||||
while {![file readable [file join $myFolder result.txt]]} {}
|
||||
viewFile result.txt $myFolder
|
||||
} \
|
||||
-result {writable} \
|
||||
-cleanup {
|
||||
catch { removeFolder $myFolder }
|
||||
}
|
||||
|
||||
::tcltest::cleanupTests
|
||||
return
|
||||
@@ -414,6 +414,17 @@ test upvar-9.7 {Tcl_UpVar procedure} testupvar {
|
||||
} {1234}
|
||||
catch {unset a}
|
||||
|
||||
test upvar-10.1 {CompileWord OBOE} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
upvar 1 {*}{
|
||||
} [return [incr n -[linenumber]]] x
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
|
||||
#
|
||||
# Tests for 'namespace upvar'. As the implementation is essentially the same as
|
||||
# for 'upvar', we only test that the variables are linked correctly, i.e., we
|
||||
@@ -536,6 +547,38 @@ test upvar-NS-2.2 {TIP 323} -setup {
|
||||
} -cleanup {
|
||||
namespace delete test_ns_1
|
||||
} -result {}
|
||||
|
||||
test upvar-NS-3.1 {CompileWord OBOE} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
namespace upvar {*}{
|
||||
} [return [incr n -[linenumber]]] x y
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
test upvar-NS-3.2 {CompileWord OBOE} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
namespace upvar :: {*}{
|
||||
} [return [incr n -[linenumber]]] x
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
test upvar-NS-3.3 {CompileWord OBOE} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
variable x {*}{
|
||||
} [return [incr n -[linenumber]]]
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
|
||||
|
||||
# cleanup
|
||||
::tcltest::cleanupTests
|
||||
|
||||
@@ -748,6 +748,9 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
|
||||
namespace eval test A useSomeUnlikelyNameHere
|
||||
namespace eval test unset useSomeUnlikelyNameHere
|
||||
} {}
|
||||
test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
|
||||
apply {{} {unset foo [return ok]}}
|
||||
} ok
|
||||
|
||||
test var-16.1 {CallVarTraces: save/restore interp error state} {
|
||||
trace add variable ::errorCode write " ;#"
|
||||
@@ -862,6 +865,19 @@ test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
|
||||
}}
|
||||
array size x
|
||||
} -result 0
|
||||
|
||||
test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
|
||||
proc linenumber {} {dict get [info frame -1] line}
|
||||
} -body {
|
||||
apply {n {
|
||||
set foo bar
|
||||
unset foo {*}{
|
||||
} [return [incr n -[linenumber]]]
|
||||
}} [linenumber]
|
||||
} -cleanup {
|
||||
rename linenumber {}
|
||||
} -result 1
|
||||
|
||||
|
||||
catch {namespace delete ns}
|
||||
catch {unset arr}
|
||||
|
||||
+12
-9
@@ -233,7 +233,7 @@ test zlib-8.7 {transformation and fconfigure} -setup {
|
||||
# Dictionary is that which is proposed _in_ SPDY draft
|
||||
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
|
||||
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
|
||||
test zlib-8.8 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.8 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
} -constraints zlib -body {
|
||||
zlib push compress $outSide -dictionary $spdyDict
|
||||
@@ -250,7 +250,7 @@ test zlib-8.8 {transformtion and fconfigure} -setup {
|
||||
catch {close $outSide}
|
||||
catch {close $inSide}
|
||||
} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
|
||||
test zlib-8.9 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.9 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream decompress]
|
||||
} -constraints zlib -body {
|
||||
@@ -267,7 +267,7 @@ test zlib-8.9 {transformtion and fconfigure} -setup {
|
||||
catch {close $inSide}
|
||||
catch {$strm close}
|
||||
} -result {3064818174 358 358}
|
||||
test zlib-8.10 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.10 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
} -constraints zlib -body {
|
||||
zlib push deflate $outSide -dictionary $spdyDict
|
||||
@@ -276,7 +276,10 @@ test zlib-8.10 {transformtion and fconfigure} -setup {
|
||||
puts -nonewline $outSide $spdyHeaders
|
||||
chan pop $outSide
|
||||
set compressed [read $inSide]
|
||||
catch {zlib inflate $compressed} err opt
|
||||
catch {
|
||||
zlib inflate $compressed
|
||||
throw UNREACHABLE "should be unreachable"
|
||||
} err opt
|
||||
list [string length [zlib deflate $spdyHeaders]] \
|
||||
[string length $compressed] \
|
||||
$err [dict get $opt -errorcode]
|
||||
@@ -284,7 +287,7 @@ test zlib-8.10 {transformtion and fconfigure} -setup {
|
||||
catch {close $outSide}
|
||||
catch {close $inSide}
|
||||
} -result {254 212 {data error} {TCL ZLIB DATA}}
|
||||
test zlib-8.11 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.11 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream inflate]
|
||||
} -constraints zlib -body {
|
||||
@@ -300,7 +303,7 @@ test zlib-8.11 {transformtion and fconfigure} -setup {
|
||||
catch {close $inSide}
|
||||
catch {$strm close}
|
||||
} -result {358 358}
|
||||
test zlib-8.12 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.12 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream compress]
|
||||
} -constraints zlib -body {
|
||||
@@ -317,7 +320,7 @@ test zlib-8.12 {transformtion and fconfigure} -setup {
|
||||
catch {close $inSide}
|
||||
catch {$strm close}
|
||||
} -result {358 358 3064818174}
|
||||
test zlib-8.13 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.13 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream compress]
|
||||
} -constraints zlib -body {
|
||||
@@ -334,7 +337,7 @@ test zlib-8.13 {transformtion and fconfigure} -setup {
|
||||
catch {close $inSide}
|
||||
catch {$strm close}
|
||||
} -result {358 358 3064818174}
|
||||
test zlib-8.14 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.14 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream deflate]
|
||||
} -constraints zlib -body {
|
||||
@@ -350,7 +353,7 @@ test zlib-8.14 {transformtion and fconfigure} -setup {
|
||||
catch {close $inSide}
|
||||
catch {$strm close}
|
||||
} -result {358 358}
|
||||
test zlib-8.15 {transformtion and fconfigure} -setup {
|
||||
test zlib-8.15 {transformation and fconfigure} -setup {
|
||||
lassign [chan pipe] inSide outSide
|
||||
set strm [zlib stream deflate]
|
||||
} -constraints zlib -body {
|
||||
|
||||
+11
-3
@@ -335,7 +335,10 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
|
||||
bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
|
||||
bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
|
||||
|
||||
STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}
|
||||
STUB_LIB_OBJS = tclStubLib.o \
|
||||
tclTomMathStubLib.o \
|
||||
tclOOStubLib.o \
|
||||
${COMPAT_OBJS}
|
||||
|
||||
UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
|
||||
tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
|
||||
@@ -346,6 +349,8 @@ NOTIFY_OBJS = tclUnixNotfy.o
|
||||
|
||||
MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
|
||||
|
||||
CYGWIN_OBJS = tclWinError.o
|
||||
|
||||
DTRACE_OBJ = tclDTrace.o
|
||||
|
||||
ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \
|
||||
@@ -575,6 +580,9 @@ MAC_OSX_SRCS = \
|
||||
$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
|
||||
$(MAC_OSX_DIR)/tclMacOSXNotify.c
|
||||
|
||||
CYGWIN_SRCS = \
|
||||
$(TOP_DIR)/win/tclWinError.c
|
||||
|
||||
DTRACE_HDR = tclDTrace.h
|
||||
|
||||
DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d
|
||||
@@ -842,8 +850,8 @@ install-libraries: libraries
|
||||
done;
|
||||
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
|
||||
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;
|
||||
@echo "Installing package tcltest 2.3.6 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.6.tm;
|
||||
|
||||
@echo "Installing package platform 1.0.12 as a Tcl Module";
|
||||
@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
|
||||
|
||||
Vendored
+10
-105
@@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL=".0"
|
||||
TCL_PATCH_LEVEL=".1"
|
||||
VERSION=${TCL_VERSION}
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
@@ -4821,7 +4821,11 @@ echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you m
|
||||
# Does the pthread-implementation provide
|
||||
# 'pthread_attr_setstacksize' ?
|
||||
|
||||
for ac_func in pthread_attr_setstacksize
|
||||
ac_saved_libs=$LIBS
|
||||
LIBS="$LIBS $THREADS_LIBS"
|
||||
|
||||
|
||||
for ac_func in pthread_attr_setstacksize pthread_atfork
|
||||
do
|
||||
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
|
||||
echo "$as_me:$LINENO: checking for $ac_func" >&5
|
||||
@@ -4922,6 +4926,7 @@ _ACEOF
|
||||
fi
|
||||
done
|
||||
|
||||
LIBS=$ac_saved_libs
|
||||
else
|
||||
TCL_THREADS=0
|
||||
fi
|
||||
@@ -7068,7 +7073,9 @@ fi
|
||||
SHLIB_CFLAGS=""
|
||||
SHLIB_LD='${CC} -shared'
|
||||
SHLIB_SUFFIX=".dll"
|
||||
DL_OBJS="tclLoadDl.o tclWinError.o"
|
||||
DL_OBJS="tclLoadDl.o"
|
||||
PLAT_OBJS='${CYGWIN_OBJS}'
|
||||
PLAT_SRCS='${CYGWIN_SRCS}'
|
||||
DL_LIBS="-ldl"
|
||||
CC_SEARCH_FLAGS=""
|
||||
LD_SEARCH_FLAGS=""
|
||||
@@ -17945,108 +17952,6 @@ if test `eval echo '${'$as_ac_var'}'` = yes; then
|
||||
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
done
|
||||
|
||||
|
||||
for ac_func in pthread_atfork
|
||||
do
|
||||
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
|
||||
echo "$as_me:$LINENO: checking for $ac_func" >&5
|
||||
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
|
||||
if eval "test \"\${$as_ac_var+set}\" = set"; then
|
||||
echo $ECHO_N "(cached) $ECHO_C" >&6
|
||||
else
|
||||
cat >conftest.$ac_ext <<_ACEOF
|
||||
/* confdefs.h. */
|
||||
_ACEOF
|
||||
cat confdefs.h >>conftest.$ac_ext
|
||||
cat >>conftest.$ac_ext <<_ACEOF
|
||||
/* end confdefs.h. */
|
||||
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
|
||||
For example, HP-UX 11i <limits.h> declares gettimeofday. */
|
||||
#define $ac_func innocuous_$ac_func
|
||||
|
||||
/* System header to define __stub macros and hopefully few prototypes,
|
||||
which can conflict with char $ac_func (); below.
|
||||
Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
|
||||
<limits.h> exists even on freestanding compilers. */
|
||||
|
||||
#ifdef __STDC__
|
||||
# include <limits.h>
|
||||
#else
|
||||
# include <assert.h>
|
||||
#endif
|
||||
|
||||
#undef $ac_func
|
||||
|
||||
/* Override any gcc2 internal prototype to avoid an error. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
{
|
||||
#endif
|
||||
/* We use char because int might match the return type of a gcc2
|
||||
builtin and then its argument prototype would still apply. */
|
||||
char $ac_func ();
|
||||
/* The GNU C library defines this for functions which it implements
|
||||
to always fail with ENOSYS. Some functions are actually named
|
||||
something starting with __ and the normal name is an alias. */
|
||||
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
|
||||
choke me
|
||||
#else
|
||||
char (*f) () = $ac_func;
|
||||
#endif
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return f != $ac_func;
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
rm -f conftest.$ac_objext conftest$ac_exeext
|
||||
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
|
||||
(eval $ac_link) 2>conftest.er1
|
||||
ac_status=$?
|
||||
grep -v '^ *+' conftest.er1 >conftest.err
|
||||
rm -f conftest.er1
|
||||
cat conftest.err >&5
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); } &&
|
||||
{ ac_try='test -z "$ac_c_werror_flag"
|
||||
|| test ! -s conftest.err'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; } &&
|
||||
{ ac_try='test -s conftest$ac_exeext'
|
||||
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
|
||||
(eval $ac_try) 2>&5
|
||||
ac_status=$?
|
||||
echo "$as_me:$LINENO: \$? = $ac_status" >&5
|
||||
(exit $ac_status); }; }; then
|
||||
eval "$as_ac_var=yes"
|
||||
else
|
||||
echo "$as_me: failed program was:" >&5
|
||||
sed 's/^/| /' conftest.$ac_ext >&5
|
||||
|
||||
eval "$as_ac_var=no"
|
||||
fi
|
||||
rm -f conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
fi
|
||||
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
|
||||
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
|
||||
if test `eval echo '${'$as_ac_var'}'` = yes; then
|
||||
cat >>confdefs.h <<_ACEOF
|
||||
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
|
||||
_ACEOF
|
||||
|
||||
fi
|
||||
done
|
||||
|
||||
|
||||
+1
-2
@@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL=".0"
|
||||
TCL_PATCH_LEVEL=".1"
|
||||
VERSION=${TCL_VERSION}
|
||||
|
||||
#------------------------------------------------------------------------
|
||||
@@ -576,7 +576,6 @@ if test "`uname -s`" = "Darwin" ; then
|
||||
if test $tcl_corefoundation = yes; then
|
||||
AC_CHECK_HEADERS(libkern/OSAtomic.h)
|
||||
AC_CHECK_FUNCS(OSSpinLockLock)
|
||||
AC_CHECK_FUNCS(pthread_atfork)
|
||||
fi
|
||||
AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
|
||||
AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8",
|
||||
|
||||
+8
-2
@@ -676,7 +676,11 @@ AC_DEFUN([SC_ENABLE_THREADS], [
|
||||
|
||||
# Does the pthread-implementation provide
|
||||
# 'pthread_attr_setstacksize' ?
|
||||
AC_CHECK_FUNCS(pthread_attr_setstacksize)
|
||||
|
||||
ac_saved_libs=$LIBS
|
||||
LIBS="$LIBS $THREADS_LIBS"
|
||||
AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
|
||||
LIBS=$ac_saved_libs
|
||||
else
|
||||
TCL_THREADS=0
|
||||
fi
|
||||
@@ -1224,7 +1228,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
|
||||
SHLIB_CFLAGS=""
|
||||
SHLIB_LD='${CC} -shared'
|
||||
SHLIB_SUFFIX=".dll"
|
||||
DL_OBJS="tclLoadDl.o tclWinError.o"
|
||||
DL_OBJS="tclLoadDl.o"
|
||||
PLAT_OBJS='${CYGWIN_OBJS}'
|
||||
PLAT_SRCS='${CYGWIN_SRCS}'
|
||||
DL_LIBS="-ldl"
|
||||
CC_SEARCH_FLAGS=""
|
||||
LD_SEARCH_FLAGS=""
|
||||
|
||||
+1
-1
@@ -4,7 +4,7 @@
|
||||
|
||||
Name: tcl
|
||||
Summary: Tcl scripting language development environment
|
||||
Version: 8.6.0
|
||||
Version: 8.6.1
|
||||
Release: 2
|
||||
License: BSD
|
||||
Group: Development/Languages
|
||||
|
||||
+3
-3
@@ -115,6 +115,9 @@
|
||||
/* Define to 1 if you have the `gmtime_r' function. */
|
||||
#undef HAVE_GMTIME_R
|
||||
|
||||
/* Compiler support for module scope symbols */
|
||||
#undef HAVE_HIDDEN
|
||||
|
||||
/* Do we have the intptr_t type? */
|
||||
#undef HAVE_INTPTR_T
|
||||
|
||||
@@ -343,9 +346,6 @@
|
||||
/* Do we have <values.h>? */
|
||||
#undef NO_VALUES_H
|
||||
|
||||
/* Compiler support for module scope symbols */
|
||||
#undef HAVE_HIDDEN
|
||||
|
||||
/* Do we have wait3() */
|
||||
#undef NO_WAIT3
|
||||
|
||||
|
||||
+2
-2
@@ -462,10 +462,10 @@ DoCopyFile(
|
||||
switch ((int) (statBufPtr->st_mode & S_IFMT)) {
|
||||
#ifndef DJGPP
|
||||
case S_IFLNK: {
|
||||
char linkBuf[MAXPATHLEN];
|
||||
char linkBuf[MAXPATHLEN+1];
|
||||
int length;
|
||||
|
||||
length = readlink(src, linkBuf, sizeof(linkBuf));
|
||||
length = readlink(src, linkBuf, MAXPATHLEN);
|
||||
/* INTL: Native. */
|
||||
if (length == -1) {
|
||||
return TCL_ERROR;
|
||||
|
||||
+112
-1
@@ -119,6 +119,15 @@ static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
static int notifierCount = 0;
|
||||
|
||||
/*
|
||||
* The following static stores the process ID of the initialized notifier
|
||||
* thread. If it changes, we have passed a fork and we should start a new
|
||||
* notifier thread.
|
||||
*
|
||||
* You must hold the notifierMutex lock before accessing this variable.
|
||||
*/
|
||||
static pid_t processIDInitialized = 0;
|
||||
|
||||
/*
|
||||
* The following variable points to the head of a doubly-linked list of
|
||||
* ThreadSpecificData structures for all threads that are currently waiting on
|
||||
@@ -185,7 +194,13 @@ static Tcl_ThreadId notifierThread;
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
static void NotifierThreadProc(ClientData clientData);
|
||||
#endif
|
||||
#ifdef HAVE_PTHREAD_ATFORK
|
||||
static int atForkInit = 0;
|
||||
static void AtForkPrepare(void);
|
||||
static void AtForkParent(void);
|
||||
static void AtForkChild(void);
|
||||
#endif /* HAVE_PTHREAD_ATFORK */
|
||||
#endif /* TCL_THREADS */
|
||||
static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
|
||||
|
||||
/*
|
||||
@@ -275,11 +290,38 @@ Tcl_InitNotifier(void)
|
||||
*/
|
||||
|
||||
Tcl_MutexLock(¬ifierMutex);
|
||||
#ifdef HAVE_PTHREAD_ATFORK
|
||||
/*
|
||||
* Install pthread_atfork handlers to reinitialize the notifier in the
|
||||
* child of a fork.
|
||||
*/
|
||||
|
||||
if (!atForkInit) {
|
||||
int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
|
||||
|
||||
if (result) {
|
||||
Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
|
||||
}
|
||||
atForkInit = 1;
|
||||
}
|
||||
#endif
|
||||
/*
|
||||
* Check if my process id changed, e.g. I was forked
|
||||
* In this case, restart the notifier thread and close the
|
||||
* pipe to the original notifier thread
|
||||
*/
|
||||
if (notifierCount > 0 && processIDInitialized != getpid()) {
|
||||
notifierCount = 0;
|
||||
processIDInitialized = 0;
|
||||
close(triggerPipe);
|
||||
triggerPipe = -1;
|
||||
}
|
||||
if (notifierCount == 0) {
|
||||
if (TclpThreadCreate(¬ifierThread, NotifierThreadProc, NULL,
|
||||
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
|
||||
Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
|
||||
}
|
||||
processIDInitialized = getpid();
|
||||
}
|
||||
notifierCount++;
|
||||
|
||||
@@ -1270,6 +1312,75 @@ NotifierThreadProc(
|
||||
|
||||
TclpThreadExit(0);
|
||||
}
|
||||
|
||||
#ifdef HAVE_PTHREAD_ATFORK
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* AtForkPrepare --
|
||||
*
|
||||
* Lock the notifier in preparation for a fork.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
AtForkPrepare(void)
|
||||
{
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* AtForkParent --
|
||||
*
|
||||
* Unlock the notifier in the parent after a fork.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
AtForkParent(void)
|
||||
{
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* AtForkChild --
|
||||
*
|
||||
* Unlock and reinstall the notifier in the child after a fork.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
AtForkChild(void)
|
||||
{
|
||||
notifierMutex = NULL;
|
||||
notifierCV = NULL;
|
||||
Tcl_InitNotifier();
|
||||
}
|
||||
#endif /* HAVE_PTHREAD_ATFORK */
|
||||
|
||||
#endif /* TCL_THREADS */
|
||||
|
||||
#endif /* !HAVE_COREFOUNDATION */
|
||||
|
||||
@@ -1358,6 +1358,7 @@ Tcl_OpenTcpServer(
|
||||
my_errno = errno;
|
||||
}
|
||||
close(sock);
|
||||
sock = -1;
|
||||
continue;
|
||||
}
|
||||
if (port == 0 && chosenport == 0) {
|
||||
@@ -1380,6 +1381,7 @@ Tcl_OpenTcpServer(
|
||||
my_errno = errno;
|
||||
}
|
||||
close(sock);
|
||||
sock = -1;
|
||||
continue;
|
||||
}
|
||||
if (statePtr == NULL) {
|
||||
|
||||
@@ -67,6 +67,7 @@ static Tcl_CmdProc TestchmodCmd;
|
||||
static Tcl_CmdProc TestfilehandlerCmd;
|
||||
static Tcl_CmdProc TestfilewaitCmd;
|
||||
static Tcl_CmdProc TestfindexecutableCmd;
|
||||
static Tcl_ObjCmdProc TestforkObjCmd;
|
||||
static Tcl_CmdProc TestgetdefencdirCmd;
|
||||
static Tcl_CmdProc TestgetopenfileCmd;
|
||||
static Tcl_CmdProc TestgotsigCmd;
|
||||
@@ -103,6 +104,8 @@ TclplatformtestInit(
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
|
||||
@@ -526,6 +529,52 @@ TestsetdefencdirCmd(
|
||||
Tcl_SetDefaultEncodingDir(argv[1]);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TestforkObjCmd --
|
||||
*
|
||||
* This function implements the "testfork" command. It is used to
|
||||
* fork the Tcl process for specific test cases.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
TestforkObjCmd(
|
||||
ClientData clientData, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const *objv) /* Argument strings. */
|
||||
{
|
||||
pid_t pid;
|
||||
|
||||
if (objc != 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
pid = fork();
|
||||
if (pid == -1) {
|
||||
Tcl_AppendResult(interp,
|
||||
"Cannot fork", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#if !defined(HAVE_PTHREAD_ATFORK) || defined(MAC_OSX_TCL)
|
||||
/* Only needed when pthread_atfork is not present or on OSX. */
|
||||
if (pid==0) {
|
||||
Tcl_InitNotifier();
|
||||
}
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
+1
-1
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
|
||||
TCLOO_INCLUDE_SPEC=""
|
||||
TCLOO_PRIVATE_INCLUDE_SPEC=""
|
||||
TCLOO_CFLAGS=""
|
||||
TCLOO_VERSION=1.0
|
||||
TCLOO_VERSION=1.0.1
|
||||
|
||||
+6
-6
@@ -584,23 +584,23 @@ install-binaries: binaries
|
||||
fi; \
|
||||
done
|
||||
@if [ -f $(DDE_DLL_FILE) ]; then \
|
||||
echo installing $(DDE_DLL_FILE); \
|
||||
echo Installing $(DDE_DLL_FILE); \
|
||||
$(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
|
||||
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
|
||||
$(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
|
||||
fi
|
||||
@if [ -f $(DDE_LIB_FILE) ]; then \
|
||||
echo installing $(DDE_LIB_FILE); \
|
||||
echo Installing $(DDE_LIB_FILE); \
|
||||
$(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
|
||||
fi
|
||||
@if [ -f $(REG_DLL_FILE) ]; then \
|
||||
echo installing $(REG_DLL_FILE); \
|
||||
echo Installing $(REG_DLL_FILE); \
|
||||
$(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
|
||||
$(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
|
||||
$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
|
||||
fi
|
||||
@if [ -f $(REG_LIB_FILE) ]; then \
|
||||
echo installing $(REG_LIB_FILE); \
|
||||
echo Installing $(REG_LIB_FILE); \
|
||||
$(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
|
||||
fi
|
||||
|
||||
@@ -650,8 +650,8 @@ install-libraries: libraries install-tzdata install-msgs
|
||||
done;
|
||||
@echo "Installing package msgcat 1.5.2 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
|
||||
@echo "Installing package tcltest 2.3.5 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
|
||||
@echo "Installing package tcltest 2.3.6 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.6.tm;
|
||||
@echo "Installing package platform 1.0.12 as a Tcl Module";
|
||||
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm;
|
||||
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
|
||||
|
||||
Vendored
+1
-1
@@ -1311,7 +1311,7 @@ SHELL=/bin/sh
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL=".0"
|
||||
TCL_PATCH_LEVEL=".1"
|
||||
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
|
||||
|
||||
TCL_DDE_VERSION=1.4
|
||||
|
||||
+1
-1
@@ -14,7 +14,7 @@ SHELL=/bin/sh
|
||||
TCL_VERSION=8.6
|
||||
TCL_MAJOR_VERSION=8
|
||||
TCL_MINOR_VERSION=6
|
||||
TCL_PATCH_LEVEL=".0"
|
||||
TCL_PATCH_LEVEL=".1"
|
||||
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
|
||||
|
||||
TCL_DDE_VERSION=1.4
|
||||
|
||||
+14
-14
@@ -409,57 +409,57 @@ $(CAT32): $(WINDIR)\cat.c
|
||||
install-binaries: $(TCLSH)
|
||||
$(MKDIR) "$(BIN_INSTALL_DIR)"
|
||||
$(MKDIR) "$(LIB_INSTALL_DIR)"
|
||||
@echo installing $(TCLDLLNAME)
|
||||
@echo Installing $(TCLDLLNAME)
|
||||
@copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
|
||||
@copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
|
||||
@echo installing "$(TCLSH)"
|
||||
@echo Installing "$(TCLSH)"
|
||||
@copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
|
||||
@echo installing $(TCLSTUBLIBNAME)
|
||||
@echo Installing $(TCLSTUBLIBNAME)
|
||||
@copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"
|
||||
@echo installing $(WINDIR)\tclooConfig.sh
|
||||
@echo Installing $(WINDIR)\tclooConfig.sh
|
||||
@copy "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)"
|
||||
|
||||
install-libraries:
|
||||
-@$(MKDIR) "$(LIB_INSTALL_DIR)"
|
||||
-@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
|
||||
@echo installing http1.0
|
||||
@echo Installing http1.0
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
|
||||
-@copy "$(ROOT)\library\http1.0\http.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
|
||||
-@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
|
||||
@echo installing http2.8
|
||||
@echo Installing http2.8
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.8"
|
||||
-@copy "$(ROOT)\library\http\http.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
|
||||
-@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.8"
|
||||
@echo installing opt0.4
|
||||
@echo Installing opt0.4
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
|
||||
-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
|
||||
-@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
|
||||
@echo installing msgcat1.5
|
||||
@echo Installing msgcat1.5
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
|
||||
-@copy "$(ROOT)\library\msgcat\msgcat.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
|
||||
-@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
|
||||
@echo installing tcltest2.3
|
||||
@echo Installing tcltest2.3
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
|
||||
-@copy "$(ROOT)\library\tcltest\tcltest.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
|
||||
-@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.3"
|
||||
@echo installing platform1.0
|
||||
@echo Installing platform1.0
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
|
||||
-@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
|
||||
-@copy "$(ROOT)\library\platform\shell.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
|
||||
-@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
|
||||
@echo installing $(TCLDDEDLLNAME)
|
||||
@echo Installing $(TCLDDEDLLNAME)
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
|
||||
-@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
|
||||
-@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
|
||||
@echo installing $(TCLREGDLLNAME)
|
||||
@echo Installing $(TCLREGDLLNAME)
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
|
||||
-@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.3"
|
||||
-@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
|
||||
@echo installing encoding files
|
||||
@echo Installing encoding files
|
||||
-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
|
||||
-@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
|
||||
@echo installing library files
|
||||
@echo Installing library files
|
||||
-@copy "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)"
|
||||
-@copy "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)"
|
||||
-@copy "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)"
|
||||
|
||||
+1
-1
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
|
||||
TCLOO_INCLUDE_SPEC=""
|
||||
TCLOO_PRIVATE_INCLUDE_SPEC=""
|
||||
TCLOO_CFLAGS=""
|
||||
TCLOO_VERSION=1.0
|
||||
TCLOO_VERSION=1.0.1
|
||||
|
||||
Reference in New Issue
Block a user