Compare commits

...
Author SHA1 Message Date
dkf 2ce24093a1 Potential fix for issues relating to lack of errorCode setting with unknown command handling. 2013-09-20 13:05:04 +00:00
jan.nijtmans 9e6b54e433 Make sure that panic's during finalization are handled by the custom panicproc not by the default panicproc, because stderr might not be available.
When the default panicproc is in use, this doesn't make any difference.
2013-09-20 09:11:51 +00:00
dgp 39fcdc3c6e merge release 2013-09-20 05:28:59 +00:00
dkf 1479c62f1c [3970f54c4e]: Improved fix that is more tolerant of a single variable varname. 2013-09-19 22:37:06 +00:00
dgp 54a81d4f0e merge trunk 2013-09-19 20:07:41 +00:00
dkf f95a5e7c82 [3970f54c4e]: Corrected regression in argument order processing in [unset]. 2013-09-19 19:37:05 +00:00
dgp 5285fe3ede merge trunk; update changes 2013-09-19 19:10:47 +00:00
dgp 8e1f9e82da comment 2013-09-19 19:02:42 +00:00
dgp fbac621bfc Line numbers wrong in compiled [unset]. 2013-09-19 18:53:01 +00:00
dgp 3cc058aa46 Line numbers wrong in compiled [dict with]. 2013-09-19 17:21:41 +00:00
dgp 3e3649a18e Line numbers wrong in compiled [dict exists]. 2013-09-19 17:01:58 +00:00
dgp d35d4b2c53 Line numbers wrong in compiled [global] and [variable]. 2013-09-19 16:41:04 +00:00
dgp c91c7b7cf1 Line numbers wrong in compiled [global] and [variable]. 2013-09-19 16:33:36 +00:00
dgp b4a00d3ac5 Line numbers wrong in compiled [namespace upvar]. 2013-09-19 16:11:20 +00:00
dgp bfcb6b40d2 renumber tests for branch merge 2013-09-19 16:06:53 +00:00
dgp 2440231062 Line numbers wrong in compiled [namespace upvar]. 2013-09-19 16:04:48 +00:00
dgp 0f1e352369 Line numbers wrong in compiled [upvar]. 2013-09-19 15:57:38 +00:00
dgp aed9fbb19c Line numbers wrong in compiled [upvar]. 2013-09-19 15:44:21 +00:00
dgp 4551ca9b2c Line numbers wrong in compiled [dict update]. 2013-09-19 15:05:55 +00:00
dgp e4dfb0d689 Line numbers wrong in compiled [dict update]. 2013-09-19 15:04:47 +00:00
dgp 63e65ca6f1 Line numbers wrong in compiled [dict for]. 2013-09-19 14:56:29 +00:00
dgp 7887926261 Line numbers wrong in compiled [dict for]. 2013-09-19 14:55:05 +00:00
dgp 91eca443b7 Line numbers wrong in compiled [dict get]. 2013-09-19 14:49:28 +00:00
dgp cb5d76ed2b Line numbers wrong in compiled [dict get]. 2013-09-19 14:48:02 +00:00
dgp 10372d985a Stop segfault due to OBOE in CompileWord() calls in [dict incr] compiler. 2013-09-19 14:22:37 +00:00
dkf 5aee161167 [3606943]: Corrected description of method search order. 2013-09-19 14:21:21 +00:00
dgp 657b49a9d1 Stop segfault due to OBOE in CompileWord() calls in [dict incr] compiler. 2013-09-19 14:06:46 +00:00
dgp bbf4d17089 [31661d2135] Plug memory leak. 2013-09-19 13:44:18 +00:00
dgp 4a2c3b6440 [31661d2135] Plug memory leak. 2013-09-19 13:39:40 +00:00
dgp 3f481feba6 Line numbers wrong in compiled [dict set]. 2013-09-19 13:13:00 +00:00
dgp 1b0845930c Line numbers wrong in compiled [dict set]. 2013-09-19 13:06:06 +00:00
jan.nijtmans 50a0b81579 consistant use of capitals 2013-09-19 13:00:02 +00:00
jan.nijtmans ad07565ec0 consistant use of capitals. 2013-09-19 12:37:13 +00:00
dgp 3b93da87b3 Merge test; bug already fixed in trunk. 2013-09-19 12:22:25 +00:00
dgp a414da9341 Line numbers wrong in compiled foreach body. 2013-09-19 12:20:13 +00:00
dgp 345bd636d4 Stop segfault due to OBOE in CompileWord() calls in [dict lappend] compiler. 2013-09-19 04:27:11 +00:00
dgp 134ada8ff9 Stop segfault due to OBOE in CompileWord() calls in [dict lappend] compiler. 2013-09-19 04:20:53 +00:00
dgp 3204893f09 [3487626] knownBug tests dict-23.2 and dist-24.21 already fixed on trunk. 2013-09-19 04:11:01 +00:00
dgp 7bc81bcbb0 [3487626] Backport fix for knownBug test dict-23.2. 2013-09-19 04:03:57 +00:00
dgp 6d44125712 merge release 2013-09-18 19:13:31 +00:00
dkf a2df72aecb Bump TclOO version to 1.0.1 2013-09-18 12:32:26 +00:00
dgp 85c48e5e91 merge trunk; update changes 2013-09-17 12:17:40 +00:00
dkf d4d8f3201a [2152292]: Corrected implementation of uuencode handling to support line length
indicator bytes.

***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-17 09:24:41 +00:00
dkf debbae5fd9 ChangeLog entry 2013-09-17 09:20:58 +00:00
dkf 649d0983f9 small improvements to the documentation 2013-09-17 09:13:40 +00:00
dgp 3146ffb96b [7b32d8d13b] Insert missing field initialization. 2013-09-16 23:18:54 +00:00
dgp f1a2117967 merge trunk; update changes 2013-09-16 18:59:14 +00:00
dkf 2044cba5ac Refactor to remove unused flexibility. 2013-09-16 09:03:50 +00:00
dkf eee6883d2a Be careful: separator needs to be bytes, not internal-encoded. 2013-09-16 08:52:12 +00:00
jan.nijtmans 472fd0a636 Add back -wrapchar option to "binary encode uuencode" 2013-09-15 16:30:01 +00:00
dkf bfe331b12a And the decoder too. 2013-09-14 18:25:45 +00:00
jan.nijtmans 1092cae12e Hm, this check doesn't really add anything. 2013-09-14 08:59:41 +00:00
jan.nijtmans 54850c7528 Add back -wrapchar option to "binary encode uuencode". 2013-09-14 08:51:23 +00:00
dkf 365b878745 [2152292] Corrected implementation of uuencoding. 2013-09-14 07:07:03 +00:00
dgp 08390e5c47 Added note to ChangeLog pointing to the fossil timeline for better logging. 2013-09-13 16:02:11 +00:00
dgp a52254cce9 merge 8.5; update changes 2013-09-13 14:14:24 +00:00
dgp 5cc8523f8e merge mark 2013-09-13 14:12:40 +00:00
dgp bcb4faa32f [bdd91c7e43] Stop crash due to error in execution stack memory management.
Thanks to azazel for the fix.
2013-09-13 14:09:09 +00:00
jan.nijtmans fa65ef51ba Suggested fix for [bdd91c7e43]: tclsh crashes in [interp delete] 2013-09-13 10:53:32 +00:00
dgp e94119e59b More macro use. 2013-09-13 03:33:43 +00:00
dgp 0440ab215b Push fixup on the stack only when needed. 2013-09-12 19:27:48 +00:00
dgp 27c4d781f4 Swap the two fixups used when compiling the ternary operator.
Push them on the stack only when needed, and pop as soon as possible.
2013-09-12 19:21:20 +00:00
dgp 8fd5bbdc7c Stop allocating JumpFixups for jumps that can never need any fixing up. 2013-09-12 17:42:36 +00:00
dgp 612c7a7d4a Eliminate another surplus storage field. Make a(n ab)use of the existing
JumpFixup fields instead.
2013-09-11 05:07:52 +00:00
dgp c4a5440ed1 Make use of the existing JumpFixup fields. Eliminate extra storage
field 'offset' in JumpList that we don't require.
2013-09-11 04:49:08 +00:00
dgp 822fd2d405 Stop the save and restore of currStackDepth. Just manage it correctly so
it doesn't need correcting.
2013-09-11 02:32:04 +00:00
dkf e723893895 [3609693] Must strip the internal representation of procedure-like methods in
order to ensure that any bound references to instance variables are removed.
2013-09-09 14:12:05 +00:00
dkf e0623615e3 [3609693] Must strip the internal representation of procedure-like methods in
order to ensure that any bound references to instance variables are removed.
2013-09-09 13:34:06 +00:00
dkf b348c536f6 merge trunk 2013-09-09 12:34:33 +00:00
dkf 2b788a21e4 [3611643] Stop polluting the global namespace.
Refactor the index entry generation so it is done right, once.
Handle more of [namespace ensemble create]'s behavior.
2013-09-08 10:21:37 +00:00
dgp a8bbc9486a merge 8.5. update changes. 2013-09-08 03:26:12 +00:00
dgp f089b1e4a1 [86ceb4e2b6] Improve reaction when multiple *tm files purport to offer the
same version of the same package. Prefer the file that comes first on the
tm path. Makes TCL*_TM_PATH variables more useful. Thanks to Gustaf Neumann
for the suggestion. 
[a16752c252] Revise (partially revert) bug fix to stop crashes in buggy 
tclcompiler.
2013-09-07 22:19:49 +00:00
dgp bb55ca2e95 [86ceb4e2b6] Improve reaction when multiple *tm files purport to offer the
same version of the same package.  Prefer the file that comes first on
the tm path.  Makes TCL*_TM_PATH variables more useful.  Thanks to
Gustaf Neumann for the suggestion.
2013-09-07 21:36:37 +00:00
dgp 0288a572d8 merge trunk 2013-09-07 21:19:47 +00:00
dgp 1ecf461e41 Partial revert of [a16752c252] bug fix to stop crashes in buggy tclcompiler. 2013-09-07 18:49:55 +00:00
dgp 97f9595151 Partial revert of [a16752c252] bug fix to stop crashes in buggy tclcompiler. 2013-09-05 17:21:41 +00:00
dgp 30710a181c Use ne instead of [string length] for less shimmer risk. 2013-09-05 15:47:29 +00:00
dgp 493b04cbc0 Error in order of #include lines broke some windows builds. 2013-09-05 12:45:11 +00:00
dgp 8938dbcc25 Merge commits to the correct branch -- trunk 2013-09-05 12:35:24 +00:00
dgp db738e7756 [010f4162ef] Repair effect of trace errors on -errorinfo and -errorstack. 2013-09-05 12:31:46 +00:00
dgp c6bb98e763 Cleaned up test command trying to make valgrind happy. 2013-09-04 12:45:51 +00:00
dkf c938932757 [98c8b3ec12] Make test fail in less catastrophic manner. 2013-09-04 09:36:22 +00:00
jan.nijtmans 9878106deb Fix 3 trivial (possible) errors, discovered by covertity.com 2013-09-04 07:22:45 +00:00
dgp 4d70c5f1e1 doc fix exposed by make html 2013-09-03 18:50:08 +00:00
dgp c5cad32cd6 make dist 2013-09-03 17:39:34 +00:00
dgp 6a3868f2cc typo 2013-09-03 17:07:41 +00:00
dgp 3116380710 Favor timeline over ChangeLog 2013-09-03 16:47:50 +00:00
dgp 53dc4dcdee Favor timeline over ChangeLog 2013-09-03 16:45:56 +00:00
dgp 4733e874fc update changes 2013-09-03 16:04:30 +00:00
dgp a313e78ffa some missed changes 2013-09-03 16:04:06 +00:00
dgp 2c3dbea378 Add test and improve errorInfo. 2013-09-02 18:47:07 +00:00
dgp 8520e69f32 [010f4162ef] First step of fix on stammering errorstack. errorstack fixed.
errorinfo revision still under consideration.
2013-09-02 17:59:42 +00:00
jan.nijtmans 54223a5f7e typo 2013-09-02 14:01:00 +00:00
dkf 22515fc47f [b98fa55285]: Fix handling of whitespace at end of hex strings to decode. 2013-09-01 20:08:50 +00:00
dgp 8932701ae7 Bump version number to 8.6.1. 2013-08-30 22:04:12 +00:00
dgp 6b45d21b4b Bump to tcltest 2.3.6 to account for changes since Tcl 8.6.0 release. 2013-08-30 21:57:26 +00:00
dgp 3adc645802 fix date 2013-08-30 14:31:06 +00:00
dgp 743ced9da3 changes 2013-08-30 14:16:05 +00:00
dgp b9ef276505 Bump to 8.5.15 for release. 2013-08-29 20:08:04 +00:00
dgp ebd7e8a86b [2486550] NR-enable same-interp invokehidden. Also, reroute all objProc
invocation through the common routines of EvalObjvCore and Dispatch.
2013-08-29 19:19:32 +00:00
dkf 6b6685b8fd define tests for this bug; no fix yet 2013-08-21 09:35:50 +00:00
dgp 5684ad8d94 Possible improvement in light of [86ceb4e2b6]. 2013-07-15 19:09:59 +00:00
53 changed files with 1179 additions and 341 deletions
+65 -9
View File
@@ -1,3 +1,58 @@
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
@@ -36,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>
@@ -153,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>
@@ -174,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 -1
View File
@@ -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.
+138 -1
View File
@@ -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
+21 -5
View File
@@ -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), tcl_platform(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:
+1 -1
View File
@@ -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.
+7 -4
View File
@@ -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
View File
@@ -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"
/*
*----------------------------------------------------------------------------
+1
View File
@@ -2617,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;
+44 -8
View File
@@ -2175,7 +2175,8 @@ Tcl_CreateCommand(
*
* Side effects:
* If a command named "cmdName" already exists for interp, it is
* first deleted. Then the new command is created from the arguments.
* first deleted. Then the new command is created from the arguments.
* [***] (See below for exception).
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
@@ -2242,8 +2243,27 @@ Tcl_CreateObjCommand(
if (!isNew) {
cmdPtr = Tcl_GetHashValue(hPtr);
/* Command already exists. */
/*
* Command already exists; delete it. Be careful to preserve any
* [***] This is wrong. See Tcl Bug a16752c252.
* However, this buggy behavior is kept under particular
* circumstances to accommodate deployed binaries of the
* "tclcompiler" program. http://sourceforge.net/projects/tclpro/
* that crash if the bug is fixed.
*/
if (cmdPtr->objProc == TclInvokeStringCommand
&& cmdPtr->clientData == clientData
&& cmdPtr->deleteData == clientData
&& cmdPtr->deleteProc == deleteProc) {
cmdPtr->objProc = proc;
cmdPtr->objClientData = clientData;
return (Tcl_Command) cmdPtr;
}
/*
* Otherwise, we delete the old command. Be careful to preserve any
* existing import links so we can restore them down below. That way,
* you can redefine a command and its import status will remain
* intact.
@@ -4679,6 +4699,15 @@ TEOV_RunEnterTraces(
TclCleanupCommandMacro(cmdPtr);
if (traceCode != TCL_OK) {
if (traceCode == TCL_ERROR) {
Tcl_Obj *info;
TclNewLiteralStringObj(info, "\n (enter trace on \"");
Tcl_AppendLimitedToObj(info, command, length, 55, "...");
Tcl_AppendToObj(info, "\")", 2);
Tcl_AppendObjToErrorInfo(interp, info);
iPtr->flags |= ERR_ALREADY_LOGGED;
}
return traceCode;
}
if (cmdEpoch != newEpoch) {
@@ -4699,12 +4728,10 @@ TEOV_RunLeaveTraces(
Tcl_Obj *commandPtr = data[1];
Command *cmdPtr = data[2];
Tcl_Obj **objv = data[3];
int length;
const char *command = Tcl_GetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
int length;
const char *command = Tcl_GetStringFromObj(commandPtr, &length);
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
traceCode = TclCheckExecutionTraces(interp, command, length,
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -4714,7 +4741,6 @@ TEOV_RunLeaveTraces(
cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
}
}
Tcl_DecrRefCount(commandPtr);
/*
* As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
@@ -4725,8 +4751,18 @@ TEOV_RunLeaveTraces(
TclCleanupCommandMacro(cmdPtr);
if (traceCode != TCL_OK) {
return traceCode;
if (traceCode == TCL_ERROR) {
Tcl_Obj *info;
TclNewLiteralStringObj(info, "\n (leave trace on \"");
Tcl_AppendLimitedToObj(info, command, length, 55, "...");
Tcl_AppendToObj(info, "\")", 2);
Tcl_AppendObjToErrorInfo(interp, info);
iPtr->flags |= ERR_ALREADY_LOGGED;
}
result = traceCode;
}
Tcl_DecrRefCount(commandPtr);
return result;
}
+251 -55
View File
@@ -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;
}
+21 -28
View File
@@ -839,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;
@@ -868,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);
}
@@ -878,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;
@@ -950,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;
@@ -966,7 +965,7 @@ TclCompileDictGetCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int numWords, i;
int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -979,17 +978,16 @@ TclCompileDictGetCmd(
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;
}
@@ -1004,7 +1002,7 @@ TclCompileDictExistsCmd(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int numWords, i;
int i;
DefineLineInformation; /* TIP #280 */
/*
@@ -1017,17 +1015,16 @@ TclCompileDictExistsCmd(
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;
}
@@ -1426,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
@@ -1635,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);
@@ -1792,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;
}
@@ -1878,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);
@@ -1905,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);
@@ -1919,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, "");
@@ -1954,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);
@@ -2228,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 */
@@ -2309,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);
+20 -13
View File
@@ -85,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);
}
@@ -584,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);
@@ -1899,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;
@@ -2568,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;
}
@@ -2585,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;
@@ -2603,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);
@@ -2625,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;
@@ -2706,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);
+68 -25
View File
@@ -1864,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);
@@ -2814,39 +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 */
/* TODO: Consider support for compiling expanded args. */
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);
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
@@ -2856,7 +2899,7 @@ TclCompileUnsetCmd(
*/
PushVarNameWord(interp, varTokenPtr, envPtr, 0,
&localIndex, &isScalar, 1);
&localIndex, &isScalar, i);
/*
* Emit instructions to unset the variable.
+39 -62
View File
@@ -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);
-2
View File
@@ -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
+1 -1
View File
@@ -4738,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;
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
/*
+1 -1
View File
@@ -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.
+1 -1
View File
@@ -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.
+48 -2
View File
@@ -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);
}
+1 -1
View File
@@ -13,9 +13,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include <assert.h>
#include "tclInt.h"
#include "tclParse.h"
#include <assert.h>
/*
* The following table provides parsing information about each possible 8-bit
+58
View File
@@ -0,0 +1,58 @@
/*
* tclStubLibTbl.c --
*
* Stub object that will be statically linked into extensions that want
* to access Tcl.
*
* Copyright (c) 1998-1999 by Scriptics Corporation.
* Copyright (c) 1998 Paul Duffin.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
/*
*----------------------------------------------------------------------
*
* TclInitStubTable --
*
* Initialize the stub table, using the structure pointed at
* by the "version" argument.
*
* Results:
* Outputs the value of the "version" argument.
*
* Side effects:
* Sets the stub table pointers.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char *
TclInitStubTable(
const char *version) /* points to the version field of a
TclStubInfoType structure variable. */
{
tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
} else {
tclPlatStubsPtr = NULL;
tclIntStubsPtr = NULL;
tclIntPlatStubsPtr = NULL;
}
return version;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
+20 -2
View File
@@ -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 -2
View File
@@ -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));
+43 -26
View File
@@ -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 {} {}]
}
@@ -619,15 +637,14 @@ 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.
foreach cmd {oo::class class} {
auto_mkindex_parser::command $cmd {ecmd name {body ""}} {
if {$cmd eq "create"} {
variable index
variable scriptFile
append index [format "set %s \[list source \[%s]]\n" \
[list auto_index([fullname $name])] \
[list file join $dir {*}[file split $scriptFile]]]
}
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
}
}
+7 -4
View File
@@ -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 --
+1 -1
View File
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]]
package ifneeded tcltest 2.3.6 [list source [file join $dir tcltest.tcl]]
+1 -1
View File
@@ -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]
+9
View File
@@ -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
View File
@@ -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)
+71 -32
View File
@@ -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
+73 -2
View File
@@ -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 }] {
+10
View File
@@ -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
+11
View File
@@ -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}
+32 -2
View File
@@ -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::*
@@ -1839,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
+1 -1
View File
@@ -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::*
+43
View File
@@ -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
+16
View File
@@ -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
View File
@@ -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 {
+2 -2
View File
@@ -850,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;
+1 -1
View File
@@ -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}
#------------------------------------------------------------------------
+1 -1
View File
@@ -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}
#------------------------------------------------------------------------
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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;
+2
View File
@@ -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) {
+1 -1
View File
@@ -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
View File
@@ -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";
+1 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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
View File
@@ -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