Creating branch scriptics-sc-1-1-branch

* README:
* generic/tcl.h: * unix/configure.in: * win/configure.in: * win/README.binary: updated to patchlevel 3
1999-11-19 23:32:56 +00:00 · 1999-11-19 23:32:52 +00:00 · 1999-11-19 23:32:40 +00:00 · 1999-11-19 23:32:24 +00:00 · 1999-11-19 23:32:02 +00:00 · 1999-11-19 23:31:46 +00:00
87 changed files with 2452 additions and 1003 deletions
@@ -1,7 +1,269 @@
+1999-11-19  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* README:
+	* generic/tcl.h:
+	* unix/configure.in:
+	* win/configure.in:
+	* win/README.binary: updated to patchlevel 3
+	* tools/tcl.wse.in: updated to patchlevel 3, as well as making
+	sure tcltest1.0 is installed, and koi-r encoding is installed
+	correctly
+
+	* generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value
+	on NULL input. [Bug: 3400]
+
+	* generic/tclStringObj.c: fixed support for passing in negative
+	length to Tcl_SetUnicodeObj, et al handling routines. [Bug: 3380]
+
+	* tests/http.test: updated http package to 2.2
+	* doc/http.n:
+	* library/http2.1/http.tcl: added register and unregister
+	commands to http:: package (better support for tls/SSL),
+	as well as -type argument to http::geturl. [RFE: 2617]
+	* library/http2.1/http.tcl: Correctly fixed the -timeout
+	problem mentioned in the 10-29 change.  Also added error
+	handling for failed writes on the socket during the protocol.
+
+	* generic/tclBasic.c: removed extra decr of numLevels in
+	Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de)
+
+	* generic/tclEvent.c: fixed possible lack of MutexUnlock in
+	Tcl_DeleteExitHandler [Bug: 3545]
+
+
+1999-11-02  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tagged 8.2.2 final
+	* changes: updated based on ChangeLog
+	* library/dde1.1/pkgIndex.tcl:
+	* library/reg1.0/pkgIndex.tcl: fixed packaging to use the debug
+	versions of the libraries when compiled with symbols [Bug: 3254]
+
+1999-10-30  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* unix/configure.in:
+	* win/configure.in:
+	* README:
+	* mac/README:
+	* win/README.binary:
+	* tools/tcl.wse.in: made demos\twind.tcl install in correct place
+	* generic/tcl.h: updated to patchlevel 2
+
+	All of the following are backported from 8.3 alpha
+
+	* generic/regc_color.c:
+	* generic/regc_cvec.c:
+	* generic/regc_lex.c:
+	* generic/regc_locale.c:
+	* generic/regcomp.c:
+	* generic/regcustom.h:
+	* generic/regerrs.h:
+	* generic/regex.h:
+	* generic/regexec.c:
+	* generic/regguts.h:
+	* generic/tclRegexp.c:
+	* generic/tclTest.c:
+	* tests/reg.test: updated to Henry Spencer's new regexp engine
+	(mid-Sept 99).  Should greatly reduce stack space reqs.
+
+	* library/init.tcl: removed [info nameof]/../bin from auto_path
+
+	* library/http2.1/http.tcl: protected gets with catch [Bug: 2665]
+	Fixed a bug in the handling of
+	the state(status) variable when the -timeout flag is specified.
+	Previously it was possible to leave the status undefined
+	instead of empty, which caused errors in http::status
+
+	* mac/tclMacLoad.c: Stupid bug - we converted the filename to
+	external, but used the unconverted version.
+	* mac/tclMacFCmd.c: Fix a merge error in the bug fix for [Bug: 2869]
+
+	* tests/string.test:
+	* generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj
+	when indexing into one (test case string-5.16) [Bug: 2871]
+
+	* tests/incr.test:
+	* tests/set.test:
+	* generic/tclCompCmds.c: fixed improper bytecode handling of
+	'eval {set array($unknownvar) 5}' (also for incr)
+
+	* unix/tclUnixNotfy.c: fixed event/io threading problems by
+	making triggerPipe non-blocking
+
+	* library/tcltest1.0/tcltest.tcl:
+	* generic/tclThreadTest.c: fixed mem leaks in threads
+
+	* generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA and
+	* generic/tclResult.c: fixed Tcl_AppendResultVA to only
+	iterates once over the va_list (avoiding a memcpy of it,
+	which is not portable).
+
+	* generic/tclCompile.c: removed savedChar trick that appeared to
+	be causing a segv when the literal table was released
+	[Bug: 2459, 2515]
+
+	* generic/tclEnv.c: fixed mem leak with putenv and DStrings
+	and fixed possible ABR error in environ array
+	* tests/encoding.test: fixed test case that change system
+	encoding to a double-byte one (this causes a bogus mem read
+	error for purify)
+	* unix/Makefile.in: purify has to use -best-effort to instrument
+	* unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when
+	doing alloc between vfork and execvp.
+	* unix/tclUnixTest.c: fixed mem leak in findexecutable test command
+
+1999-10-19  Jennifer Hom  <jenn@scriptics.com>
+
+	* library/tcltest1.0/pkgIndex.tcl: Removed nonexistent
+	procs from pkgIndex.tcl.
+	
+	* library/tcltest1.0/tcltest.tcl: Fixed the way that the
+	interactive constraint is set so that it checks the content
+	of the tcl_interactive flag as well as its existence, and removed
+	the extra return at the end of tcltest.tcl.
+
+1999-10-01  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* All frozen for 10/4/99 8.2.1 release
+	* changes: updated from ChangeLog
+	* unix/Makefile.in: added ChangeLog to source dist
+
+1999-09-30  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* unix/configure.in:
+	* win/configure.in: updated patchlevel to 1
+
+1999-09-24  Jennifer Hom  <jenn@scriptics.com>
+
+	* library/tcltest1.0/tcltest.tcl: Changed checks for value of
+	tcl_interactive to checks for existence of tcl_interactive.
+
+1999-09-24  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* mac/tclMacFCmd.c: fixed filename stuff to support UTF-8 [Bug: 2869]
+
+	* win/tclWinSerial.c: changed SerialSetOptionProc to return
+	TCL_OK by default. (patch from Rolf Schroedter)
+
+1999-09-23  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* README:
+	* generic/tcl.h:
+	* tools/tcl.wse.in: updated text to reflect 8.2.1 where necessary
+
+1999-09-22  Jennifer Hom  <jenn@scriptics.com>
+
+	* tests/tcltest.test: Added 'exit' calls to the scripts that the
+	test creates and added tests for -tmpdir and -args.
+	
+	* tests/env.test:
+	* tests/exec.test: Added 'exit' calls to scripts that the tests
+	themselves write.
+
+	* tests/README: Cleaned up documentation in README so that it
+	refers to variables and documentation that actually exist.  Also
+	added missing documentation for flag usage.
+
+	* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a
+	variable named ::tcltest::parameters based on whatever's being
+	sent in as the argument to the -args flag.  Modified tcltest so
+	that tcltest namespace variables are only initialized to their
+	default values if they did not previously exist.  Modified the
+	::tcltest::testConstraints variable so that it isn't unset every
+	time ::tcltest::initConstraints is called.  Modified command line
+	processing so that they are only processed if ::tcltest doesn't
+	have a child namespace (if there is a child namespace, then the
+	command line arguments *must* be processed in that namespace).
+
+1999-09-21  Jeff Hobbs  <hobbs@scriptics.com>
+
+	* tests/env.test:
+	* unix/Makefile.in: added support for AIX LIBPATH env var [Bug:	2793]
+	removed second definition of INCLUDE_INSTALL_DIR (the one that
+	referenced @includedir@) [Bug: 2805]
+	* unix/dltest/Makefile.in: added -lc to LIBS [Bug: 2794]
+
+	* tests/timer.test: changed after delay in timer test 6.29 from
+	1 to 10. [Bug: 2796]
+
+	* tests/pkg.test:
+	* generic/tclPkg.c: fixed package version check to disallow 1.2..3
+	[Bug: 2539]
+
+	* unix/Makefile.in: fixed gendate target - this never worked
+	since RCS was intro'd.
+	* generic/tclGetDate.y: updated to reflect previous changes
+	to tclDate.c (leap year calc) and added CEST and UCT time zone
+	recognition.  Fixed 4 missing UCHAR() casts. [Bug: 2717, 954,
+	1245, 1249]
+
+	* generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really
+	dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc
+	and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719]
+	and changed Tcl_Alloc, et al to not panic when a alloc request
+	for zero came through and NULL was returned (valid on AIX, Tru64)
+	[Bug: 2795, etc]
+
+	* generic/tclIOCmd.c: fixed potential core dump in conjunction
+	with stacked channels with result obj manipulation in
+	Tcl_ReadChars [Bug: 2623]
+
+	* tests/format.test:
+	* generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605]
+
+	* tests/set-old.test:
+	* generic/tclVar.c: Added fix in TclArraySet
+	to check when trying to set in a non-existent namespace. [Bug: 2613]
+
+	* tests/linsert.test:
+	* generic/tclCmdIL.c: fixed end-int interpretation of linsert
+	to correctly calculate value for end, added test and docs [Bug: 2693]
+
+	* doc/switch.n: added proper use of comments to example.
+	* generic/tclCmdMZ.c: changed switch to complain when an error
+	occurs that seems to be due to a misplaced comment.
+
+	* generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions
+	in regsub [Bug: 2723]
+
+	* generic/tclCmdMZ.c: changed [string equal] to return an Int
+	type object (was a Boolean)
+
+	* generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD
+	happy [Bug: 2625]
+
+	* generic/tclProc.c: moved static buf to better location and
+	changed static msg that would overflow in ProcessProcResultCode
+	[Bug: 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd.
+	Also reworked size of static buffers.
+
+	* tests/stringObj.test: added test 9.11
+	* generic/tclStringObj.c: changed Tcl_AppendObjToObj to
+	properly handle the 1-byte dest and mixed src case where
+	both had had Unicode string len checks made on them.  [Bug: 2678]
+
+	* unix/aclocal.m4:
+	* unix/tcl.m4: added -bnoentry to the AIX-* case [Bug: 1909]
+	added fix for FreeBSD-[1-2] recognition
+	[Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610]
+
+	* generic/tclPosixStr.c: fixed typo [Bug: 2592]
+
+	* win/README.binary: fixed version info and some typos [Bug: 2561]
+
+	* generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide
+	headers (pleases HP cc)
+
+	* tests/expr.test:
+	* generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types
+	that cause differed compilation for exprs, to correct the expr
+	double-evaluation problem for vars.  Added test cases.
+	Related to [Bug: 732]
+
 1999-08-05  Jim Ingham  <jingham@cygnus.com>

-        * mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build 
-        directory is separate from the sources.  Much more convenient! 
+	* mac/tclMacProjects.sea.hqx: Rearrange the projects so that the build 
+	directory is separate from the sources.  Much more convenient! 

 1999-08-12  Scott Stanton  <stanton@scriptics.com>

@@ -115,6 +377,13 @@
 	instead to send a message to the socket event window to tell it to
 	terminate its thread.

+1999-07-30  Jennifer Hom  <jenn@scriptics.com>
+
+	* tests/tcltest.test:
+	* library/tcltest1.0/tcltest.tcl: Exit with non-zero status if
+	there were problems with the way the test suite was started
+	(e.g. wrong # arguments).  
+
 1999-07-30  Jeff Hobbs  <hobbs@scriptics.com>

 	* generic/tclInt.decls: added declaractions necessary for the
@@ -1,9 +1,9 @@
 README:  Tcl
-    This is the Tcl 8.2.0 source distribution.
+    This is the Tcl 8.2.3 source distribution.
    You can get this release from:
-        http://www.scriptics.com/registration/8.2.0.tml
+        http://www.scriptics.com/registration/8.2.3.tml

-RCS: @(#) $Id: README,v 1.23 1999/08/10 23:16:25 redman Exp $
+RCS: @(#) $Id: README,v 1.23.2.2 1999/11/19 23:31:26 hobbs Exp $

 Contents
 --------
@@ -50,7 +50,7 @@ Information about new features in 8.2 can be found at
    http://www.scriptics.com/software/whatsnew82.html

 Detailed release notes can be found at
-    http://www.scriptics.com/software/relnotes/tcl8.2.0
+    http://www.scriptics.com/software/relnotes/tcl8.2.3

 Information about Tcl itself can be found at
    http://www.scriptics.com/scripting/
@@ -1,6 +1,6 @@
 Recent user-visible changes to Tcl:

-RCS: @(#) $Id: changes,v 1.50 1999/08/13 18:30:24 redman Exp $
+RCS: @(#) $Id: changes,v 1.50.2.2 1999/11/03 00:42:07 hobbs Exp $

 1. No more [command1] [command2] construct for grouping multiple
 commands on a single command line.
@@ -4640,3 +4640,46 @@ error code. [Bug: 2535] (stanton)

 --------------- Released 8.2.0, August 17, 1999 ----------------------

+9/21/99 (config fixes) fixed several AIX configuration issues.  gcc and
+threading may still cause problems on AIX. (hobbs)
+
+9/21/99 (bug fix) fixed expr double-eval problem. [Bug: 732] (hobbs)
+
+9/21/99 (bug fix) fixed static buffer overflow problem. [Bug: 2483] (hobbs)
+
+9/21/99 (bug fix) fixed end-int linsert interpretation. [Bug: 2693] (hobbs)
+
+9/21/99 (bug fix) fixed bug when setting array in non-existent
+namespace. [Bug: 2613] (hobbs)
+
+--- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---
+
+10/30/99 (feature enhancement) new regexp engine from Henry Spencer
+was patched in - should greatly reduce stack space usage. (spencer)
+
+10/30/99 (bug fix) fixed Purify reported memory leaks in findexecutable
+test command, TclpCreateProcess on Unix, in handling of C environ array,
+and in testthread code.  No more known (reported) mem leaks for Tcl
+built using gcc on Solaris 2.5.1.  Also none reported for Tcl on NT
+(using Purify 6.0). (hobbs)
+
+10/30/99 (bug fix) fixed improper bytecode handling of 
+'eval {set array($unknownvar) 5}' (also for incr) (hobbs)
+
+10/30/99 (bug fix) fixed event/io threading problems by making
+triggerPipe non-blocking (nick kisserbeth)
+
+10/30/99 (bug fix) fixed Tcl_AppendStringsToObjVA and Tcl_AppendResultVA
+to only	iterates once over the va_list (avoiding non-portable memcpy).
+(joe english, hobbs)
+
+10/30/99 (bug fix) removed savedChar trick in tclCompile.c that appeared
+to be causing a segv when the literal table was released.
+[Bug: 2459, 2515] (David Whitehouse)
+
+10/30/99 (bug fix) fixed [string index] to return ByteArrayObj
+when indexing into one (test case string-5.16) [Bug: 2871] (hobbs)
+
+10/30/99 (bug fix) fixes for mac UTF filename handling (ingham)
+
+--- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---
@@ -5,16 +5,16 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: http.n,v 1.5 1999/07/20 00:11:52 hershey Exp $
+'\" RCS: @(#) $Id: http.n,v 1.5.4.1 1999/11/19 23:31:46 hobbs Exp $
 '\" 
 .so man.macros
-.TH "Http" n 8.0 Tcl "Tcl Built-In Commands"
+.TH "Http" n 8.3 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
 Http \- Client-side implementation of the HTTP/1.0 protocol.
 .SH SYNOPSIS
-\fBpackage require http ?2.1?\fP
+\fBpackage require http ?2.2?\fP
 .sp
 \fB::http::config \fI?options?\fR
 .sp
@@ -35,6 +35,10 @@ Http \- Client-side implementation of the HTTP/1.0 protocol.
 \fB::http::data \fItoken\fR
 .sp
 \fB::http::cleanup \fItoken\fR
+.sp
+\fB::http::register \fIproto port command\fR
+.sp
+\fB::http::unregister \fIproto\fR
 .BE

 .SH DESCRIPTION
@@ -44,7 +48,9 @@ protocol.  The package implements the GET, POST, and HEAD operations
 of HTTP/1.0.  It allows configuration of a proxy host to get through
 firewalls.  The package is compatible with the \fBSafesock\fR security
 policy, so it can be used by untrusted applets to do URL fetching from
-a restricted set of hosts.
+a restricted set of hosts. This package can be extened to support
+additional HTTP transport protocols, such as HTTPS, by providing
+a custom \fBsocket\fR command, via \fBhttp::register\fR.
 .PP
 The \fB::http::geturl\fR procedure does a HTTP transaction.
 Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction
@@ -101,7 +107,7 @@ non-empty.
 .TP
 \fB\-useragent\fP \fIstring\fP
 The value of the User-Agent header in the HTTP request.  The default
-is \fB"Tcl http client package 2.1."\fR
+is \fB"Tcl http client package 2.2."\fR
 .RE
 .TP
 \fB::http::geturl\fP \fIurl\fP ?\fIoptions\fP? 
@@ -207,6 +213,11 @@ the \fB-command\fP callback, if specified.
 The return value of \fB::http::status\fP is \fBtimeout\fP
 after a timeout has occurred.
 .TP
+\fB\-type\fP \fImime-type\fP
+Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the
+default value (\fBapplication/x-www-form-urlencoded\fR) during a
+POST operation.
+.TP
 \fB\-validate\fP \fIboolean\fP
 If \fIboolean\fR is non-zero, then \fB::http::geturl\fR does an HTTP HEAD
 request.  This request returns meta information about the URL, but the
@@ -252,6 +263,25 @@ This procedure cleans up the state associated with the connection
 identified by \fItoken\fP.  After this call, the procedures
 like \fB::http::data\fP cannot be used to get information
 about the operation.
+.TP
+\fB::http::register\fP \fIproto port command\fP
+This procedure allows one to provide custom HTTP transport types
+such as HTTPS, by registering a prefix, the default port, and the
+command to execute to create the Tcl \fBchannel\fR. E.g.:
+.RS
+.CS
+package require http
+package require tls
+
+http::register https 443 ::tls::socket
+
+set token [http::geturl https://my.secure.site/]
+.CE
+.RE
+.TP
+\fB::http::unregister\fP \fIproto\fP
+This procedure unregisters a protocol handler that was previously
+registered via \fBhttp::register\fR.

 .SH "STATE ARRAY"
 The \fB::http::geturl\fR procedure returns a \fItoken\fR that can be used to
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: switch.n,v 1.3 1999/06/24 21:15:14 jpeek Exp $
+'\" RCS: @(#) $Id: switch.n,v 1.3.4.1 1999/09/22 04:12:42 hobbs Exp $
 '\" 
 .so man.macros
 .TH switch n 7.0 Tcl "Tcl Built-In Commands"
@@ -94,7 +94,10 @@ will return \fB1\fR, and
 	a
 		\-
 	b
-		{format 1}
+		{
+		# Correct Comment Placement (in switch body)
+		format 1
+	}
 	a*
 		{format 2}
 	default
@@ -97,7 +97,7 @@ struct colormap *cm;
 	cm->magic = 0;
 	if (NBYTS > 1)
 		cmtreefree(cm, cm->tree, 0);
-	for (i = 1; i < cm->max; i++)		/* skip WHITE */
+	for (i = 1; i <= cm->max; i++)		/* skip WHITE */
 		if (!UNUSEDCOLOR(&cm->cd[i])) {
 			cb = cm->cd[i].block;
 			if (cb != NULL)
@@ -456,7 +456,7 @@ struct state *rp;
 	color co;
 	color sco;

-	assert((uc & BYTMASK) == 0);
+	assert((uc % BYTTAB) == 0);

 	/* find its color block, making new pointer blocks as needed */
 	t = cm->tree;
@@ -614,8 +614,6 @@ struct arc *a;
 	a->colorchain = NULL;	/* paranoia */
 }

-#ifdef NOTDEF			/* This isn't used currently. */
-
 /*
 - singleton - is this character in its own color?
 ^ static int singleton(struct colormap *, pchr c);
@@ -633,8 +631,6 @@ pchr c;
 	return 0;
 }

-#endif /* NOTDEF */
-
 /*
 - rainbow - add arcs of all full colors (but one) between specified states
 ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
@@ -110,8 +110,6 @@ pchr to;
 	cv->nranges++;
 }

-#ifdef NOTDEF			/* This isn't used currently. */
-
 /*
 - addmcce - add an MCCE to a cvec
 ^ static VOID addmcce(struct cvec *, chr *, chr *);
@@ -122,25 +120,26 @@ struct cvec *cv;
 chr *startp;			/* beginning of text */
 chr *endp;			/* just past end of text */
 {
-	int n = endp - startp;
+	int len;
 	int i;
 	chr *s;
 	chr *d;

-	assert(n > 0);
-	assert(cv->nchrs + n < cv->chrspace - cv->nmccechrs);
+	if (startp == NULL && endp == NULL)
+		return;
+	len = endp - startp;
+	assert(len > 0);
+	assert(cv->nchrs + len < cv->chrspace - cv->nmccechrs);
 	assert(cv->nmcces < cv->mccespace);
-	d = &cv->chrs[cv->chrspace - cv->nmccechrs - n - 1];
+	d = &cv->chrs[cv->chrspace - cv->nmccechrs - len - 1];
 	cv->mcces[cv->nmcces++] = d;
-	for (s = startp, i = n; i > 0; s++, i--)
+	for (s = startp, i = len; i > 0; s++, i--)
 		*d++ = *s;
 	*d++ = 0;		/* endmarker */
 	assert(d == &cv->chrs[cv->chrspace - cv->nmccechrs]);
-	cv->nmccechrs += n + 1;
+	cv->nmccechrs += len + 1;
 }

-#endif /* NOTDEF */
-
 /*
 - haschr - does a cvec contain this chr?
 ^ static int haschr(struct cvec *, pchr);
@@ -1010,8 +1010,9 @@ newline()
 }

 /*
- - ch - return the chr sequence for locale.c's fake collating element ch
- * This helps confine use of CHR to this source file.
+ - ch - return the chr sequence for regc_locale.c's fake collating element ch
+ * This helps confine use of CHR to this source file.  Beware that the caller
+ * knows how long the sequence is.
 ^ #ifdef REG_DEBUG
 ^ static chr *ch(NOPARMS);
 ^ #endif
@@ -9,7 +9,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: regc_locale.c,v 1.4 1999/06/24 03:27:56 stanton Exp $
+ * RCS: @(#) $Id: regc_locale.c,v 1.4.4.1 1999/11/02 02:09:48 hobbs Exp $
 */

 /* ASCII character-name table */
@@ -634,7 +634,7 @@ int cases;			/* all cases? */
 	struct cvec *cv;

 	/* crude fake equivalence class for testing */
-	if ((v->cflags&REG_FAKEEC) && c == 'x') {
+	if ((v->cflags&REG_FAKE) && c == 'x') {
 		cv = getcvec(v, 4, 0, 0);
 		addchr(cv, (chr)'x');
 		addchr(cv, (chr)'y');
@@ -105,9 +105,7 @@ static VOID subblock _ANSI_ARGS_((struct vars *, pchr, struct state *, struct st
 static VOID okcolors _ANSI_ARGS_((struct nfa *, struct colormap *));
 static VOID colorchain _ANSI_ARGS_((struct colormap *, struct arc *));
 static VOID uncolorchain _ANSI_ARGS_((struct colormap *, struct arc *));
-#ifdef NOTDEF			/* Avoid compiler warnings. */
 static int singleton _ANSI_ARGS_((struct colormap *, pchr c));
-#endif
 static VOID rainbow _ANSI_ARGS_((struct nfa *, struct colormap *, int, pcolor, struct state *, struct state *));
 static VOID colorcomplement _ANSI_ARGS_((struct nfa *, struct colormap *, int, struct state *, struct state *, struct state *));
 #ifdef REG_DEBUG
@@ -173,9 +171,7 @@ static struct cvec *newcvec _ANSI_ARGS_((int, int, int));
 static struct cvec *clearcvec _ANSI_ARGS_((struct cvec *));
 static VOID addchr _ANSI_ARGS_((struct cvec *, pchr));
 static VOID addrange _ANSI_ARGS_((struct cvec *, pchr, pchr));
-#ifdef NOTDEF			/* Avoid compiler warnings. */
 static VOID addmcce _ANSI_ARGS_((struct cvec *, chr *, chr *));
-#endif
 static int haschr _ANSI_ARGS_((struct cvec *, pchr));
 static struct cvec *getcvec _ANSI_ARGS_((struct vars *, int, int, int));
 static VOID freecvec _ANSI_ARGS_((struct cvec *));
@@ -229,7 +225,6 @@ struct vars {
 	struct state *mccepend;	/* in nfa, end of MCCE prototypes */
 	struct subre *lacons;	/* lookahead-constraint vector */
 	int nlacons;		/* size of lacons */
-	int usedshorter;	/* used short-preferring quantifiers */
 };

 /* parsing macros; most know that `v' is the struct vars pointer */
@@ -362,6 +357,7 @@ int flags;
 		CNOERR();
 		v->mcces = allmcces(v, v->mcces);
 		leaders(v, v->mcces);
+		addmcce(v->mcces, (chr *)NULL, (chr *)NULL);	/* dummy */
 	}
 	CNOERR();

@@ -386,18 +382,16 @@ int flags;
 		dumpnfa(v->nfa, debug);
 		dumpst(v->tree, debug, 1);
 	}
-	v->usedshorter = 0;
 	optst(v, v->tree);
 	v->ntree = numst(v->tree, 1);
 	markst(v->tree);
 	cleanst(v);
 	if (debug != NULL) {
 		fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
-		fprintf(debug, "-->\n");
 		dumpst(v->tree, debug, 1);
 	}

-	/* build compacted NFAs for tree, lacons, fast search */
+	/* build compacted NFAs for tree and lacons */
 	re->re_info |= nfatree(v, v->tree, debug);
 	CNOERR();
 	assert(v->nlacons == 0 || v->lacons != NULL);
@@ -407,6 +401,10 @@ int flags;
 		nfanode(v, &v->lacons[i], debug);
 	}
 	CNOERR();
+	if (v->tree->flags&SHORTER)
+		NOTE(REG_USHORTEST);
+
+	/* build compacted NFAs for tree, lacons, fast search */
 	if (debug != NULL)
 		fprintf(debug, "\n\n\n========= SEARCH ==========\n");
 	/* can sacrifice main NFA now, so use it as work area */
@@ -431,7 +429,6 @@ int flags;
 	g->lacons = v->lacons;
 	v->lacons = NULL;
 	g->nlacons = v->nlacons;
-	g->usedshorter = v->usedshorter;

 	if (flags&REG_DUMP)
 		dump(re, stdout);
@@ -507,7 +504,7 @@ int err;
 }

 /*
- - makesearch - turn an NFA into a fast-scan NFA (implicit prepend of .*?)
+ - makesearch - turn an NFA into a search NFA (implicit prepend of .*?)
 * NFA must have been optimize()d already.
 ^ static VOID makesearch(struct vars *, struct nfa *);
 */
@@ -1653,6 +1650,10 @@ struct state *rp;
 	for (i = 0; i < cv->nmcces; i++) {
 		p = cv->mcces[i];
 		assert(singleton(v->cm, *p));
+		if (!singleton(v->cm, *p)) {
+			ERR(REG_ASSERT);
+			return;
+		}
 		ch = *p++;
 		co = GETCOLOR(v->cm, ch);
 		a = findarc(lp, PLAIN, co);
@@ -1835,10 +1836,6 @@ struct subre *t;
 	if (t == NULL)
 		return;

-	/* preference cleanup and analysis */
-	if (t->flags&SHORTER)
-		v->usedshorter = 1;
-
 	/* recurse through children */
 	if (t->left != NULL)
 		optst(v, t->left);
@@ -1937,7 +1934,7 @@ FILE *f;			/* for debug output */
 {
 	struct nfa *nfa;
 	long ret = 0;
- 	char idbuf[50];
+	char idbuf[50];

 	assert(t->begin != NULL);

@@ -2066,9 +2063,8 @@ FILE *f;
 								GUTSMAGIC);

 	fprintf(f, "\n\n\n========= DUMP ==========\n");
-	fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d, usedshort %d\n", 
-		re->re_nsub, re->re_info, re->re_csize, g->ntree,
-		g->usedshorter);
+	fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n", 
+		re->re_nsub, re->re_info, re->re_csize, g->ntree);

 	dumpcolors(&g->cmap, f);
 	if (!NULLCNFA(g->search)) {
@@ -26,11 +26,10 @@
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

-/* headers (which also pick up the standard ones, or equivalents) */
+/* headers if any */
 #include "tclInt.h"

-/* overrides for regguts.h definitions */
-/* function-pointer declarations */
+/* overrides for regguts.h definitions, if any */
 #define	FUNCPTR(name, args)	(*name) _ANSI_ARGS_(args)
 #define	MALLOC(n)		ckalloc(n)
 #define	FREE(p)			ckfree(VS(p))
@@ -62,6 +61,12 @@
 #ifdef __REG_CONST
 #undef __REG_CONST
 #endif
+#ifdef __REG_NOFRONT
+#undef __REG_NOFRONT
+#endif
+#ifdef __REG_NOCHAR
+#undef __REG_NOCHAR
+#endif
 /* interface types */
 #define	__REG_WIDE_T	Tcl_UniChar
 #define	__REG_REGOFF_T	long	/* not really right, but good enough... */
@@ -70,12 +75,8 @@
 /* names and declarations */
 #define	__REG_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
-#ifndef __REG_NOFRONT
 #define	__REG_NOFRONT		/* don't want regcomp() and regexec() */
-#endif
-#ifndef __REG_NOCHAR
 #define	__REG_NOCHAR		/* or the char versions */
-#endif
 #define	regfree		TclReFree
 #define	regerror	TclReError
 /* --- end --- */
@@ -105,7 +106,7 @@ typedef int celt;		/* type to hold chr, MCCE number, or NOCELT */
 #define	exec		TclReExec

 /* enable/disable debugging code (by whether REG_DEBUG is defined or not) */
-#ifdef notdef
+#if 0		/* no debug unless requested by makefile */
 #define	REG_DEBUG	/* */
 #endif

@@ -1,6 +1,6 @@
 { REG_OKAY,	"REG_OKAY",	"no errors detected" },
 { REG_NOMATCH,	"REG_NOMATCH",	"failed to match" },
-{ REG_BADPAT,	"REG_BADPAT",	"invalid regexp (reg version 0.4)" },
+{ REG_BADPAT,	"REG_BADPAT",	"invalid regexp (reg version 0.8)" },
 { REG_ECOLLATE,	"REG_ECOLLATE",	"invalid collating element" },
 { REG_ECTYPE,	"REG_ECTYPE",	"invalid character class" },
 { REG_EESCAPE,	"REG_EESCAPE",	"invalid escape \\ sequence" },
@@ -101,6 +101,12 @@ extern "C" {
 #ifdef __REG_CONST
 #undef __REG_CONST
 #endif
+#ifdef __REG_NOFRONT
+#undef __REG_NOFRONT
+#endif
+#ifdef __REG_NOCHAR
+#undef __REG_NOCHAR
+#endif
 /* interface types */
 #define	__REG_WIDE_T	Tcl_UniChar
 #define	__REG_REGOFF_T	long	/* not really right, but good enough... */
@@ -109,12 +115,8 @@ extern "C" {
 /* names and declarations */
 #define	__REG_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
-#ifndef __REG_NOFRONT
 #define	__REG_NOFRONT		/* don't want regcomp() and regexec() */
-#endif
-#ifndef __REG_NOCHAR
 #define	__REG_NOCHAR		/* or the char versions */
-#endif
 #define	regfree		TclReFree
 #define	regerror	TclReError
 /* --- end --- */
@@ -163,7 +165,7 @@ typedef void re_void;
 typedef struct {
 	int re_magic;		/* magic number */
 	size_t re_nsub;		/* number of subexpressions */
-	int re_info;		/* information about RE */
+	long re_info;		/* information about RE */
 #		define	REG_UBACKREF		000001
 #		define	REG_ULOOKAHEAD		000002
 #		define	REG_UBOUNDS		000004
@@ -177,6 +179,7 @@ typedef struct {
 #		define	REG_ULOCALE		002000
 #		define	REG_UEMPTYMATCH		004000
 #		define	REG_UIMPOSSIBLE		010000
+#		define	REG_USHORTEST		020000
 	int re_csize;		/* sizeof(character) */
 	char *re_endp;		/* backward compatibility kludge */
 	/* the rest is opaque pointers to hidden innards */
@@ -225,7 +228,7 @@ typedef struct {
 #define	REG_EXPECT	001000	/* report details on partial/limited matches */
 #define	REG_BOSONLY	002000	/* temporary kludge for BOS-only matches */
 #define	REG_DUMP	004000	/* none of your business :-) */
-#define	REG_FAKEEC	010000	/* none of your business :-) */
+#define	REG_FAKE	010000	/* none of your business :-) */
 #define	REG_PROGRESS	020000	/* none of your business :-) */


@@ -33,29 +33,6 @@



-/* internal variables, bundled for easy passing around */
-struct vars {
-	regex_t *re;
-	struct guts *g;
-	int eflags;		/* copies of arguments */
-	size_t nmatch;
-	regmatch_t *pmatch;
-	rm_detail_t *details;
-	chr *start;		/* start of string */
-	chr *stop;		/* just past end of string */
-	int err;		/* error code if any (0 none) */
-	regoff_t *mem;		/* memory vector for backtracking */
-};
-#define	VISERR(vv)	((vv)->err != 0)	/* have we seen an error yet? */
-#define	ISERR()	VISERR(v)
-#define	VERR(vv,e)	(((vv)->err) ? (vv)->err : ((vv)->err = (e)))
-#define	ERR(e)	VERR(v, e)		/* record an error */
-#define	NOERR()	{if (ISERR()) return;}	/* if error seen, return */
-#define	OFF(p)	((p) - v->start)
-#define	LOFF(p)	((long)OFF(p))
-
-
-
 /* lazy-DFA representation */
 struct arcp {			/* "pointer" to an outarc */
 	struct sset *ss;
@@ -111,9 +88,34 @@ struct smalldfa {
 	struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
 	struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
 };
+#define	DOMALLOC	((struct smalldfa *)NULL)	/* force malloc */



+/* internal variables, bundled for easy passing around */
+struct vars {
+	regex_t *re;
+	struct guts *g;
+	int eflags;		/* copies of arguments */
+	size_t nmatch;
+	regmatch_t *pmatch;
+	rm_detail_t *details;
+	chr *start;		/* start of string */
+	chr *stop;		/* just past end of string */
+	int err;		/* error code if any (0 none) */
+	regoff_t *mem;		/* memory vector for backtracking */
+	struct smalldfa dfa1;
+	struct smalldfa dfa2;
+};
+#define	VISERR(vv)	((vv)->err != 0)	/* have we seen an error yet? */
+#define	ISERR()	VISERR(v)
+#define	VERR(vv,e)	(((vv)->err) ? (vv)->err : ((vv)->err = (e)))
+#define	ERR(e)	VERR(v, e)		/* record an error */
+#define	NOERR()	{if (ISERR()) return v->err;}	/* if error seen, return it */
+#define	OFF(p)	((p) - v->start)
+#define	LOFF(p)	((long)OFF(p))
+
+

 /*
 * forward declarations
@@ -196,8 +198,8 @@ int flags;
 	if (v->g->cflags&REG_NOSUB)
 		nmatch = 0;		/* override client */
 	v->nmatch = nmatch;
-	if (backref && v->nmatch < v->g->nsub + 1) {
-		/* need work area bigger than what user gave us */
+	if (backref) {
+		/* need work area */
 		if (v->g->nsub + 1 <= LOCALMAT)
 			v->pmatch = mat;
 		else
@@ -260,10 +262,8 @@ struct vars *v;
 struct cnfa *cnfa;
 struct colormap *cm;
 {
-	struct smalldfa da;
-	struct dfa *d = newdfa(v, cnfa, cm, &da);
-	struct smalldfa sa;
-	struct dfa *s = newdfa(v, &v->g->search, cm, &sa);
+	struct dfa *s;
+	struct dfa *d;
 	chr *begin;
 	chr *end;
 	chr *cold;
@@ -272,19 +272,15 @@ struct colormap *cm;
 	int hitend;
 	int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;

-	if (ISERR()) {		/* should be newdfa() failure */
-		if (d != NULL)
-			freedfa(d);
-		if (s != NULL)
-			freedfa(s);
-		return v->err;
-	}
-
 	/* first, a shot with the search RE */
+	s = newdfa(v, &v->g->search, cm, &v->dfa1);
+	assert(!(ISERR() && s != NULL));
+	NOERR();
 	MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
 	cold = NULL;
 	close = shortest(v, s, v->start, v->start, v->stop, &cold, (int *)NULL);
 	freedfa(s);
+	NOERR();
 	if (v->g->cflags&REG_EXPECT) {
 		assert(v->details != NULL);
 		if (cold != NULL)
@@ -293,22 +289,19 @@ struct colormap *cm;
 			v->details->rm_extend.rm_so = OFF(v->stop);
 		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
 	}
-	if (close == NULL) {		/* not found */
-		freedfa(d);
-		if (ISERR())
-			return v->err;
+	if (close == NULL)		/* not found */
 		return REG_NOMATCH;
-	}
-	if (v->nmatch == 0) {		/* found, don't need exact location */
-		freedfa(d);
+	if (v->nmatch == 0)		/* found, don't need exact location */
 		return REG_OKAY;
-	}

-	/* find starting point */
+	/* find starting point and match */
 	assert(cold != NULL);
 	open = cold;
 	cold = NULL;
 	MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
+	d = newdfa(v, cnfa, cm, &v->dfa1);
+	assert(!(ISERR() && d != NULL));
+	NOERR();
 	for (begin = open; begin <= close; begin++) {
 		MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
 		if (shorter)
@@ -316,6 +309,7 @@ struct colormap *cm;
 							(chr **)NULL, &hitend);
 		else
 			end = longest(v, d, begin, v->stop, &hitend);
+		NOERR();
 		if (hitend && cold == NULL)
 			cold = begin;
 		if (end != NULL)
@@ -335,13 +329,12 @@ struct colormap *cm;
 			v->details->rm_extend.rm_so = OFF(v->stop);
 		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
 	}
-	if (v->nmatch > 1) {
-		zapsubs(v->pmatch, v->nmatch);
-		return dissect(v, v->g->tree, begin, end);
-	}
-	if (ISERR())
-		return v->err;
-	return REG_OKAY;
+	if (v->nmatch == 1)		/* no need for submatches */
+		return REG_OKAY;
+
+	/* submatches */
+	zapsubs(v->pmatch, v->nmatch);
+	return dissect(v, v->g->tree, begin, end);
 }

 /*
@@ -354,17 +347,17 @@ struct vars *v;
 struct cnfa *cnfa;
 struct colormap *cm;
 {
-	struct smalldfa da;
-	struct dfa *d = newdfa(v, cnfa, cm, &da);
-	struct smalldfa sa;
-	struct dfa *s = newdfa(v, &v->g->search, cm, &sa);
+	struct dfa *s;
+	struct dfa *d;
 	chr *cold;
 	int ret;

-	if (d == NULL)
-		return v->err;
-	if (s == NULL) {
-		freedfa(d);
+	s = newdfa(v, &v->g->search, cm, &v->dfa1);
+	NOERR();
+	d = newdfa(v, cnfa, cm, &v->dfa2);
+	if (ISERR()) {
+		assert(d == NULL);
+		freedfa(s);
 		return v->err;
 	}

@@ -372,8 +365,7 @@ struct colormap *cm;

 	freedfa(d);
 	freedfa(s);
-	if (ISERR())
-		return v->err;
+	NOERR();
 	if (v->g->cflags&REG_EXPECT) {
 		assert(v->details != NULL);
 		if (cold != NULL)
@@ -589,9 +581,7 @@ struct subre *t;
 chr *begin;			/* beginning of relevant substring */
 chr *end;			/* end of same */
 {
-	struct smalldfa da;
 	struct dfa *d;
-	struct smalldfa d2a;
 	struct dfa *d2;
 	chr *mid;
 	int i;
@@ -602,11 +592,11 @@ chr *end;			/* end of same */
 	assert(t->left != NULL && t->left->cnfa.nstates > 0);
 	assert(t->right != NULL && t->right->cnfa.nstates > 0);

-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &da);
-	if (ISERR())
-		return v->err;
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+	NOERR();
+	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
 	if (ISERR()) {
+		assert(d2 == NULL);
 		freedfa(d);
 		return v->err;
 	}
@@ -670,7 +660,6 @@ struct subre *t;
 chr *begin;			/* beginning of relevant substring */
 chr *end;			/* end of same */
 {
-	struct smalldfa da;
 	struct dfa *d;
 	int i;

@@ -680,7 +669,7 @@ chr *end;			/* end of same */
 	for (i = 0; t != NULL; t = t->right, i++) {
 		MDEBUG(("trying %dth\n", i));
 		assert(t->left != NULL && t->left->cnfa.nstates > 0);
-		d = newdfa(v, &t->left->cnfa, &v->g->cmap, &da);
+		d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
 		if (ISERR())
 			return v->err;
 		if (longest(v, d, begin, end, (int *)NULL) == end) {
@@ -755,9 +744,7 @@ struct subre *t;
 chr *begin;			/* beginning of relevant substring */
 chr *end;			/* end of same */
 {
-	struct smalldfa da;
 	struct dfa *d;
-	struct smalldfa d2a;
 	struct dfa *d2;
 	chr *mid;
 	int er;
@@ -769,10 +756,10 @@ chr *end;			/* end of same */
 	if (t->left->flags&SHORTER)		/* reverse scan */
 		return crevdissect(v, t, begin, end);

-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &da);
+	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
 	if (ISERR())
 		return v->err;
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
 	if (ISERR()) {
 		freedfa(d);
 		return v->err;
@@ -839,7 +826,7 @@ chr *end;			/* end of same */
 }

 /*
- - crevdissect - determine shortest-first subexpression matches
+ - crevdissect - determine backref shortest-first subexpression matches
 * The retry memory stores the offset of the trial midpoint from begin, 
 * plus 1 so that 0 uniquely means "clean slate".
 ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
@@ -851,9 +838,7 @@ struct subre *t;
 chr *begin;			/* beginning of relevant substring */
 chr *end;			/* end of same */
 {
-	struct smalldfa da;
 	struct dfa *d;
-	struct smalldfa d2a;
 	struct dfa *d2;
 	chr *mid;
 	int er;
@@ -864,10 +849,10 @@ chr *end;			/* end of same */
 	assert(t->left->flags&SHORTER);

 	/* concatenation -- need to split the substring between parts */
-	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &da);
+	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
 	if (ISERR())
 		return v->err;
-	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+	d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
 	if (ISERR()) {
 		freedfa(d);
 		return v->err;
@@ -1011,7 +996,6 @@ struct subre *t;
 chr *begin;			/* beginning of relevant substring */
 chr *end;			/* end of same */
 {
-	struct smalldfa da;
 	struct dfa *d;
 	int er;
 #	define	UNTRIED	0	/* not yet tried at all */
@@ -1028,7 +1012,7 @@ chr *end;			/* end of same */
 	assert(t->left != NULL);

 	if (v->mem[t->retry] == UNTRIED) {
-		d = newdfa(v, &t->left->cnfa, &v->g->cmap, &da);
+		d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
 		if (ISERR())
 			return v->err;
 		if (longest(v, d, begin, end, (int *)NULL) != end) {
@@ -1,5 +1,5 @@
 /*
- * Internal interface definitions, etc., for the regex package
+ * Internal interface definitions, etc., for the reg package
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 * 
@@ -77,6 +77,11 @@
 #define	NOPARMS	VOID			/* for empty parm lists */
 #endif

+/* const */
+#ifndef CONST
+#define	CONST	const			/* for old compilers, might be empty */
+#endif
+
 /* function-pointer declarator */
 #ifndef FUNCPTR
 #if __STDC__ >= 1
@@ -410,5 +415,4 @@ struct guts {
 	int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
 	struct subre *lacons;	/* lookahead-constraint vector */
 	int nlacons;		/* size of lacons */
-	int usedshorter;	/* used non-greedy quantifiers? */
 };
@@ -12,7 +12,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tcl.h,v 1.57 1999/08/10 23:16:25 redman Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.57.2.3 1999/11/19 23:32:02 hobbs Exp $
 */

 #ifndef _TCL
@@ -38,28 +38,28 @@ extern "C" {
 * When version numbers change here, must also go into the following files
 * and update the version numbers:
 *
- * library/init.tcl	(only if major.minor changes, not patchlevel)
- * unix/configure.in
- * win/configure.in	(only if major.minor changes, not patchlevel)
- * win/makefile.bc	(only if major.minor changes, not patchlevel)
- * win/makefile.vc	(only if major.minor changes, not patchlevel)
- * win/pkgIndex.tcl	(for tclregNN.dll, not patchlevel)
- * README
- * mac/README
- * win/README.binary
- * win/README		(only if major.minor changes, not patchlevel)
- * unix/README		(only if major.minor changes, not patchlevel)
- * tools/tcl.hpj.in	(for windows installer)
+ * library/init.tcl	(only if Major.minor changes, not patchlevel) 1 LOC
+ * unix/configure.in	(2 LOC Major, 2 LOC minor, 1 LOC patch)
+ * win/configure.in	(as above)
+ * win/makefile.vc	(not patchlevel) 2 LOC
+ * win/pkgIndex.tcl	(not patchlevel, for tclregNN.dll)
+ * README		(sections 0 and 2)
+ * mac/README		(2 LOC)
+ * win/README.binary	(sections 0-4)
+ * win/README		(not patchlevel) (sections 0 and 2)
+ * unix/README		(not patchlevel) (part (h))
+ * tests/basic.test	(not patchlevel) (version checks)
+ * tools/tcl.hpj.in	(not patchlevel, for windows installer)
 * tools/tcl.wse.in	(for windows installer)
 */

 #define TCL_MAJOR_VERSION   8
 #define TCL_MINOR_VERSION   2
 #define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL  0
+#define TCL_RELEASE_SERIAL  3

 #define TCL_VERSION	    "8.2"
-#define TCL_PATCH_LEVEL	    "8.2.0"
+#define TCL_PATCH_LEVEL	    "8.2.3"

 /*
 * The following definitions set up the proper options for Windows
@@ -12,7 +12,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclBasic.c,v 1.21 1999/05/14 23:16:54 surles Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.21.4.1 1999/11/19 23:32:03 hobbs Exp $
 */

 #include "tclInt.h"
@@ -2581,7 +2581,6 @@ Tcl_EvalObjEx(interp, objPtr, flags)

    iPtr->numLevels++;
    if (iPtr->numLevels > iPtr->maxNestingDepth) {
-	iPtr->numLevels--;
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
 		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1); 
 	result = TCL_ERROR;
@@ -2595,7 +2594,6 @@ Tcl_EvalObjEx(interp, objPtr, flags)
    
    if (TclpCheckStackSpace() == 0) {
 	/*NOTREACHED*/
-    	iPtr->numLevels--;
    	Tcl_AppendToObj(Tcl_GetObjResult(interp),
 		"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
 	result = TCL_ERROR;
@@ -13,7 +13,7 @@
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 *
- * RCS: @(#) $Id: tclCkalloc.c,v 1.5 1999/08/10 02:42:12 welch Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.5.4.2 1999/11/19 23:32:04 hobbs Exp $
 */

 #include "tclInt.h"
@@ -165,18 +165,18 @@ void
 TclDumpMemoryInfo(outFile) 
    FILE *outFile;
 {
-        fprintf(outFile,"total mallocs             %10d\n", 
-                total_mallocs);
-        fprintf(outFile,"total frees               %10d\n", 
-                total_frees);
-        fprintf(outFile,"current packets allocated %10d\n", 
-                current_malloc_packets);
-        fprintf(outFile,"current bytes allocated   %10d\n", 
-                current_bytes_malloced);
-        fprintf(outFile,"maximum packets allocated %10d\n", 
-                maximum_malloc_packets);
-        fprintf(outFile,"maximum bytes allocated   %10d\n", 
-                maximum_bytes_malloced);
+    fprintf(outFile,"total mallocs             %10d\n", 
+	    total_mallocs);
+    fprintf(outFile,"total frees               %10d\n", 
+	    total_frees);
+    fprintf(outFile,"current packets allocated %10d\n", 
+	    current_malloc_packets);
+    fprintf(outFile,"current bytes allocated   %10d\n", 
+	    current_bytes_malloced);
+    fprintf(outFile,"maximum packets allocated %10d\n", 
+	    maximum_malloc_packets);
+    fprintf(outFile,"maximum bytes allocated   %10d\n", 
+	    maximum_bytes_malloced);
 }

 /*
@@ -294,7 +294,7 @@ Tcl_DumpActiveMemory (fileName)
    char              *address;

    if (fileName == NULL) {
-	fileP = stdout;
+	fileP = stderr;
    } else {
 	fileP = fopen(fileName, "w");
 	if (fileP == NULL) {
@@ -354,8 +354,7 @@ Tcl_DbCkalloc(size, file, line)
    if (result == NULL) {
        fflush(stdout);
        TclDumpMemoryInfo(stderr);
-        panic("unable to alloc %d bytes, %s line %d", size, file, 
-              line);
+        panic("unable to alloc %d bytes, %s line %d", size, file, line);
    }

    /*
@@ -445,10 +444,16 @@ Tcl_DbCkalloc(size, file, line)

 int
 Tcl_DbCkfree(ptr, file, line)
-    char *  ptr;
-    char     *file;
-    int       line;
+    char *ptr;
+    char *file;
+    int   line;
 {
+    struct mem_header *memp;
+
+    if (ptr == NULL) {
+	return 0;
+    }
+
    /*
     * The following cast is *very* tricky.  Must convert the pointer
     * to an integer before doing arithmetic on it, because otherwise
@@ -457,15 +462,16 @@ Tcl_DbCkfree(ptr, file, line)
     * even though BODY_OFFSET is in words on these machines).
     */

-    struct mem_header *memp = (struct mem_header *)
-	    (((unsigned long) ptr) - BODY_OFFSET);
+    memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);

-    if (alloc_tracing)
+    if (alloc_tracing) {
        fprintf(stderr, "ckfree %lx %ld %s %d\n",
 		(long unsigned int) memp->body, memp->length, file, line);
+    }

-    if (validate_memory)
+    if (validate_memory) {
        Tcl_ValidateAllMemory(file, line);
+    }

    Tcl_MutexLock(ckallocMutexPtr);
    ValidateMemory(memp, file, line, TRUE);
@@ -520,14 +526,18 @@ Tcl_DbCkrealloc(ptr, size, file, line)
 {
    char *new;
    unsigned int copySize;
+    struct mem_header *memp;
+
+    if (ptr == NULL) {
+	return Tcl_DbCkalloc(size, file, line);
+    }

    /*
     * See comment from Tcl_DbCkfree before you change the following
     * line.
     */

-    struct mem_header *memp = (struct mem_header *)
-	    (((unsigned long) ptr) - BODY_OFFSET);
+    memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > (unsigned int) memp->length) {
@@ -536,7 +546,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
    new = Tcl_DbCkalloc(size, file, line);
    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
-    return(new);
+    return new;
 }


@@ -777,6 +787,8 @@ Tcl_InitMemory(interp)

 #else	/* TCL_MEM_DEBUG */

+/* This is the !TCL_MEM_DEBUG case */
+
 #undef Tcl_InitMemory
 #undef Tcl_DumpActiveMemory
 #undef Tcl_ValidateAllMemory
@@ -796,12 +808,22 @@ char *
 Tcl_Alloc (size)
    unsigned int size;
 {
-        char *result;
+    char *result;

-        result = TclpAlloc(size);
-        if (result == NULL) 
-                panic("unable to alloc %d bytes", size);
-        return result;
+    result = TclpAlloc(size);
+    /*
+     * Most systems will not alloc(0), instead bumping it to one so
+     * that NULL isn't returned.  Some systems (AIX, Tru64) will alloc(0)
+     * by returning NULL, so we have to check that the NULL we get is
+     * not in response to alloc(0).
+     *
+     * The ANSI spec actually says that systems either return NULL *or*
+     * a special pointer on failure, but we only check for NULL
+     */
+    if ((result == NULL) && size) {
+	panic("unable to alloc %d bytes", size);
+    }
+    return result;
 }

 char *
@@ -814,10 +836,9 @@ Tcl_DbCkalloc(size, file, line)

    result = (char *) TclpAlloc(size);

-    if (result == NULL) {
+    if ((result == NULL) && size) {
        fflush(stdout);
-        panic("unable to alloc %d bytes, %s line %d", size, file, 
-              line);
+        panic("unable to alloc %d bytes, %s line %d", size, file, line);
    }
    return result;
 }
@@ -841,8 +862,10 @@ Tcl_Realloc(ptr, size)
    char *result;

    result = TclpRealloc(ptr, size);
-    if (result == NULL) 
+
+    if ((result == NULL) && size) {
 	panic("unable to realloc %d bytes", size);
+    }
    return result;
 }

@@ -857,10 +880,9 @@ Tcl_DbCkrealloc(ptr, size, file, line)

    result = (char *) TclpRealloc(ptr, size);

-    if (result == NULL) {
+    if ((result == NULL) && size) {
        fflush(stdout);
-        panic("unable to realloc %d bytes, %s line %d", size, file, 
-              line);
+        panic("unable to realloc %d bytes, %s line %d", size, file, line);
    }
    return result;
 }
@@ -880,14 +902,14 @@ void
 Tcl_Free (ptr)
    char *ptr;
 {
-        TclpFree(ptr);
+    TclpFree(ptr);
 }

 int
 Tcl_DbCkfree(ptr, file, line)
-    char *  ptr;
-    char     *file;
-    int       line;
+    char *ptr;
+    char *file;
+    int   line;
 {
    TclpFree(ptr);
    return 0;
@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.7 1999/07/01 23:21:06 redman Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.7.4.1 1999/09/22 04:12:45 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1907,6 +1907,8 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 				 * been seen in the current field. */
    int gotPrecision;		/* Non-zero indicates that a precision has
 				 * been set for the current field. */
+    int gotZero;		/* Non-zero indicates that a zero flag has
+ 				 * been seen in the current field. */

    /*
     * This procedure is a bit nasty.  The goal is to use sprintf to
@@ -1935,7 +1937,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 	register char *newPtr = newFormat;

 	width = precision = noPercent = useShort = 0;
-	gotMinus = gotPrecision = 0;
+	gotZero = gotMinus = gotPrecision = 0;
 	whichValue = PTR_VALUE;

 	/*
@@ -2004,6 +2006,13 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 	    if (*format == '-') {
 		gotMinus = 1;
 	    }
+ 	    if (*format == '0') {
+ 		/*
+ 		 * This will be handled by sprintf for numbers, but we
+ 		 * need to do the char/string ones ourselves
+ 		 */
+ 		gotZero = 1;
+ 	    }
 	    *newPtr = *format;
 	    newPtr++;
 	    format++;
@@ -2191,21 +2200,23 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 		}
 		case CHAR_VALUE: {
 		    char *ptr;
+		    char padChar = (gotZero ? '0' : ' ');
 		    ptr = dst;
 		    if (!gotMinus) {
 			for ( ; --width > 0; ptr++) {
-			    *ptr = ' ';
+			    *ptr = padChar;
 			}
 		    }
 		    ptr += Tcl_UniCharToUtf(intValue, ptr);
 		    for ( ; --width > 0; ptr++) {
-			*ptr = ' ';
+			*ptr = padChar;
 		    }
 		    *ptr = '\0';
 		    break;
 		}
 		case STRING_VALUE: {
 		    char *ptr;
+		    char padChar = (gotZero ? '0' : ' ');
 		    int pad;

 		    ptr = dst;
@@ -2217,7 +2228,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)

 		    if (!gotMinus) {
 			while (pad > 0) {
-			    *ptr++ = ' ';
+			    *ptr++ = padChar;
 			    pad--;
 			}
 		    }
@@ -2228,7 +2239,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 			ptr += size;
 		    }
 		    while (pad > 0) {
-			*ptr++ = ' ';
+			*ptr++ = padChar;
 			pad--;
 		    }
 		    *ptr = '\0';
@@ -14,7 +14,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.15 1999/08/10 17:35:18 redman Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.15.4.1 1999/09/22 04:12:46 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1954,8 +1954,12 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
     * will invalidate the list's internal representation.
     */

-    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ INT_MAX,
-	    &index);
+    result = Tcl_ListObjLength(interp, objv[1], &len);
+    if (result != TCL_OK) {
+	return result;
+    }
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ len, &index);
    if (result != TCL_OK) {
 	return result;
    }
@@ -13,7 +13,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.19 1999/07/22 21:50:54 redman Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.19.4.2 1999/10/30 11:05:58 hobbs Exp $
 */

 #include "tclInt.h"
@@ -485,11 +485,13 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
 	    if (firstChar != src) {
 		Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
 	    }
-	    subStart = info.matches[index].start;
-	    subEnd = info.matches[index].end;
-	    if ((subStart >= 0) && (subEnd >= 0)) {
-		Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart,
-			subEnd - subStart);
+	    if (index <= info.nsubs) {
+		subStart = info.matches[index].start;
+		subEnd = info.matches[index].end;
+		if ((subStart >= 0) && (subEnd >= 0)) {
+		    Tcl_AppendUnicodeToObj(resultPtr,
+			    wstring + offset + subStart, subEnd - subStart);
+		}
 	    }
 	    if (*src == '\\') {
 		src++;
@@ -949,7 +951,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	    }

 	    if ((enum options) index == STR_EQUAL) {
-		Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
+		Tcl_SetIntObj(resultPtr, (match) ? 0 : 1);
 	    } else {
 		Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
 					  (match < 0) ? -1 : 0));
@@ -1063,7 +1065,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 			&index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		Tcl_SetStringObj(resultPtr, &string1[index], 1);
+		Tcl_SetByteArrayObj(resultPtr,
+			(unsigned char *)(&string1[index]), 1);
 	    } else {
 		string1 = Tcl_GetStringFromObj(objv[2], &length1);
 		
@@ -2136,7 +2139,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
 {
-    int i, j, index, mode, matched, result;
+    int i, j, index, mode, matched, result, splitObjs, seenComment;
    char *string, *pattern;
    Tcl_Obj *stringObj;
    static char *options[] = {
@@ -2179,6 +2182,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     * argument, split them out again.
     */

+    splitObjs = 0;
    if (objc == 1) {
 	Tcl_Obj **listv;

@@ -2186,13 +2190,26 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	    return TCL_ERROR;
 	}
 	objv = listv;
+	splitObjs = 1;
    }

+    seenComment = 0;
    for (i = 0; i < objc; i += 2) {
 	if (i == objc - 1) {
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
 	            "extra switch pattern with no body", -1);
+
+	    /*
+	     * Check if this can be due to a badly placed comment
+	     * in the switch block
+	     */
+
+	    if (splitObjs && seenComment) {
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			", this may be due to a comment incorrectly placed outside of a switch body - see the \"switch\" documentation", -1);
+	    }
+
 	    return TCL_ERROR;
 	}

@@ -2201,6 +2218,17 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	 */

 	pattern = Tcl_GetString(objv[i]);
+
+	/*
+	 * The following is an heuristic to detect the infamous
+	 * "comment in switch" error: just check if a pattern
+	 * begins with '#'.
+	 */
+
+	if (splitObjs && *pattern == '#') {
+	    seenComment = 1;
+	}
+
 	matched = 0;
 	if ((i == objc - 2) 
 		&& (*pattern == 'd') 
@@ -9,7 +9,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.2 1999/04/16 00:46:43 stanton Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.2.6.1 1999/10/30 11:05:58 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1341,7 +1341,16 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)

    varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+    /*
+     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+     * curly braces surround the variable name.
+     * This really matters for array elements to handle things like
+     *    set {x($foo)} 5
+     * which raises an undefined var error if we are not careful here.
+     * This goes with the hack in TclCompileSetCmd.
+     */
+    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+	    (varTokenPtr->start[0] != '{')) {
 	/*
 	 * A simple variable name. Divide it up into "name" and "elName"
 	 * strings. If it is not a local variable, look it up at runtime.
@@ -1446,7 +1455,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)

 	    word[numBytes] = '\0';
 	    if (TclLooksLikeInt(word, numBytes)
-		     && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
+		    && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
 		if ((-127 <= n) && (n <= 127)) {
 		    haveImmValue = 1;
 		    immValue = n;
@@ -1600,8 +1609,18 @@ TclCompileSetCmd(interp, parsePtr, envPtr)

    varTokenPtr = parsePtr->tokenPtr
 	    + (parsePtr->tokenPtr->numComponents + 1);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+    /*
+     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
+     * curly braces surround the variable name.
+     * This really matters for array elements to handle things like
+     *    set {x($foo)} 5
+     * which raises an undefined var error if we are not careful here.
+     * This goes with the hack in TclCompileIncrCmd.
+     */
+    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
+	    (varTokenPtr->start[0] != '{')) {
 	simpleVarName = 1;
+
 	name = varTokenPtr[1].start;
 	nameChars = varTokenPtr[1].size;
 	/* last char is ')' => potential array reference */
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclCompile.c,v 1.15 1999/04/22 22:57:06 stanton Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.15.6.2 1999/10/30 11:05:59 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1348,7 +1348,6 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
    JumpFixup jumpFixup;
    int maxDepth, doExprInline, range, numBytes, i, j, code;
    char *script;
-    char saveChar;
    int saveExprIsJustVarRef = envPtr->exprIsJustVarRef;
    int saveExprIsComparison = envPtr->exprIsComparison;

@@ -1370,10 +1369,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)

 	script = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
-	saveChar = script[numBytes];
-	script[numBytes] = 0;
 	code = TclCompileExpr(interp, script, numBytes, envPtr);
-	script[numBytes] = saveChar;
 	return code;
    }
 	
@@ -1393,7 +1389,8 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
 	    for (j = 0, partPtr = wordPtr+1;  j < wordPtr->numComponents;
 		    j++, partPtr++) {
 		if ((partPtr->type == TCL_TOKEN_BS)
-		        || (partPtr->type == TCL_TOKEN_COMMAND)) {
+		        || (partPtr->type == TCL_TOKEN_COMMAND)
+			|| (partPtr->type == TCL_TOKEN_VARIABLE)) {
 		    doExprInline = 0;
 		    break;
 		}
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclDate.c,v 1.5 1999/05/14 18:29:50 stanton Exp $ 
+ * RCS: @(#) $Id: tclDate.c,v 1.5.4.1 1999/09/22 04:12:47 hobbs Exp $
 */

 #include "tclInt.h"
@@ -135,22 +135,27 @@ typedef union



-#ifdef __cplusplus

+#if defined(__cplusplus) || defined(__STDC__)
+
+#if defined(__cplusplus) && defined(__EXTERN_C__)
+extern "C" {
+#endif
 #ifndef TclDateerror
+#if defined(__cplusplus)
 	void TclDateerror(const char *);
 #endif
-
+#endif
 #ifndef TclDatelex
-#ifdef __EXTERN_C__
-	extern "C" { int TclDatelex(void); }
-#else
 	int TclDatelex(void);
-#endif
 #endif
 	int TclDateparse(void);
+#if defined(__cplusplus) && defined(__EXTERN_C__)
+}
+#endif

 #endif
+
 #define TclDateclearin TclDatechar = -1
 #define TclDateerrok TclDateerrflag = 0
 extern int TclDatechar;
@@ -258,7 +263,8 @@ static TABLE    TimezoneTable[] = {
    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
    { "utc",    tZONE,     HOUR( 0) },
-    { "wet",    tZONE,     HOUR( 0) } ,     /* Western European */
+    { "uct",    tZONE,     HOUR( 0) },      /* Universal Coordinated Time */
+    { "wet",    tZONE,     HOUR( 0) },      /* Western European */
    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
    { "at",     tZONE,     HOUR( 2) },      /* Azores */
@@ -290,6 +296,7 @@ static TABLE    TimezoneTable[] = {
    { "nt",     tZONE,     HOUR(11) },      /* Nome */
    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
+    { "cest",   tDAYZONE, -HOUR( 1) },      /* Central European Summer */
    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
@@ -430,12 +437,10 @@ Convert(Month, Day, Year, Hours, Minutes, Seconds, Meridian, DSTmode, TimePtr)
        Julian += DaysInMonth[i];
    if (Year >= EPOCH) {
        for (i = EPOCH; i < Year; i++)
-            Julian += 365 + (((i % 4) == 0) &&
-	            (((i % 100) != 0) || ((i % 400) == 0)));
+            Julian += 365 + (i % 4 == 0);
    } else {
        for (i = Year; i < EPOCH; i++)
-            Julian -= 365 + (((i % 4) == 0) &&
-	            (((i % 100) != 0) || ((i % 400) == 0)));
+            Julian -= 365 + (i % 4 == 0);
    }
    Julian *= SECSPERDAY;
    Julian += TclDateTimezone * 60L;
@@ -660,10 +665,10 @@ TclDatelex()
            TclDateInput++;
 	}

-        if (isdigit(c = *TclDateInput) || c == '-' || c == '+') { /* INTL: digit */
+        if (isdigit(UCHAR(c = *TclDateInput)) || c == '-' || c == '+') { /* INTL: digit */
            if (c == '-' || c == '+') {
                sign = c == '-' ? -1 : 1;
-                if (!isdigit(*++TclDateInput)) { /* INTL: digit */
+                if (!isdigit(UCHAR(*++TclDateInput))) { /* INTL: digit */
                    /*
 		     * skip the '-' sign
 		     */
@@ -673,7 +678,7 @@ TclDatelex()
                sign = 0;
 	    }
            for (TclDatelval.Number = 0;
-		    isdigit(c = *TclDateInput++); ) { /* INTL: digit */
+		    isdigit(UCHAR(c = *TclDateInput++)); ) { /* INTL: digit */
                TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
 	    }
            TclDateInput--;
@@ -683,7 +688,7 @@ TclDatelex()
            return sign ? tSNUMBER : tUNUMBER;
        }
        if (!(c & 0x80) && isalpha(UCHAR(c))) {	/* INTL: ISO only. */
-            for (p = buff; isalpha(c = *TclDateInput++) /* INTL: ISO only. */
+            for (p = buff; isalpha(UCHAR(c = *TclDateInput++)) /* INTL: ISO only. */
 		     || c == '.'; ) {
                if (p < &buff[sizeof buff - 1]) {
                    *p++ = c;
@@ -803,14 +808,14 @@ TclGetDate(p, now, zone, timePtr)
    *timePtr = Start;
    return 0;
 }
-TclDatetabelem TclDateexca[] ={
+static const TclDatetabelem TclDateexca[] ={
 -1, 1,
 	0, -1,
 	-2, 0,
 	};
 # define YYNPROD 41
 # define YYLAST 227
-TclDatetabelem TclDateact[]={
+static const TclDatetabelem TclDateact[]={

    14,    11,    23,    28,    17,    12,    19,    18,    16,     9,
    10,    13,    42,    21,    46,    45,    44,    48,    41,    37,
@@ -835,39 +840,39 @@ TclDatetabelem TclDateact[]={
     0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
     0,     0,     0,    22,     0,     0,    20,    25,    24,    27,
    26,    42,     0,     0,     0,     0,    40 };
-TclDatetabelem TclDatepact[]={
+static const TclDatetabelem TclDatepact[]={

 -10000000,  -258,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,   -45,
  -267,-10000000,  -244,-10000000,   -14,  -231,  -240,-10000000,-10000000,-10000000,
 -10000000,  -246,-10000000,  -247,  -248,-10000000,-10000000,-10000000,-10000000,   -15,
 -10000000,-10000000,-10000000,-10000000,-10000000,   -40,   -20,-10000000,  -251,-10000000,
 -10000000,  -252,-10000000,  -253,-10000000,  -249,-10000000,-10000000,-10000000 };
-TclDatetabelem TclDatepgo[]={
+static const TclDatetabelem TclDatepgo[]={

     0,    28,    39,    38,    37,    36,    35,    34,    33,    32,
    31 };
-TclDatetabelem TclDater1[]={
+static const TclDatetabelem TclDater1[]={

     0,     2,     2,     3,     3,     3,     3,     3,     3,     4,
     4,     4,     4,     4,     5,     5,     5,     7,     7,     7,
     6,     6,     6,     6,     6,     6,     6,     8,     8,    10,
    10,    10,    10,    10,    10,    10,    10,    10,     9,     1,
     1 };
-TclDatetabelem TclDater2[]={
+static const TclDatetabelem TclDater2[]={

     0,     0,     4,     3,     3,     3,     3,     3,     2,     5,
     9,     9,    13,    13,     5,     3,     3,     3,     5,     5,
     7,    11,     5,     9,     5,     3,     7,     5,     2,     5,
     5,     3,     5,     5,     3,     5,     5,     3,     3,     1,
     3 };
-TclDatetabelem TclDatechk[]={
+static const TclDatetabelem TclDatechk[]={

 -10000000,    -2,    -3,    -4,    -5,    -6,    -7,    -8,    -9,   267,
   268,   259,   263,   269,   258,   -10,   266,   262,   265,   264,
   261,    58,   258,    47,   263,   262,   265,   264,   270,   267,
    44,   257,   262,   265,   264,   267,   267,   267,    44,    -1,
   266,    58,   261,    47,   267,   267,   267,    -1,   266 };
-TclDatetabelem TclDatedef[]={
+static const TclDatetabelem TclDatedef[]={

     1,    -2,     2,     3,     4,     5,     6,     7,     8,    38,
    15,    16,     0,    25,    17,    28,     0,    31,    34,    37,
@@ -979,7 +984,7 @@ char * TclDatereds[] =
 #define YYRECOVERING()	(!!TclDateerrflag)
 #define YYNEW(type)	malloc(sizeof(type) * TclDatenewmax)
 #define YYCOPY(to, from, type) \
-	(type *) memcpy(to, (char *) from, TclDatenewmax * sizeof(type))
+	(type *) memcpy(to, (char *) from, TclDatemaxdepth * sizeof (type))
 #define YYENLARGE( from, type) \
 	(type *) realloc((char *) from, TclDatenewmax * sizeof(type))
 #ifndef YYDEBUG
@@ -1063,12 +1068,12 @@ int TclDateparse(void)
 int TclDateparse()
 #endif
 {
-	register YYSTYPE *TclDatepvt;	/* top of value stack for $vars */
+	register YYSTYPE *TclDatepvt = 0;	/* top of value stack for $vars */

 #if defined(__cplusplus) || defined(lint)
 /*
-	hacks to please C++ and lint - goto's inside switch should never be
-	executed; TclDatepvt is set to 0 to avoid "used before set" warning.
+	hacks to please C++ and lint - goto's inside
+	switch should never be executed
 */
 	static int __yaccpar_lint_hack__ = 0;
 	switch (__yaccpar_lint_hack__)
@@ -1076,7 +1081,6 @@ int TclDateparse()
 		case 1: goto TclDateerrlab;
 		case 2: goto TclDatenewstate;
 	}
-	TclDatepvt = 0;
 #endif

 	/*
@@ -1167,9 +1171,9 @@ int TclDateparse()
 			** reallocate and recover.  Note that pointers
 			** have to be reset, or bad things will happen
 			*/
-			int TclDateps_index = (TclDate_ps - TclDates);
-			int TclDatepv_index = (TclDate_pv - TclDatev);
-			int TclDatepvt_index = (TclDatepvt - TclDatev);
+			long TclDateps_index = (TclDate_ps - TclDates);
+			long TclDatepv_index = (TclDate_pv - TclDatev);
+			long TclDatepvt_index = (TclDatepvt - TclDatev);
 			int TclDatenewmax;
 #ifdef YYEXPAND
 			TclDatenewmax = YYEXPAND(TclDatemaxdepth);
@@ -1295,7 +1299,7 @@ int TclDateparse()
 			** look through exception table
 			*/
 			{
-				register int *TclDatexi = TclDateexca;
+				register const int *TclDatexi = TclDateexca;

 				while ( ( *TclDatexi != -1 ) ||
 					( TclDatexi[1] != TclDate_state ) )
@@ -1572,10 +1576,10 @@ case 24:{
            TclDateDay = TclDatepvt[-1].Number;
        } break;
 case 25:{
-				TclDateMonth = 1;
-				TclDateDay = 1;
-				TclDateYear = EPOCH;
-		  } break;
+	    TclDateMonth = 1;
+	    TclDateDay = 1;
+	    TclDateYear = EPOCH;
+	} break;
 case 26:{
            TclDateMonth = TclDatepvt[-1].Number;
            TclDateDay = TclDatepvt[-2].Number;
@@ -12,7 +12,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclEnv.c,v 1.4 1999/04/16 00:46:46 stanton Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.4.6.1 1999/10/30 11:06:00 hobbs Exp $
 */

 #include "tclInt.h"
@@ -225,23 +225,23 @@ TclSetEnv(name, value)
    p[nameLength] = '=';
    strcpy(p+nameLength+1, value);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
-    ckfree(p);
+
+    /*
+     * Copy the native string to heap memory.
+     */
    
+    p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
+    strcpy(p, p2);
+    Tcl_DStringFree(&envString);

 #ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

-    putenv(p2);
+    putenv(p);
    index = TclpFindVariable(name, &length);
 #else
-    /*
-     * Copy the native string to heap memory.
-     */
-    
-    p = (char *) ckalloc((unsigned) (strlen(p2) + 1));
-    strcpy(p, p2);
    environ[index] = p;
 #endif

@@ -251,9 +251,7 @@ TclSetEnv(name, value)
     * update the string in the cache.
     */

-    if (environ[index] != p) {
-	Tcl_DStringFree(&envString);
-    } else {
+    if ((index != -1) && (environ[index] == p)) {
 	ReplaceString(oldValue, p);
    }

@@ -381,8 +379,10 @@ TclUnsetEnv(name)
    string[length+1] = '\0';
    
    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
-    ckfree(string);
-    string = Tcl_DStringValue(&envString);
+    string = ckrealloc(string, (unsigned) (Tcl_DStringLength(&envString)+1));
+    strcpy(string, Tcl_DStringValue(&envString));
+    Tcl_DStringFree(&envString);
+
    putenv(string);

    /*
@@ -391,9 +391,7 @@ TclUnsetEnv(name)
     * update the string in the cache.
     */

-    if (environ[index] != string) {
-	Tcl_DStringFree(&envString);
-    } else {
+    if (environ[index] == string) {
 	ReplaceString(oldValue, string);
    }
 #else
@@ -663,7 +661,3 @@ TclFinalizeEnvironment()
 #endif
    }
 }
-
-	
-    
-    
@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclEvent.c,v 1.5 1999/04/23 01:57:08 stanton Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.5.6.1 1999/11/19 23:32:04 hobbs Exp $
 */

 #include "tclInt.h"
@@ -453,11 +453,12 @@ Tcl_DeleteExitHandler(proc, clientData)
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    Tcl_MutexUnlock(&exitMutex);
 	    ckfree((char *) exitPtr);
-	    return;
+	    break;
 	}
    }
+    Tcl_MutexUnlock(&exitMutex);
+    return;
 }

 /*
@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclGetDate.y,v 1.4 1999/04/16 00:46:46 stanton Exp $
+ * RCS: @(#) $Id: tclGetDate.y,v 1.4.6.1 1999/09/22 04:12:47 hobbs Exp $
 */

 %{
@@ -250,11 +250,11 @@ date    : tUNUMBER '/' tUNUMBER {
            yyMonth = $2;
            yyDay = $1;
        }
-		  | tEPOCH {
-				yyMonth = 1;
-				yyDay = 1;
-				yyYear = EPOCH;
-		  }
+	| tEPOCH {
+	    yyMonth = 1;
+	    yyDay = 1;
+	    yyYear = EPOCH;
+	}
        | tUNUMBER tMONTH tUNUMBER {
            yyMonth = $2;
            yyDay = $1;
@@ -413,7 +413,8 @@ static TABLE    TimezoneTable[] = {
    { "gmt",    tZONE,     HOUR( 0) },      /* Greenwich Mean */
    { "ut",     tZONE,     HOUR( 0) },      /* Universal (Coordinated) */
    { "utc",    tZONE,     HOUR( 0) },
-    { "wet",    tZONE,     HOUR( 0) } ,     /* Western European */
+    { "uct",    tZONE,     HOUR( 0) },      /* Universal Coordinated Time */
+    { "wet",    tZONE,     HOUR( 0) },      /* Western European */
    { "bst",    tDAYZONE,  HOUR( 0) },      /* British Summer */
    { "wat",    tZONE,     HOUR( 1) },      /* West Africa */
    { "at",     tZONE,     HOUR( 2) },      /* Azores */
@@ -445,6 +446,7 @@ static TABLE    TimezoneTable[] = {
    { "nt",     tZONE,     HOUR(11) },      /* Nome */
    { "idlw",   tZONE,     HOUR(12) },      /* International Date Line West */
    { "cet",    tZONE,    -HOUR( 1) },      /* Central European */
+    { "cest",   tDAYZONE, -HOUR( 1) },      /* Central European Summer */
    { "met",    tZONE,    -HOUR( 1) },      /* Middle European */
    { "mewt",   tZONE,    -HOUR( 1) },      /* Middle European Winter */
    { "mest",   tDAYZONE, -HOUR( 1) },      /* Middle European Summer */
@@ -813,10 +815,10 @@ yylex()
            yyInput++;
 	}

-        if (isdigit(c = *yyInput) || c == '-' || c == '+') { /* INTL: digit */
+        if (isdigit(UCHAR(c = *yyInput)) || c == '-' || c == '+') { /* INTL: digit */
            if (c == '-' || c == '+') {
                sign = c == '-' ? -1 : 1;
-                if (!isdigit(*++yyInput)) { /* INTL: digit */
+                if (!isdigit(UCHAR(*++yyInput))) { /* INTL: digit */
                    /*
 		     * skip the '-' sign
 		     */
@@ -826,7 +828,7 @@ yylex()
                sign = 0;
 	    }
            for (yylval.Number = 0;
-		    isdigit(c = *yyInput++); ) { /* INTL: digit */
+		    isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
                yylval.Number = 10 * yylval.Number + c - '0';
 	    }
            yyInput--;
@@ -836,7 +838,7 @@ yylex()
            return sign ? tSNUMBER : tUNUMBER;
        }
        if (!(c & 0x80) && isalpha(UCHAR(c))) {	/* INTL: ISO only. */
-            for (p = buff; isalpha(c = *yyInput++) /* INTL: ISO only. */
+            for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */
 		     || c == '.'; ) {
                if (p < &buff[sizeof buff - 1]) {
                    *p++ = c;
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclIO.c,v 1.14 1999/08/10 17:35:18 redman Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.14.4.1 1999/09/22 04:12:48 hobbs Exp $
 */

 #include "tclInt.h"
@@ -8157,7 +8157,6 @@ SetBlockMode(interp, chanPtr, mode)
    }
    return TCL_OK;
 }
-

 /*
 *----------------------------------------------------------------------
@@ -8176,7 +8175,8 @@ SetBlockMode(interp, chanPtr, mode)
 */

 int
-Tcl_GetChannelNames(Tcl_Interp *interp)
+Tcl_GetChannelNames(interp)
+    Tcl_Interp *interp;		/* Interp for error reporting. */
 {
    Channel *chanPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -8,7 +8,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.6 1999/05/05 01:19:43 stanton Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.6.6.1 1999/09/22 04:12:49 hobbs Exp $
 */

 #include "tclInt.h"
@@ -350,12 +350,14 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
        }
    }

-    resultPtr = Tcl_GetObjResult(interp);
+    resultPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(resultPtr);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead < 0) {
 	Tcl_ResetResult(interp);
 	Tcl_AppendResult(interp, "error reading \"", name, "\": ",
 		Tcl_PosixError(interp), (char *) NULL);
+	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
    }
    
@@ -372,6 +374,8 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
 	    Tcl_SetObjLength(resultPtr, length - 1);
 	}
    }
+    Tcl_SetObjResult(interp, resultPtr);
+    Tcl_DecrRefCount(resultPtr);
    return TCL_OK;
 }

@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclParseExpr.c,v 1.4 1999/04/21 21:50:28 rjohnson Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.4.6.1 1999/09/22 04:12:49 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1589,7 +1589,7 @@ GetLexeme(infoPtr)
 	    infoPtr->lexeme = DOLLAR;
 	    return TCL_OK;

-	case '"':
+	case '\"':
 	    infoPtr->lexeme = QUOTE;
 	    return TCL_OK;

@@ -9,7 +9,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclPkg.c,v 1.4 1999/04/16 00:46:51 stanton Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.4.6.1 1999/09/22 04:12:49 hobbs Exp $
 */

 #include "tclInt.h"
@@ -871,16 +871,19 @@ CheckVersion(interp, string)
 				 * by dots. */
 {
    char *p = string;
+    char prevChar;

    if (!isdigit(UCHAR(*p))) {	/* INTL: digit */
 	goto error;
    }
-    for (p++; *p != 0; p++) {
-	if (!isdigit(UCHAR(*p)) && (*p != '.')) { /* INTL: digit */
+    for (prevChar = *p, p++; *p != 0; p++) {
+	if (!isdigit(UCHAR(*p)) &&
+		((*p != '.') || (prevChar == '.'))) { /* INTL: digit */
 	    goto error;
 	}
+	prevChar = *p;
    }
-    if (p[-1] != '.') {
+    if (prevChar != '.') {
 	return TCL_OK;
    }

@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclPosixStr.c,v 1.4 1999/04/16 00:46:52 stanton Exp $
+ * RCS: @(#) $Id: tclPosixStr.c,v 1.4.6.1 1999/09/22 04:12:49 hobbs Exp $
 */

 #include "tclInt.h"
@@ -736,7 +736,7 @@ Tcl_ErrnoMsg(err)
 	case ENOPKG: return "package not installed";
 #endif
 #ifdef ENOPROTOOPT
-	case ENOPROTOOPT: return "bad proocol option";
+	case ENOPROTOOPT: return "bad protocol option";
 #endif
 #ifdef ENOSPC
 	case ENOSPC: return "no space left on device";
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclProc.c,v 1.19 1999/04/16 00:46:52 stanton Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.19.6.1 1999/09/22 04:12:50 hobbs Exp $
 */

 #include "tclInt.h"
@@ -135,6 +135,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
 	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);

+    Tcl_DStringFree(&ds);
    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
     * later when the procedure is called to determine what namespace the
@@ -265,7 +266,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)

    if (precompiled) {
        if (numArgs > procPtr->numArgs) {
-            char buf[128];
+            char buf[64 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
            sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
                    numArgs, procPtr->numArgs);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -351,7 +352,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
                            && (fieldCount == 2))
                    || ((localPtr->defValuePtr != NULL)
                            && (fieldCount != 2))) {
-                char buf[128];
+                char buf[80 + TCL_INTEGER_SPACE];
                sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
                        i);
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1087,7 +1088,6 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
 	}
    }
    if (bodyPtr->typePtr != &tclByteCodeType) {
- 	char buf[100];
 	int numChars;
 	char *ellipsis;
 	
@@ -1133,7 +1133,9 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
 	
 	if (result != TCL_OK) {
 	    if (result == TCL_ERROR) {
- 		numChars = strlen(procName);
+		char buf[100 + TCL_INTEGER_SPACE];
+
+		numChars = strlen(procName);
 		ellipsis = "";
 		if (numChars > 50) {
 		    numChars = 50;
@@ -1201,13 +1203,20 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
    int returnCode;		/* The unexpected result code. */
 {
    Interp *iPtr = (Interp *) interp;
-    char msg[100 + TCL_INTEGER_SPACE];
-    
+
    if (returnCode == TCL_RETURN) {
 	returnCode = TclUpdateReturnInfo(iPtr);
    } else if (returnCode == TCL_ERROR) {
-	sprintf(msg, "\n    (procedure \"%.*s\" line %d)",
-		nameLen, procName, iPtr->errorLine);
+	char msg[100 + TCL_INTEGER_SPACE];
+	char *ellipsis = "";
+	int numChars = nameLen;
+
+	if (numChars > 60) {
+	    numChars = 60;
+	    ellipsis = "...";
+	}
+	sprintf(msg, "\n    (procedure \"%.*s%s\" line %d)",
+		numChars, procName, ellipsis, iPtr->errorLine);
 	Tcl_AddObjErrorInfo(interp, msg, -1);
    } else if (returnCode == TCL_BREAK) {
 	Tcl_ResetResult(interp);
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclRegexp.c,v 1.9 1999/06/17 19:32:15 stanton Exp $
+ * RCS: @(#) $Id: tclRegexp.c,v 1.9.4.1 1999/11/02 02:09:49 hobbs Exp $
 */

 #include "tclInt.h"
@@ -642,7 +642,8 @@ TclRegAbout(interp, re)
 	{REG_ULOCALE,		"REG_ULOCALE"},
 	{REG_UEMPTYMATCH,	"REG_UEMPTYMATCH"},
 	{REG_UIMPOSSIBLE,	"REG_UIMPOSSIBLE"},
-	 {0,			""}
+	{REG_USHORTEST,		"REG_USHORTEST"},
+	{0,			""}
    };
    struct infoname *inf;
    int n;
@@ -8,7 +8,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclResult.c,v 1.3 1999/05/07 20:07:35 stanton Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.3.6.1 1999/10/30 11:06:00 hobbs Exp $
 */

 #include "tclInt.h"
@@ -455,10 +455,12 @@ Tcl_AppendResultVA (interp, argList)
 				 * return value. */
    va_list argList;		/* Variable argument list. */
 {
+#define STATIC_LIST_SIZE 16
    Interp *iPtr = (Interp *) interp;
-    va_list tmpArgList;
-    char *string;
-    int newSpace;
+    char *string, *static_list[STATIC_LIST_SIZE];
+    char **args = static_list;
+    int nargs_space = STATIC_LIST_SIZE;
+    int nargs, newSpace, i;

    /*
     * If the string result is empty, move the object result to the
@@ -472,17 +474,35 @@ Tcl_AppendResultVA (interp, argList)
    }
    
    /*
-     * Scan through all the arguments to see how much space is needed.
+     * Scan through all the arguments to see how much space is needed
+     * and save pointers to the arguments in the args array,
+     * reallocating as necessary.
     */

-    memcpy ((VOID *) &tmpArgList, (VOID *) &argList, sizeof (tmpArgList));
+    nargs = 0;
    newSpace = 0;
    while (1) {
-	string = va_arg(tmpArgList, char *);
+ 	string = va_arg(argList, char *);
 	if (string == NULL) {
 	    break;
 	}
-	newSpace += strlen(string);
+ 	if (nargs >= nargs_space) {
+ 	    /* 
+ 	     * Expand the args buffer
+ 	     */
+ 	    nargs_space += STATIC_LIST_SIZE;
+ 	    if (args == static_list) {
+ 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
+ 		for (i = 0; i < nargs; ++i) {
+ 		    args[i] = static_list[i];
+ 		}
+ 	    } else {
+ 		args = (void *)ckrealloc((void *)args,
+			nargs_space * sizeof(char *));
+ 	    }
+ 	}
+  	newSpace += strlen(string);
+	args[nargs++] = string;
    }

    /*
@@ -501,14 +521,21 @@ Tcl_AppendResultVA (interp, argList)
     * buffer.
     */

-    while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
-	    break;
-	}
-	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
-	iPtr->appendUsed += strlen(string);
+    for (i = 0; i < nargs; ++i) {
+ 	string = args[i];
+  	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+  	iPtr->appendUsed += strlen(string);
    }
+ 
+    /*
+     * If we had to allocate a buffer from the heap, 
+     * free it now.
+     */
+ 
+    if (args != static_list) {
+     	ckfree((void *)args);
+    }
+#undef STATIC_LIST_SIZE
 }

 /*
@@ -33,7 +33,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclStringObj.c,v 1.12 1999/06/16 00:47:56 hershey Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.12.4.3 1999/11/19 23:32:05 hobbs Exp $ */

 #include "tclInt.h"

@@ -275,7 +275,15 @@ Tcl_NewUnicodeObj(unicode, numChars)
 {
    Tcl_Obj *objPtr;
    String *stringPtr;
-    int uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+    size_t uallocated;
+
+    if (numChars < 0) {
+	numChars = 0;
+	if (unicode) {
+	    while (unicode[numChars] != 0) { numChars++; }
+	}
+    }
+    uallocated = (numChars + 1) * sizeof(Tcl_UniChar);

    /*
     * Create a new obj with an invalid string rep.
@@ -289,8 +297,7 @@ Tcl_NewUnicodeObj(unicode, numChars)
    stringPtr->numChars = numChars;
    stringPtr->uallocated = uallocated;
    stringPtr->allocated = 0;
-    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode,
-	    (size_t) (numChars * sizeof(Tcl_UniChar)));
+    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
    stringPtr->unicode[numChars] = 0;
    SET_STRING(objPtr, stringPtr);
    return objPtr;
@@ -334,11 +341,11 @@ Tcl_GetCharLength(objPtr)
 	if (stringPtr->numChars == objPtr->length) {

 	    /*
-	     * Since we've just calucalated the number of chars, and all
+	     * Since we've just calculated the number of chars, and all
 	     * UTF chars are 1-byte long, we don't need to store the
 	     * unicode string.
 	     */
-	    
+
 	    stringPtr->uallocated = 0;

 	} else {
@@ -427,7 +434,7 @@ Tcl_GetUniChar(objPtr, index)
 *
 * Tcl_GetUnicode --
 *
- *	Get the index'th Unicode character from the String object.  If
+ *	Get the Unicode form of the String object.  If
 *	the object is not already a String object, it will be converted
 *	to one.  If the String object does not have a Unicode rep, then
 *	one is create from the UTF string format.
@@ -703,7 +710,15 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
 {
    Tcl_ObjType *typePtr;
    String *stringPtr;
-    size_t uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+    size_t uallocated;
+
+    if (numChars < 0) {
+	numChars = 0;
+	if (unicode) {
+	    while (unicode[numChars] != 0) { numChars++; }
+	}
+    }
+    uallocated = (numChars + 1) * sizeof(Tcl_UniChar);

    /*
     * Free the internal rep if one exists, and invalidate the string rep.
@@ -723,8 +738,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
    stringPtr->numChars = numChars;
    stringPtr->uallocated = uallocated;
    stringPtr->allocated = 0;
-    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode,
-	    (size_t) (numChars * sizeof(Tcl_UniChar)));
+    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
    stringPtr->unicode[numChars] = 0;
    SET_STRING(objPtr, stringPtr);
    Tcl_InvalidateStringRep(objPtr);
@@ -916,17 +930,18 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
     * number of characters in the final (appended-to) object.
     */

+    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+
    allOneByteChars = 0;
    numChars = stringPtr->numChars;
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
 	stringPtr = GET_STRING(appendObjPtr);
-	if (stringPtr->numChars >= 0) {
+	if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
 	    numChars += stringPtr->numChars;
 	    allOneByteChars = 1;
 	}
    }
-    
-    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
+
    AppendUtfToUtfRep(objPtr, bytes, length);

    if (allOneByteChars) {
@@ -962,6 +977,12 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
    int numChars;
    size_t newSize;

+    if (appendNumChars < 0) {
+	appendNumChars = 0;
+	if (unicode) {
+	    while (unicode[appendNumChars] != 0) { appendNumChars++; }
+	}
+    }
    if (appendNumChars == 0) {
 	return;
    }
@@ -1026,6 +1047,12 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
    Tcl_DString dsPtr;
    char *bytes;
    
+    if (numChars < 0) {
+	numChars = 0;
+	if (unicode) {
+	    while (unicode[numChars] != 0) { numChars++; }
+	}
+    }
    if (numChars == 0) {
 	return;
    }
@@ -1169,10 +1196,14 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
    Tcl_Obj *objPtr;		/* Points to the object to append to. */
    va_list argList;		/* Variable argument list. */
 {
+#define STATIC_LIST_SIZE 16
    String *stringPtr;
-    va_list tmpArgList;
    int newLength, oldLength;
    register char *string, *dst;
+    char *static_list[STATIC_LIST_SIZE];
+    char **args = static_list;
+    int nargs_space = STATIC_LIST_SIZE;
+    int nargs, i;

    if (Tcl_IsShared(objPtr)) {
 	panic("Tcl_AppendStringsToObj called with shared object");
@@ -1187,17 +1218,33 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     * (notably OS/390) the argList is an array so we need to use memcpy.
     */

-    memcpy ((VOID *) &tmpArgList, (VOID *) &argList, sizeof (tmpArgList));
+    nargs = 0;
    newLength = oldLength = objPtr->length;
    while (1) {
-	string = va_arg(tmpArgList, char *);
+	string = va_arg(argList, char *);
 	if (string == NULL) {
 	    break;
 	}
+ 	if (nargs >= nargs_space) {
+ 	    /* 
+ 	     * Expand the args buffer
+ 	     */
+ 	    nargs_space += STATIC_LIST_SIZE;
+ 	    if (args == static_list) {
+ 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
+ 		for (i = 0; i < nargs; ++i) {
+ 		    args[i] = static_list[i];
+ 		}
+ 	    } else {
+ 		args = (void *)ckrealloc((void *)args,
+			nargs_space * sizeof(char *));
+ 	    }
+ 	}
 	newLength += strlen(string);
+	args[nargs++] = string;
    }
    if (newLength == oldLength) {
-	return;
+	goto done;
    }

    stringPtr = GET_STRING(objPtr);
@@ -1221,8 +1268,8 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
     */

    dst = objPtr->bytes + oldLength;
-    while (1) {
-	string = va_arg(argList, char *);
+    for (i = 0; i < nargs; ++i) {
+ 	string = args[i];
 	if (string == NULL) {
 	    break;
 	}
@@ -1244,6 +1291,17 @@ Tcl_AppendStringsToObjVA (objPtr, argList)
 	*dst = 0;
    }
    objPtr->length = newLength;
+
+    done:
+    /*
+     * If we had to allocate a buffer from the heap, 
+     * free it now.
+     */
+ 
+    if (args != static_list) {
+     	ckfree((void *)args);
+    }
+#undef STATIC_LIST_SIZE
 }

 /*
@@ -13,7 +13,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclTest.c,v 1.16 1999/08/13 17:53:19 redman Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.16.2.1 1999/11/02 02:09:50 hobbs Exp $
 */

 #define TCL_TEST
@@ -2788,7 +2788,7 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
 		break;
 	    }
 	    case '+': {
-		cflags |= REG_FAKEEC;
+		cflags |= REG_FAKE;
 		break;
 	    }
 	    case ',': {
@@ -2815,7 +2815,7 @@ TestregexpXflags(string, length, cflagsPtr, eflagsPtr)
 		eflags |= REG_NOTEOL;
 		break;
 	    }
-	    case '?': {
+	    case 't': {
 		cflags |= REG_EXPECT;
 		break;
 	    }
@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclThreadTest.c,v 1.3 1999/05/26 20:24:43 redman Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.3.4.1 1999/10/30 11:06:01 hobbs Exp $
 */

 #include "tclInt.h"
@@ -135,6 +135,9 @@ static void	ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
 static void	ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr));
 static int	ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask));
 static void	ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp));
+static void	ThreadFreeProc _ANSI_ARGS_((ClientData clientData));
+static int	ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr,
+	ClientData clientData));
 static void	ThreadExitProc _ANSI_ARGS_((ClientData clientData));


@@ -351,8 +354,7 @@ TclCreateThread(interp, script)
    ThreadCtrl ctrl;
    Tcl_ThreadId id;

-    ctrl.script = (char*)ckalloc( strlen(script) + 1 );
-    strcpy(ctrl.script, script);
+    ctrl.script = (char *) script;
    ctrl.condWait = NULL;
    ctrl.flags = 0;

@@ -413,10 +415,8 @@ NewThread(clientData)
 {
    ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    ThreadCtrl ctrl;
    int result;
-
-    ctrl = *ctrlPtr;
+    char *threadEvalScript;

    /*
     * Initialize the interpreter.  This should be more general.
@@ -432,7 +432,14 @@ NewThread(clientData)

    Tcl_MutexLock(&threadMutex);
    ListUpdateInner(tsdPtr);
-    Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
+    /*
+     * We need to keep a pointer to the alloc'ed mem of the script
+     * we are eval'ing, for the case that we exit during evaluation
+     */
+    threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
+    strcpy(threadEvalScript, ctrlPtr->script);
+
+    Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);

    /*
     * Notify the parent we are alive.
@@ -446,7 +453,7 @@ NewThread(clientData)
     */

    Tcl_Preserve((ClientData) tsdPtr->interp);
-    result = Tcl_Eval(tsdPtr->interp, ctrl.script);
+    result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
    if (result != TCL_OK) {
 	ThreadErrorProc(tsdPtr->interp);
    }
@@ -456,7 +463,6 @@ NewThread(clientData)
     */

    ListRemove(tsdPtr);
-    ckfree((char*)ctrl.script);
    Tcl_Release((ClientData) tsdPtr->interp);
    Tcl_DeleteInterp(tsdPtr->interp);
    Tcl_ExitThread(result);
@@ -676,7 +682,7 @@ TclThreadSend(interp, id, script, wait)
    threadEventPtr->script = ckalloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
-	threadEventPtr->resultPtr = NULL;
+	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
 	resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
 	threadEventPtr->resultPtr = resultPtr;
@@ -802,7 +808,11 @@ ThreadEventProc(evPtr, mask)
    } else {
 	Tcl_Preserve((ClientData) interp);
 	Tcl_ResetResult(interp);
+	Tcl_CreateThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	code = Tcl_GlobalEval(interp, threadEventPtr->script);
+	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	result = Tcl_GetStringResult(interp);
 	if (code != TCL_OK) {
 	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
@@ -834,6 +844,65 @@ ThreadEventProc(evPtr, mask)
    return 1;
 }

+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadFreeProc --
+ *
+ *    This is called from when we are exiting and memory needs
+ *    to be freed.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *	Clears up mem specified in ClientData
+ *
+ *------------------------------------------------------------------------
+ */
+     /* ARGSUSED */
+void
+ThreadFreeProc(clientData)
+    ClientData clientData;
+{
+    if (clientData) {
+	ckfree((char *) clientData);
+    }
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * ThreadDeleteEvent --
+ *
+ *    This is called from the ThreadExitProc to delete memory related
+ *    to events that we put on the queue.
+ *
+ * Results:
+ *    1 it was our event and we want it removed, 0 otherwise.
+ *
+ * Side effects:
+ *	It cleans up our events in the event queue for this thread.
+ *
+ *------------------------------------------------------------------------
+ */
+     /* ARGSUSED */
+int
+ThreadDeleteEvent(eventPtr, clientData)
+    Tcl_Event *eventPtr;		/* Really ThreadEvent */
+    ClientData clientData;		/* dummy */
+{
+    if (eventPtr->proc == ThreadEventProc) {
+	ckfree((char *) ((ThreadEvent *) eventPtr)->script);
+	return 1;
+    }
+    /*
+     * If it was NULL, we were in the middle of servicing the event
+     * and it should be removed
+     */
+    return (eventPtr->proc == NULL);
+}
+
 /*
 *------------------------------------------------------------------------
 *
@@ -852,13 +921,21 @@ ThreadEventProc(evPtr, mask)
 */
     /* ARGSUSED */
 void
-ThreadExitProc(dummy)
-    ClientData dummy;
+ThreadExitProc(clientData)
+    ClientData clientData;
 {
+    char *threadEvalScript = (char *) clientData;
    ThreadEventResult *resultPtr, *nextPtr;
    Tcl_ThreadId self = Tcl_GetCurrentThread();

    Tcl_MutexLock(&threadMutex);
+
+    if (threadEvalScript) {
+	ckfree((char *) threadEvalScript);
+	threadEvalScript = NULL;
+    }
+    Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
+
    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
 	nextPtr = resultPtr->nextPtr;
 	if (resultPtr->srcThreadId == self) {
@@ -14,7 +14,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclVar.c,v 1.12 1999/08/10 02:42:14 welch Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.12.4.1 1999/09/22 04:12:50 hobbs Exp $
 */

 #include "tclInt.h"
@@ -3255,8 +3255,7 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
 	    
 	    return TCL_OK;
 	}
-	if (TclIsVarArrayElement(varPtr) ||
-		!TclIsVarUndefined(varPtr)) {
+	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
 	    /*
 	     * Either an array element, or a scalar: lose!
 	     */
@@ -3269,9 +3268,17 @@ TclArraySet(interp, arrayNameObj, arrayElemObj)
 	 * Create variable for new array.
 	 */
 	
-	varPtr = TclLookupVar(interp, varName, (char *) NULL, 0, 0,
+	varPtr = TclLookupVar(interp, varName, (char *) NULL,
+		TCL_LEAVE_ERR_MSG, "set",
 	        /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);

+	/*
+	 * Still couldn't do it - this can occur if a non-existent
+	 * namespace was specified
+	 */
+	if (varPtr == NULL) {
+	    return TCL_ERROR;
+	}
    }
    TclSetVarArray(varPtr);
    TclClearVarUndefined(varPtr);
@@ -1 +1,5 @@
-package ifneeded dde 1.1 "load [list [file join $dir tcldde82.dll]] dde"
+if {[info exists tcl_platform(debug)]} {
+    package ifneeded dde 1.1 [list load [file join $dir tcldde82d.dll] dde]
+} else {
+    package ifneeded dde 1.1 [list load [file join $dir tcldde82.dll] dde]
+}
@@ -1 +1,5 @@
-package ifneeded dde 1.1 "load [list [file join $dir tcldde82.dll]] dde"
+if {[info exists tcl_platform(debug)]} {
+    package ifneeded dde 1.1 [list load [file join $dir tcldde82d.dll] dde]
+} else {
+    package ifneeded dde 1.1 [list load [file join $dir tcldde82.dll] dde]
+}
@@ -9,24 +9,23 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.9 1999/08/05 16:57:48 hobbs Exp $
+# RCS: @(#) $Id: http.tcl,v 1.9.4.3 1999/11/19 23:32:24 hobbs Exp $

-package provide http 2.1	;# This uses Tcl namespaces
+package provide http 2.2	;# This uses Tcl namespaces

 namespace eval http {
    variable http
-
    array set http {
 	-accept */*
 	-proxyhost {}
 	-proxyport {}
-	-useragent {Tcl http client package 2.1}
+	-useragent {Tcl http client package 2.2}
 	-proxyfilter http::ProxyRequired
    }

    variable formMap
-    set alphanumeric	a-zA-Z0-9
-
+    variable alphanumeric a-zA-Z0-9
+    variable c
    variable i 0
    for {} {$i <= 256} {incr i} {
 	set c [format %c $i]
@@ -39,10 +38,50 @@ namespace eval http {
 	" " +   \n %0d%0a
    }

-    namespace export geturl config reset wait formatQuery 
+    variable urlTypes
+    array set urlTypes {
+	http	{80 ::socket}
+    }
+
+    namespace export geturl config reset wait formatQuery register unregister
    # Useful, but not exported: data size status code
 }

+# http::register --
+#
+#     See documentaion for details.
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+#     port            Default port for protocol
+#     command         Command to use to create socket
+# Results:
+#     list of port and command that was registered.
+
+proc http::register {proto port command} {
+    variable urlTypes
+    set urlTypes($proto) [list $port $command]
+}
+
+# http::unregister --
+#
+#     Unregisters URL protocol handler
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+# Results:
+#     list of port and command that was unregistered.
+
+proc http::unregister {proto} {
+    variable urlTypes
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set old $urlTypes($proto)
+    unset urlTypes($proto)
+    return $old
+}
+
 # http::config --
 #
 #	See documentaion for details.
@@ -83,6 +122,17 @@ proc http::config {args} {
    }
 }

+# http::Finish --
+#
+#	Clean up the socket and eval close time callbacks
+#
+# Arguments:
+#	token	Connection token.
+#	errormsg	If set, forces status to error.
+#
+# Side Effects:
+#        Closes the socket
+
 proc http::Finish { token {errormsg ""} } {
    variable $token
    upvar 0 $token state
@@ -114,8 +164,9 @@ proc http::config {args} {
 # Arguments:
 #	token	Connection token.
 #	why	Status info.
-# Results:
-#        TODO
+#
+# Side Effects:
+#       See Finish

 proc http::reset { token {why reset} } {
    variable $token
@@ -145,6 +196,7 @@ proc http::reset { token {why reset} } {

 proc http::geturl { url args } {
    variable http
+    variable urlTypes

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.
@@ -164,6 +216,7 @@ proc http::geturl { url args } {
 	-validate 	0
 	-headers 	{}
 	-timeout 	0
+	-type           application/x-www-form-urlencoded
 	state		header
 	meta		{}
 	currentsize	0
@@ -173,18 +226,16 @@ proc http::geturl { url args } {
 	status		""
    }
    set options {-blocksize -channel -command -handler -headers \
-		-progress -query -validate -timeout}
+		-progress -query -validate -timeout -type}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
 	if {[regexp $pat $flag]} {
-
 	    # Validate numbers
-
 	    if {[info exists state($flag)] && \
-		    [regexp {^[0-9]+$} $state($flag)] && \
-		    ![regexp {^[0-9]+$} $value]} {
+		    [string is integer -strict $state($flag)] && \
+		    ![string is integer -strict $value]} {
 		return -code error "Bad value for $flag ($value), must be integer"
 	    }
 	    set state($flag) $value
@@ -192,12 +243,22 @@ proc http::geturl { url args } {
 	    return -code error "Unknown option $flag, can be: $usage"
 	}
    }
-    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
-	    x proto host y port srvurl]} {
+    if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
+	    x prefix proto host y port srvurl]} {
 	error "Unsupported URL: $url"
    }
+    if {[string length $proto] == 0} {
+	set proto http
+	set url ${proto}://$url
+    }
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set defport [lindex $urlTypes($proto) 0]
+    set defcmd [lindex $urlTypes($proto) 1]
+
    if {[string length $port] == 0} {
-	set port 80
+	set port $defport
    }
    if {[string length $srvurl] == 0} {
 	set srvurl /
@@ -227,23 +288,22 @@ proc http::geturl { url args } {

    if {[info exists phost] && [string length $phost]} {
 	set srvurl $url
-	set s [eval socket $async {$phost $pport}]
+	set s [eval $defcmd $async {$phost $pport}]
    } else {
-	set s [eval socket $async {$host $port}]
+	set s [eval $defcmd $async {$host $port}]
    }
    set state(sock) $s

    # Wait for the connection to complete

    if {$state(-timeout) > 0} {
-	#fileevent $s writable [list set $token\(status) connect]
 	fileevent $s writable [list http::Connect $token]
 	http::wait $token
-	if {[string compare $state(status) "timeout"] == 0} {
-	    return
+	if {![string equal $state(status) "connect"]} {
+	    return $token
 	}
 	fileevent $s writable {}
-	unset state(status)
+	set state(status) ""
    }

    # Send data in cr-lf format, but accept any line terminators
@@ -264,28 +324,37 @@ proc http::geturl { url args } {
    } elseif {$state(-validate)} {
 	set how HEAD
    }
-    puts $s "$how $srvurl HTTP/1.0"
-    puts $s "Accept: $http(-accept)"
-    puts $s "Host: $host"
-    puts $s "User-Agent: $http(-useragent)"
-    foreach {key value} $state(-headers) {
-	regsub -all \[\n\r\]  $value {} value
-	set key [string trim $key]
-	if {[string length $key]} {
-	    puts $s "$key: $value"
+    if {[catch {
+	puts $s "$how $srvurl HTTP/1.0"
+	puts $s "Accept: $http(-accept)"
+	puts $s "Host: $host"
+	puts $s "User-Agent: $http(-useragent)"
+	foreach {key value} $state(-headers) {
+	    regsub -all \[\n\r\]  $value {} value
+	    set key [string trim $key]
+	    if {[string length $key]} {
+		puts $s "$key: $value"
+	    }
 	}
+	if {$len > 0} {
+	    puts $s "Content-Length: $len"
+	    puts $s "Content-Type: $state(-type)"
+	    puts $s ""
+	    fconfigure $s -translation {auto binary}
+	    puts $s $state(-query)
+	} else {
+	    puts $s ""
+	}
+	flush $s
+	fileevent $s readable [list http::Event $token]
+    } err]} {
+	# The socket probably was never connected, or the connection
+	# dropped later.
+
+	reset $token ioerror
+	return $token
    }
-    if {$len > 0} {
-	puts $s "Content-Length: $len"
-	puts $s "Content-Type: application/x-www-form-urlencoded"
-	puts $s ""
-	fconfigure $s -translation {auto binary}
-	puts $s $state(-query)
-    } else {
-	puts $s ""
-    }
-    flush $s
-    fileevent $s readable [list http::Event $token]
+
    if {! [info exists state(-command)]} {
 	wait $token
    }
@@ -336,12 +405,38 @@ proc http::cleanup {token} {
 	unset state
    }
 }
+
+# http::Connect
+#
+#	Wait for an asynchronous connection to complete
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Sets the status of the connection, which unblocks
+# 	the waiting geturl call
+
 proc http::Connect {token} {
    variable $token
    upvar 0 $token state
-    set state(status) connect
+    if {[eof $state(sock)]} {
+	set state(status) ioerror
+    } else {
+	set state(status) connect
+    }
 }

+# http::Event
+#
+#	Handle input on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Read the socket and handle callbacks.
+
 proc http::Event {token} {
    variable $token
    upvar 0 $token state
@@ -351,8 +446,10 @@ proc http::cleanup {token} {
 	Eof $token
 	return
    }
-    if {$state(state) == "header"} {
-	set n [gets $s line]
+    if {[string equal $state(state) "header"]} {
+	if {[catch {gets $s line} n]} {
+	    Finish $token $err
+	}
 	if {$n == 0} {
 	    set state(state) body
 	    if {![regexp -nocase ^text $state(type)]} {
@@ -404,6 +501,18 @@ proc http::cleanup {token} {
 	}
    }
 }
+
+# http::CopyStart
+#
+#	Error handling wrapper around fcopy
+#
+# Arguments
+#	s	The socket to copy from
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	This closes the connection upon error
+
 proc http::CopyStart {s token} {
    variable $token
    upvar 0 $token state
@@ -414,6 +523,18 @@ proc http::cleanup {token} {
 	Finish $token $err
    }
 }
+
+# http::CopyDone
+#
+#	fcopy completion callback
+#
+# Arguments
+#	token	The token returned from http::geturl
+#	count	The amount transfered
+#
+# Side Effects
+#	Invokes callbacks
+
 proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state
@@ -423,7 +544,7 @@ proc http::cleanup {token} {
 	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    # At this point the token may have been reset
-    if {([string length $error] != 0)} {
+    if {[string length $error]} {
 	Finish $token $error
    } elseif {[catch {::eof $s} iseof] || $iseof} {
 	Eof $token
@@ -431,10 +552,21 @@ proc http::cleanup {token} {
 	CopyStart $s $token
    }
 }
+
+# http::Eof
+#
+#	Handle eof on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Clean up the socket
+
 proc http::Eof {token} {
    variable $token
    upvar 0 $token state
-    if {$state(state) == "header"} {
+    if {[string equal $state(state) "header"]} {
 	# Premature eof
 	set state(status) eof
    } else {
@@ -458,9 +590,7 @@ proc http::wait {token} {
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
-
 	# We must wait on the original variable name, not the upvar alias
-
 	vwait $token\(status)
    }
    if {[info exists state(error)]} {
@@ -487,8 +617,8 @@ proc http::formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
-	append result  $sep [mapReply $i]
-	if {$sep != "="} {
+	append result $sep [mapReply $i]
+	if {[string compare $sep "="]} {
 	    set sep =
 	} else {
 	    set sep &
@@ -497,15 +627,25 @@ proc http::formatQuery {args} {
    return $result
 }

-# do x-www-urlencoded character mapping
-# The spec says: "non-alphanumeric characters are replaced by '%HH'"
-# 1 leave alphanumerics characters alone
-# 2 Convert every other character to an array lookup
-# 3 Escape constructs that are "special" to the tcl parser
-# 4 "subst" the result, doing all the array substitutions
- 
+# http::mapReply --
+#
+#	Do x-www-urlencoded character mapping
+#
+# Arguments:
+#	string	The string the needs to be encoded
+#
+# Results:
+#       The encoded string
+
 proc http::mapReply {string} {
    variable formMap
+
+    # The spec says: "non-alphanumeric characters are replaced by '%HH'"
+    # 1 leave alphanumerics characters alone
+    # 2 Convert every other character to an array lookup
+    # 3 Escape constructs that are "special" to the tcl parser
+    # 4 "subst" the result, doing all the array substitutions
+
    set alphanumeric	a-zA-Z0-9
    regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
    regsub -all \n $string {\\n} string
@@ -514,7 +654,15 @@ proc http::formatQuery {args} {
    return [subst $string]
 }

-# Default proxy filter. 
+# http::ProxyRequired --
+#	Default proxy filter. 
+#
+# Arguments:
+#	host	The destination host
+#
+# Results:
+#       The current proxy settings
+
 proc http::ProxyRequired {host} {
    variable http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
@@ -8,4 +8,4 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.

-package ifneeded http 2.1 [list tclPkgSetup $dir http 2.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait}}}]
+package ifneeded http 2.2 [list tclPkgSetup $dir http 2.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
@@ -9,24 +9,23 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.9 1999/08/05 16:57:48 hobbs Exp $
+# RCS: @(#) $Id: http.tcl,v 1.9.4.3 1999/11/19 23:32:24 hobbs Exp $

-package provide http 2.1	;# This uses Tcl namespaces
+package provide http 2.2	;# This uses Tcl namespaces

 namespace eval http {
    variable http
-
    array set http {
 	-accept */*
 	-proxyhost {}
 	-proxyport {}
-	-useragent {Tcl http client package 2.1}
+	-useragent {Tcl http client package 2.2}
 	-proxyfilter http::ProxyRequired
    }

    variable formMap
-    set alphanumeric	a-zA-Z0-9
-
+    variable alphanumeric a-zA-Z0-9
+    variable c
    variable i 0
    for {} {$i <= 256} {incr i} {
 	set c [format %c $i]
@@ -39,10 +38,50 @@ namespace eval http {
 	" " +   \n %0d%0a
    }

-    namespace export geturl config reset wait formatQuery 
+    variable urlTypes
+    array set urlTypes {
+	http	{80 ::socket}
+    }
+
+    namespace export geturl config reset wait formatQuery register unregister
    # Useful, but not exported: data size status code
 }

+# http::register --
+#
+#     See documentaion for details.
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+#     port            Default port for protocol
+#     command         Command to use to create socket
+# Results:
+#     list of port and command that was registered.
+
+proc http::register {proto port command} {
+    variable urlTypes
+    set urlTypes($proto) [list $port $command]
+}
+
+# http::unregister --
+#
+#     Unregisters URL protocol handler
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+# Results:
+#     list of port and command that was unregistered.
+
+proc http::unregister {proto} {
+    variable urlTypes
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set old $urlTypes($proto)
+    unset urlTypes($proto)
+    return $old
+}
+
 # http::config --
 #
 #	See documentaion for details.
@@ -83,6 +122,17 @@ proc http::config {args} {
    }
 }

+# http::Finish --
+#
+#	Clean up the socket and eval close time callbacks
+#
+# Arguments:
+#	token	Connection token.
+#	errormsg	If set, forces status to error.
+#
+# Side Effects:
+#        Closes the socket
+
 proc http::Finish { token {errormsg ""} } {
    variable $token
    upvar 0 $token state
@@ -114,8 +164,9 @@ proc http::config {args} {
 # Arguments:
 #	token	Connection token.
 #	why	Status info.
-# Results:
-#        TODO
+#
+# Side Effects:
+#       See Finish

 proc http::reset { token {why reset} } {
    variable $token
@@ -145,6 +196,7 @@ proc http::reset { token {why reset} } {

 proc http::geturl { url args } {
    variable http
+    variable urlTypes

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.
@@ -164,6 +216,7 @@ proc http::geturl { url args } {
 	-validate 	0
 	-headers 	{}
 	-timeout 	0
+	-type           application/x-www-form-urlencoded
 	state		header
 	meta		{}
 	currentsize	0
@@ -173,18 +226,16 @@ proc http::geturl { url args } {
 	status		""
    }
    set options {-blocksize -channel -command -handler -headers \
-		-progress -query -validate -timeout}
+		-progress -query -validate -timeout -type}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
 	if {[regexp $pat $flag]} {
-
 	    # Validate numbers
-
 	    if {[info exists state($flag)] && \
-		    [regexp {^[0-9]+$} $state($flag)] && \
-		    ![regexp {^[0-9]+$} $value]} {
+		    [string is integer -strict $state($flag)] && \
+		    ![string is integer -strict $value]} {
 		return -code error "Bad value for $flag ($value), must be integer"
 	    }
 	    set state($flag) $value
@@ -192,12 +243,22 @@ proc http::geturl { url args } {
 	    return -code error "Unknown option $flag, can be: $usage"
 	}
    }
-    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
-	    x proto host y port srvurl]} {
+    if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
+	    x prefix proto host y port srvurl]} {
 	error "Unsupported URL: $url"
    }
+    if {[string length $proto] == 0} {
+	set proto http
+	set url ${proto}://$url
+    }
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set defport [lindex $urlTypes($proto) 0]
+    set defcmd [lindex $urlTypes($proto) 1]
+
    if {[string length $port] == 0} {
-	set port 80
+	set port $defport
    }
    if {[string length $srvurl] == 0} {
 	set srvurl /
@@ -227,23 +288,22 @@ proc http::geturl { url args } {

    if {[info exists phost] && [string length $phost]} {
 	set srvurl $url
-	set s [eval socket $async {$phost $pport}]
+	set s [eval $defcmd $async {$phost $pport}]
    } else {
-	set s [eval socket $async {$host $port}]
+	set s [eval $defcmd $async {$host $port}]
    }
    set state(sock) $s

    # Wait for the connection to complete

    if {$state(-timeout) > 0} {
-	#fileevent $s writable [list set $token\(status) connect]
 	fileevent $s writable [list http::Connect $token]
 	http::wait $token
-	if {[string compare $state(status) "timeout"] == 0} {
-	    return
+	if {![string equal $state(status) "connect"]} {
+	    return $token
 	}
 	fileevent $s writable {}
-	unset state(status)
+	set state(status) ""
    }

    # Send data in cr-lf format, but accept any line terminators
@@ -264,28 +324,37 @@ proc http::geturl { url args } {
    } elseif {$state(-validate)} {
 	set how HEAD
    }
-    puts $s "$how $srvurl HTTP/1.0"
-    puts $s "Accept: $http(-accept)"
-    puts $s "Host: $host"
-    puts $s "User-Agent: $http(-useragent)"
-    foreach {key value} $state(-headers) {
-	regsub -all \[\n\r\]  $value {} value
-	set key [string trim $key]
-	if {[string length $key]} {
-	    puts $s "$key: $value"
+    if {[catch {
+	puts $s "$how $srvurl HTTP/1.0"
+	puts $s "Accept: $http(-accept)"
+	puts $s "Host: $host"
+	puts $s "User-Agent: $http(-useragent)"
+	foreach {key value} $state(-headers) {
+	    regsub -all \[\n\r\]  $value {} value
+	    set key [string trim $key]
+	    if {[string length $key]} {
+		puts $s "$key: $value"
+	    }
 	}
+	if {$len > 0} {
+	    puts $s "Content-Length: $len"
+	    puts $s "Content-Type: $state(-type)"
+	    puts $s ""
+	    fconfigure $s -translation {auto binary}
+	    puts $s $state(-query)
+	} else {
+	    puts $s ""
+	}
+	flush $s
+	fileevent $s readable [list http::Event $token]
+    } err]} {
+	# The socket probably was never connected, or the connection
+	# dropped later.
+
+	reset $token ioerror
+	return $token
    }
-    if {$len > 0} {
-	puts $s "Content-Length: $len"
-	puts $s "Content-Type: application/x-www-form-urlencoded"
-	puts $s ""
-	fconfigure $s -translation {auto binary}
-	puts $s $state(-query)
-    } else {
-	puts $s ""
-    }
-    flush $s
-    fileevent $s readable [list http::Event $token]
+
    if {! [info exists state(-command)]} {
 	wait $token
    }
@@ -336,12 +405,38 @@ proc http::cleanup {token} {
 	unset state
    }
 }
+
+# http::Connect
+#
+#	Wait for an asynchronous connection to complete
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Sets the status of the connection, which unblocks
+# 	the waiting geturl call
+
 proc http::Connect {token} {
    variable $token
    upvar 0 $token state
-    set state(status) connect
+    if {[eof $state(sock)]} {
+	set state(status) ioerror
+    } else {
+	set state(status) connect
+    }
 }

+# http::Event
+#
+#	Handle input on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Read the socket and handle callbacks.
+
 proc http::Event {token} {
    variable $token
    upvar 0 $token state
@@ -351,8 +446,10 @@ proc http::cleanup {token} {
 	Eof $token
 	return
    }
-    if {$state(state) == "header"} {
-	set n [gets $s line]
+    if {[string equal $state(state) "header"]} {
+	if {[catch {gets $s line} n]} {
+	    Finish $token $err
+	}
 	if {$n == 0} {
 	    set state(state) body
 	    if {![regexp -nocase ^text $state(type)]} {
@@ -404,6 +501,18 @@ proc http::cleanup {token} {
 	}
    }
 }
+
+# http::CopyStart
+#
+#	Error handling wrapper around fcopy
+#
+# Arguments
+#	s	The socket to copy from
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	This closes the connection upon error
+
 proc http::CopyStart {s token} {
    variable $token
    upvar 0 $token state
@@ -414,6 +523,18 @@ proc http::cleanup {token} {
 	Finish $token $err
    }
 }
+
+# http::CopyDone
+#
+#	fcopy completion callback
+#
+# Arguments
+#	token	The token returned from http::geturl
+#	count	The amount transfered
+#
+# Side Effects
+#	Invokes callbacks
+
 proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state
@@ -423,7 +544,7 @@ proc http::cleanup {token} {
 	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    # At this point the token may have been reset
-    if {([string length $error] != 0)} {
+    if {[string length $error]} {
 	Finish $token $error
    } elseif {[catch {::eof $s} iseof] || $iseof} {
 	Eof $token
@@ -431,10 +552,21 @@ proc http::cleanup {token} {
 	CopyStart $s $token
    }
 }
+
+# http::Eof
+#
+#	Handle eof on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Clean up the socket
+
 proc http::Eof {token} {
    variable $token
    upvar 0 $token state
-    if {$state(state) == "header"} {
+    if {[string equal $state(state) "header"]} {
 	# Premature eof
 	set state(status) eof
    } else {
@@ -458,9 +590,7 @@ proc http::wait {token} {
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
-
 	# We must wait on the original variable name, not the upvar alias
-
 	vwait $token\(status)
    }
    if {[info exists state(error)]} {
@@ -487,8 +617,8 @@ proc http::formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
-	append result  $sep [mapReply $i]
-	if {$sep != "="} {
+	append result $sep [mapReply $i]
+	if {[string compare $sep "="]} {
 	    set sep =
 	} else {
 	    set sep &
@@ -497,15 +627,25 @@ proc http::formatQuery {args} {
    return $result
 }

-# do x-www-urlencoded character mapping
-# The spec says: "non-alphanumeric characters are replaced by '%HH'"
-# 1 leave alphanumerics characters alone
-# 2 Convert every other character to an array lookup
-# 3 Escape constructs that are "special" to the tcl parser
-# 4 "subst" the result, doing all the array substitutions
- 
+# http::mapReply --
+#
+#	Do x-www-urlencoded character mapping
+#
+# Arguments:
+#	string	The string the needs to be encoded
+#
+# Results:
+#       The encoded string
+
 proc http::mapReply {string} {
    variable formMap
+
+    # The spec says: "non-alphanumeric characters are replaced by '%HH'"
+    # 1 leave alphanumerics characters alone
+    # 2 Convert every other character to an array lookup
+    # 3 Escape constructs that are "special" to the tcl parser
+    # 4 "subst" the result, doing all the array substitutions
+
    set alphanumeric	a-zA-Z0-9
    regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
    regsub -all \n $string {\\n} string
@@ -514,7 +654,15 @@ proc http::formatQuery {args} {
    return [subst $string]
 }

-# Default proxy filter. 
+# http::ProxyRequired --
+#	Default proxy filter. 
+#
+# Arguments:
+#	host	The destination host
+#
+# Results:
+#       The current proxy settings
+
 proc http::ProxyRequired {host} {
    variable http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
@@ -8,4 +8,4 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.

-package ifneeded http 2.1 [list tclPkgSetup $dir http 2.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait}}}]
+package ifneeded http 2.2 [list tclPkgSetup $dir http 2.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
@@ -9,24 +9,23 @@
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.9 1999/08/05 16:57:48 hobbs Exp $
+# RCS: @(#) $Id: http.tcl,v 1.9.4.3 1999/11/19 23:32:24 hobbs Exp $

-package provide http 2.1	;# This uses Tcl namespaces
+package provide http 2.2	;# This uses Tcl namespaces

 namespace eval http {
    variable http
-
    array set http {
 	-accept */*
 	-proxyhost {}
 	-proxyport {}
-	-useragent {Tcl http client package 2.1}
+	-useragent {Tcl http client package 2.2}
 	-proxyfilter http::ProxyRequired
    }

    variable formMap
-    set alphanumeric	a-zA-Z0-9
-
+    variable alphanumeric a-zA-Z0-9
+    variable c
    variable i 0
    for {} {$i <= 256} {incr i} {
 	set c [format %c $i]
@@ -39,10 +38,50 @@ namespace eval http {
 	" " +   \n %0d%0a
    }

-    namespace export geturl config reset wait formatQuery 
+    variable urlTypes
+    array set urlTypes {
+	http	{80 ::socket}
+    }
+
+    namespace export geturl config reset wait formatQuery register unregister
    # Useful, but not exported: data size status code
 }

+# http::register --
+#
+#     See documentaion for details.
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+#     port            Default port for protocol
+#     command         Command to use to create socket
+# Results:
+#     list of port and command that was registered.
+
+proc http::register {proto port command} {
+    variable urlTypes
+    set urlTypes($proto) [list $port $command]
+}
+
+# http::unregister --
+#
+#     Unregisters URL protocol handler
+#
+# Arguments:
+#     proto           URL protocol prefix, e.g. https
+# Results:
+#     list of port and command that was unregistered.
+
+proc http::unregister {proto} {
+    variable urlTypes
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set old $urlTypes($proto)
+    unset urlTypes($proto)
+    return $old
+}
+
 # http::config --
 #
 #	See documentaion for details.
@@ -83,6 +122,17 @@ proc http::config {args} {
    }
 }

+# http::Finish --
+#
+#	Clean up the socket and eval close time callbacks
+#
+# Arguments:
+#	token	Connection token.
+#	errormsg	If set, forces status to error.
+#
+# Side Effects:
+#        Closes the socket
+
 proc http::Finish { token {errormsg ""} } {
    variable $token
    upvar 0 $token state
@@ -114,8 +164,9 @@ proc http::config {args} {
 # Arguments:
 #	token	Connection token.
 #	why	Status info.
-# Results:
-#        TODO
+#
+# Side Effects:
+#       See Finish

 proc http::reset { token {why reset} } {
    variable $token
@@ -145,6 +196,7 @@ proc http::reset { token {why reset} } {

 proc http::geturl { url args } {
    variable http
+    variable urlTypes

    # Initialize the state variable, an array.  We'll return the
    # name of this array as the token for the transaction.
@@ -164,6 +216,7 @@ proc http::geturl { url args } {
 	-validate 	0
 	-headers 	{}
 	-timeout 	0
+	-type           application/x-www-form-urlencoded
 	state		header
 	meta		{}
 	currentsize	0
@@ -173,18 +226,16 @@ proc http::geturl { url args } {
 	status		""
    }
    set options {-blocksize -channel -command -handler -headers \
-		-progress -query -validate -timeout}
+		-progress -query -validate -timeout -type}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
 	if {[regexp $pat $flag]} {
-
 	    # Validate numbers
-
 	    if {[info exists state($flag)] && \
-		    [regexp {^[0-9]+$} $state($flag)] && \
-		    ![regexp {^[0-9]+$} $value]} {
+		    [string is integer -strict $state($flag)] && \
+		    ![string is integer -strict $value]} {
 		return -code error "Bad value for $flag ($value), must be integer"
 	    }
 	    set state($flag) $value
@@ -192,12 +243,22 @@ proc http::geturl { url args } {
 	    return -code error "Unknown option $flag, can be: $usage"
 	}
    }
-    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
-	    x proto host y port srvurl]} {
+    if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
+	    x prefix proto host y port srvurl]} {
 	error "Unsupported URL: $url"
    }
+    if {[string length $proto] == 0} {
+	set proto http
+	set url ${proto}://$url
+    }
+    if {![info exists urlTypes($proto)]} {
+	return -code error "unsupported url type \"$proto\""
+    }
+    set defport [lindex $urlTypes($proto) 0]
+    set defcmd [lindex $urlTypes($proto) 1]
+
    if {[string length $port] == 0} {
-	set port 80
+	set port $defport
    }
    if {[string length $srvurl] == 0} {
 	set srvurl /
@@ -227,23 +288,22 @@ proc http::geturl { url args } {

    if {[info exists phost] && [string length $phost]} {
 	set srvurl $url
-	set s [eval socket $async {$phost $pport}]
+	set s [eval $defcmd $async {$phost $pport}]
    } else {
-	set s [eval socket $async {$host $port}]
+	set s [eval $defcmd $async {$host $port}]
    }
    set state(sock) $s

    # Wait for the connection to complete

    if {$state(-timeout) > 0} {
-	#fileevent $s writable [list set $token\(status) connect]
 	fileevent $s writable [list http::Connect $token]
 	http::wait $token
-	if {[string compare $state(status) "timeout"] == 0} {
-	    return
+	if {![string equal $state(status) "connect"]} {
+	    return $token
 	}
 	fileevent $s writable {}
-	unset state(status)
+	set state(status) ""
    }

    # Send data in cr-lf format, but accept any line terminators
@@ -264,28 +324,37 @@ proc http::geturl { url args } {
    } elseif {$state(-validate)} {
 	set how HEAD
    }
-    puts $s "$how $srvurl HTTP/1.0"
-    puts $s "Accept: $http(-accept)"
-    puts $s "Host: $host"
-    puts $s "User-Agent: $http(-useragent)"
-    foreach {key value} $state(-headers) {
-	regsub -all \[\n\r\]  $value {} value
-	set key [string trim $key]
-	if {[string length $key]} {
-	    puts $s "$key: $value"
+    if {[catch {
+	puts $s "$how $srvurl HTTP/1.0"
+	puts $s "Accept: $http(-accept)"
+	puts $s "Host: $host"
+	puts $s "User-Agent: $http(-useragent)"
+	foreach {key value} $state(-headers) {
+	    regsub -all \[\n\r\]  $value {} value
+	    set key [string trim $key]
+	    if {[string length $key]} {
+		puts $s "$key: $value"
+	    }
 	}
+	if {$len > 0} {
+	    puts $s "Content-Length: $len"
+	    puts $s "Content-Type: $state(-type)"
+	    puts $s ""
+	    fconfigure $s -translation {auto binary}
+	    puts $s $state(-query)
+	} else {
+	    puts $s ""
+	}
+	flush $s
+	fileevent $s readable [list http::Event $token]
+    } err]} {
+	# The socket probably was never connected, or the connection
+	# dropped later.
+
+	reset $token ioerror
+	return $token
    }
-    if {$len > 0} {
-	puts $s "Content-Length: $len"
-	puts $s "Content-Type: application/x-www-form-urlencoded"
-	puts $s ""
-	fconfigure $s -translation {auto binary}
-	puts $s $state(-query)
-    } else {
-	puts $s ""
-    }
-    flush $s
-    fileevent $s readable [list http::Event $token]
+
    if {! [info exists state(-command)]} {
 	wait $token
    }
@@ -336,12 +405,38 @@ proc http::cleanup {token} {
 	unset state
    }
 }
+
+# http::Connect
+#
+#	Wait for an asynchronous connection to complete
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Sets the status of the connection, which unblocks
+# 	the waiting geturl call
+
 proc http::Connect {token} {
    variable $token
    upvar 0 $token state
-    set state(status) connect
+    if {[eof $state(sock)]} {
+	set state(status) ioerror
+    } else {
+	set state(status) connect
+    }
 }

+# http::Event
+#
+#	Handle input on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Read the socket and handle callbacks.
+
 proc http::Event {token} {
    variable $token
    upvar 0 $token state
@@ -351,8 +446,10 @@ proc http::cleanup {token} {
 	Eof $token
 	return
    }
-    if {$state(state) == "header"} {
-	set n [gets $s line]
+    if {[string equal $state(state) "header"]} {
+	if {[catch {gets $s line} n]} {
+	    Finish $token $err
+	}
 	if {$n == 0} {
 	    set state(state) body
 	    if {![regexp -nocase ^text $state(type)]} {
@@ -404,6 +501,18 @@ proc http::cleanup {token} {
 	}
    }
 }
+
+# http::CopyStart
+#
+#	Error handling wrapper around fcopy
+#
+# Arguments
+#	s	The socket to copy from
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	This closes the connection upon error
+
 proc http::CopyStart {s token} {
    variable $token
    upvar 0 $token state
@@ -414,6 +523,18 @@ proc http::cleanup {token} {
 	Finish $token $err
    }
 }
+
+# http::CopyDone
+#
+#	fcopy completion callback
+#
+# Arguments
+#	token	The token returned from http::geturl
+#	count	The amount transfered
+#
+# Side Effects
+#	Invokes callbacks
+
 proc http::CopyDone {token count {error {}}} {
    variable $token
    upvar 0 $token state
@@ -423,7 +544,7 @@ proc http::cleanup {token} {
 	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    # At this point the token may have been reset
-    if {([string length $error] != 0)} {
+    if {[string length $error]} {
 	Finish $token $error
    } elseif {[catch {::eof $s} iseof] || $iseof} {
 	Eof $token
@@ -431,10 +552,21 @@ proc http::cleanup {token} {
 	CopyStart $s $token
    }
 }
+
+# http::Eof
+#
+#	Handle eof on the socket
+#
+# Arguments
+#	token	The token returned from http::geturl
+#
+# Side Effects
+#	Clean up the socket
+
 proc http::Eof {token} {
    variable $token
    upvar 0 $token state
-    if {$state(state) == "header"} {
+    if {[string equal $state(state) "header"]} {
 	# Premature eof
 	set state(status) eof
    } else {
@@ -458,9 +590,7 @@ proc http::wait {token} {
    upvar 0 $token state

    if {![info exists state(status)] || [string length $state(status)] == 0} {
-
 	# We must wait on the original variable name, not the upvar alias
-
 	vwait $token\(status)
    }
    if {[info exists state(error)]} {
@@ -487,8 +617,8 @@ proc http::formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
-	append result  $sep [mapReply $i]
-	if {$sep != "="} {
+	append result $sep [mapReply $i]
+	if {[string compare $sep "="]} {
 	    set sep =
 	} else {
 	    set sep &
@@ -497,15 +627,25 @@ proc http::formatQuery {args} {
    return $result
 }

-# do x-www-urlencoded character mapping
-# The spec says: "non-alphanumeric characters are replaced by '%HH'"
-# 1 leave alphanumerics characters alone
-# 2 Convert every other character to an array lookup
-# 3 Escape constructs that are "special" to the tcl parser
-# 4 "subst" the result, doing all the array substitutions
- 
+# http::mapReply --
+#
+#	Do x-www-urlencoded character mapping
+#
+# Arguments:
+#	string	The string the needs to be encoded
+#
+# Results:
+#       The encoded string
+
 proc http::mapReply {string} {
    variable formMap
+
+    # The spec says: "non-alphanumeric characters are replaced by '%HH'"
+    # 1 leave alphanumerics characters alone
+    # 2 Convert every other character to an array lookup
+    # 3 Escape constructs that are "special" to the tcl parser
+    # 4 "subst" the result, doing all the array substitutions
+
    set alphanumeric	a-zA-Z0-9
    regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
    regsub -all \n $string {\\n} string
@@ -514,7 +654,15 @@ proc http::formatQuery {args} {
    return [subst $string]
 }

-# Default proxy filter. 
+# http::ProxyRequired --
+#	Default proxy filter. 
+#
+# Arguments:
+#	host	The destination host
+#
+# Results:
+#       The current proxy settings
+
 proc http::ProxyRequired {host} {
    variable http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
@@ -8,4 +8,4 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.

-package ifneeded http 2.1 [list tclPkgSetup $dir http 2.1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait}}}]
+package ifneeded http 2.2 [list tclPkgSetup $dir http 2.2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}]
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.32 1999/08/09 16:30:50 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.32.4.1 1999/10/30 11:06:17 hobbs Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -52,12 +52,10 @@ if {[string compare [info library] {}]} {
 	}
    }
 }
-foreach __dir [list [file dirname [info nameofexecutable]] \
-	[file join [file dirname [file dirname \
-	[info nameofexecutable]]] lib]] {
-    if {[lsearch -exact $auto_path $__dir] < 0} {
-	lappend auto_path $__dir
-    }
+set __dir [file join [file dirname \
+	[file dirname [info nameofexecutable]]] lib]
+if {[lsearch -exact $auto_path $__dir] < 0} {
+    lappend auto_path $__dir
 }
 if {[info exist tcl_pkgPath]} {
    foreach __dir $tcl_pkgPath {
@@ -1 +1,7 @@
-package ifneeded registry 1.0 "load [list [file join $dir tclreg82.dll]] registry"
+if {[info exists tcl_platform(debug)]} {
+    package ifneeded registry 1.0 \
+	    [list load [file join $dir tclreg82d.dll] registry]
+} else {
+    package ifneeded registry 1.0 \
+	    [list load [file join $dir tclreg82.dll] registry]
+}
@@ -1 +1,7 @@
-package ifneeded registry 1.0 "load [list [file join $dir tclreg82.dll]] registry"
+if {[info exists tcl_platform(debug)]} {
+    package ifneeded registry 1.0 \
+	    [list load [file join $dir tclreg82d.dll] registry]
+} else {
+    package ifneeded registry 1.0 \
+	    [list load [file join $dir tclreg82.dll] registry]
+}
@@ -10,9 +10,9 @@

 package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \
 	{{tcltest.tcl source {::tcltest::bytestring ::tcltest::cleanupTests \
-	::tcltest::dotests ::tcltest::makeDirectory ::tcltest::makeFile \
-	::tcltest::normalizeMsg ::tcltest::removeDirectory \
-	::tcltest::removeFile ::tcltest::restoreState ::tcltest::saveState \
-	::tcltest::test ::tcltest::threadReap ::tcltest::viewFile memory \
-	::tcltest:grep ::tcltest::getMatchingTestFiles }}}]
+	::tcltest::makeDirectory ::tcltest::makeFile ::tcltest::normalizeMsg \
+	::tcltest::removeDirectory ::tcltest::removeFile \
+	::tcltest::restoreState ::tcltest::saveState ::tcltest::test \
+	::tcltest::threadReap ::tcltest::viewFile \ 
+	::tcltest::grep ::tcltest::getMatchingFiles }}}]

@@ -12,7 +12,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.9 1999/07/30 01:35:27 jenn Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.9.4.4 1999/10/30 11:07:05 hobbs Exp $

 package provide tcltest 1.0

@@ -26,43 +26,62 @@ namespace eval tcltest {
    # Export the public tcltest procs
    set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingTestFiles]
+	    viewFile bytestring safeFetch threadReap getMatchingFiles]
    foreach proc $procList {
 	namespace export $proc
    }

    # ::tcltest::verbose defaults to "b"
-
-    variable verbose "b"
+    if {![info exists verbose]} {
+	variable verbose "b"
+    }

    # Match and skip patterns default to the empty list, except for
    # matchFiles, which defaults to all .test files in the testsDirectory

-    variable match {}
-    variable skip {}
-
-    variable matchFiles {*.test}
-    variable skipFiles {}
+    if {![info exists match]} {
+	variable match {}
+    }
+    if {![info exists skip]} {
+	variable skip {}
+    }
+    if {![info exists matchFiles]} {
+	variable matchFiles {*.test}
+    }
+    if {![info exists skipFiles]} {
+	variable skipFiles {}
+    }

    # By default, don't save core files
-    variable preserveCore 0
+    if {![info exists preserveCore]} {
+	variable preserveCore 0
+    }

    # output goes to stdout by default
-
-    variable outputChannel stdout
+    if {![info exists outputChannel]} {
+	variable outputChannel stdout
+    }

    # errors go to stderr by default
-
-    variable errorChannel stderr
+    if {![info exists errorChannel]} {
+	variable errorChannel stderr
+    }

    # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tets that were skipped because they didn't match or were 
+    # up only the tests that were skipped because they didn't match or were 
    # specifically skipped.  A debug level of 2 would spit up the tcltest
    # variables and flags provided; a debug level of 3 causes some additional
    # output regarding operations of the test harness.  The tcltest package
    # currently implements only up to debug level 3.
+    if {![info exists debug]} {
+	variable debug 0
+    }

-    variable debug 0
+    # Save any arguments that we might want to pass through to other programs. 
+    # This is used by the -args flag.
+    if {![info exists parameters]} {
+	variable parameters {}
+    }

    # Count the number of files tested (0 if all.tcl wasn't called).
    # The all.tcl file will set testSingleFile to false, so stats will
@@ -71,10 +90,18 @@ namespace eval tcltest {
    # current test file has had any failures.  The failFiles list
    # stores the names of test files that had failures.

-    variable numTestFiles 0
-    variable testSingleFile true
-    variable currentFailure false
-    variable failFiles {}
+    if {![info exists numTestFiles]} {
+	variable numTestFiles 0
+    }
+    if {![info exists testSingleFile]} {
+	variable testSingleFile true
+    }
+    if {![info exists currentFailure]} {
+	variable currentFailure false
+    }
+    if {![info exists failFiles]} {
+	variable failFiles {}
+    }

    # Tests should remove all files they create.  The test suite will
    # check the current working dir for files created by the tests.
@@ -82,18 +109,29 @@ namespace eval tcltest {
    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
    # ::tcltest::filesExisted stores the names of pre-existing files.

-    variable filesMade {}
-    variable filesExisted {}
+    if {![info exists filesMade]} {
+	variable filesMade {}
+    }
+    if {![info exists filesExisted]} {
+	variable filesExisted {}
+    }

    # ::tcltest::numTests will store test files as indices and the list
    # of files (that should not have been) left behind by the test files.

-    array set ::tcltest::createdNewFiles {}
+    if {![info exists createdNewFiles]} {
+	variable createdNewFiles
+	array set ::tcltest::createdNewFiles {}
+    }

    # initialize ::tcltest::numTests array to keep track fo the number of
-    # tests that pass, fial, and are skipped.
+    # tests that pass, fail, and are skipped.

-    array set ::tcltest::numTests [list Total 0 Passed 0 Skipped 0 Failed 0] 
+    if {![info exists numTests]} {
+	variable numTests
+	array set ::tcltest::numTests \
+		[list Total 0 Passed 0 Skipped 0 Failed	0] 
+    }

    # initialize ::tcltest::skippedBecause array to keep track of
    # constraints that kept tests from running; a constraint name of
@@ -103,49 +141,70 @@ namespace eval tcltest {
    # both of these constraints are counted only if ::tcltest::debug is set to
    # true. 

-    array set ::tcltest::skippedBecause {}
+    if {![info exists skippedBecause]} {
+	variable skippedBecause
+	array set ::tcltest::skippedBecause {}
+    }

    # initialize the ::tcltest::testConstraints array to keep track of valid
    # predefined constraints (see the explanation for the
    # ::tcltest::initConstraints proc for more details).

-    array set ::tcltest::testConstraints {}
+    if {![info exists testConstraints]} {
+	variable testConstraints
+	array set ::tcltest::testConstraints {}
+    }

    # Don't run only the constrained tests by default
-    variable limitConstraints false
+    if {![info exists limitConstraints]} {
+	variable limitConstraints false
+    }

-    # tests that use thread need to know which is the main thread
+    # tests that use threads need to know which is the main thread

-    variable mainThread 1
-    if {[info commands testthread] != {}} {
-	set mainThread [testthread names]
+    if {![info exists mainThread]} {
+	variable mainThread 1
+	if {[info commands testthread] != {}} {
+	    set mainThread [testthread names]
+	}
    }

    # save the original environment so that it can be restored later
    
-    array set ::tcltest::originalEnv [array get ::env]
+    if {![info exists originalEnv]} {
+	variable originalEnv
+	array set ::tcltest::originalEnv [array get ::env]
+    }

    # Set ::tcltest::workingDirectory to [pwd]. The default output directory
    # for Tcl tests is the working directory.

-    variable workingDirectory [pwd]
-    variable temporaryDirectory $workingDirectory
+    if {![info exists workingDirectory]} {
+	variable workingDirectory [pwd]
+    }
+    if {![info exists temporaryDirectory]} {
+	variable temporaryDirectory $workingDirectory
+    }

    # Tests should not rely on the current working directory.
    # Files that are part of the test suite should be accessed relative to 
    # ::tcltest::testsDirectory.

-    set oDir [pwd]
-    catch {cd [file join [file dirname [info script]] .. .. tests]}
-    variable testsDirectory [pwd]
-    cd $oDir
+    if {![info exists testsDirectory]} {
+	set oDir [pwd]
+	catch {cd [file join [file dirname [info script]] .. .. tests]}
+	variable testsDirectory [pwd]
+	cd $oDir
+    }

    # the variables and procs that existed when ::tcltest::saveState was
    # called are stored in a variable of the same name
-    variable saveState {}
+    if {![info exists saveState]} {
+	variable saveState {}
+    }

    # Internationalization support
-    if {![info exists ::tcltest::isoLocale]} {
+    if {![info exists isoLocale]} {
 	variable isoLocale fr
        switch $tcl_platform(platform) {
 	    "unix" {
@@ -180,18 +239,22 @@ namespace eval tcltest {
    }

    # Set the location of the execuatble
-    variable tcltest [info nameofexecutable]
-
-    # save the platform information so it can be restored later
-    variable originalTclPlatform [array get tcl_platform]
-
-
-    # If a core file exists, save its modification time.
-    if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	variable coreModificationTime [file mtime [file join \
-		$::tcltest::workingDirectory core]]
+    if {![info exists tcltest]} {
+	variable tcltest [info nameofexecutable]
    }

+    # save the platform information so it can be restored later
+    if {![info exists originalTclPlatform]} {
+	variable originalTclPlatform [array get tcl_platform]
+    }
+
+    # If a core file exists, save its modification time.
+    if {![info exists coreModificationTime]} {
+	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	    variable coreModificationTime [file mtime [file join \
+		    $::tcltest::workingDirectory core]]
+	}
+    }
 }   

 # ::tcltest::AddToSkippedBecause --
@@ -207,7 +270,7 @@ namespace eval tcltest {
 #       previously exist - otherwise, it just increments it.

 proc ::tcltest::AddToSkippedBecause { constraint } {
-    # add the constraint to the list of constraints the kept tests
+    # add the constraint to the list of constraints that kept tests
    # from running

    if {[info exists ::tcltest::skippedBecause($constraint)]} {
@@ -270,7 +333,9 @@ proc ::tcltest::PrintError {errorMsg} {
    return
 }

-proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
+    proc ::tcltest::initConstraintsHook {} {}
+}

 # ::tcltest::initConstraints --
 #
@@ -291,8 +356,6 @@ proc ::tcltest::initConstraintsHook {} {}
 proc ::tcltest::initConstraints {} {
    global tcl_platform tcl_interactive tk_version

-    catch {unset ::tcltest::testConstraints}
-
    # The following trace procedure makes it so that we can safely refer to
    # non-existent members of the ::tcltest::testConstraints array without
    # causing an error.  Instead, reading a non-existent member will return 0.
@@ -339,9 +402,10 @@ proc ::tcltest::initConstraints {} {
    set ::tcltest::testConstraints(win32s) [string equal $tcl_platform(os) \
 	    "Win32s"]

-    # The following Constraints switches are used to mark tests that should work,
-    # but have been temporarily disabled on certain platforms because they don't
-    # and we haven't gotten around to fixing the underlying problem.
+    # The following Constraints switches are used to mark tests that should
+    # work, but have been temporarily disabled on certain platforms because
+    # they don't and we haven't gotten around to fixing the underlying
+    # problem. 

    set ::tcltest::testConstraints(tempNotPc) \
 	    [expr {!$::tcltest::testConstraints(pc)}]
@@ -381,7 +445,11 @@ proc ::tcltest::initConstraints {} {

    # Some tests must be skipped if the interpreter is not in interactive mode

-    set ::tcltest::testConstraints(interactive) $tcl_interactive
+    if {[info exists tcl_interactive]} {
+	set ::tcltest::testConstraints(interactive) $::tcl_interactive
+    } else {
+	set ::tcltest::testConstraints(interactive) 0
+    }

    # Some tests can only be run if the installation came from a CD image
    # instead of a web image
@@ -437,7 +505,7 @@ proc ::tcltest::initConstraints {} {
    # to the "e" format of floating-point numbers.

    set ::tcltest::testConstraints(eformat) 1
-    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+    if {![string equal "[format %g 5e-5]" "5e-05"]} {
 	set ::tcltest::testConstraints(eformat) 0
    }

@@ -550,7 +618,9 @@ proc ::tcltest::initConstraints {} {
 #       Hook used for customization of display of usage information.
 #

-proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
+    proc ::tcltest::PrintUsageInfoHook {} {}
+}

 # ::tcltest::PrintUsageInfo
 #
@@ -612,7 +682,9 @@ proc ::tcltest::PrintUsageInfo {} {
 #       processed by ::tcltest::processCmdLineArgs. 
 #

-proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+}

 # ::tcltest::processCmdLineArgsHook --
 #
@@ -623,7 +695,9 @@ proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
 #	flags      The flags that have been pulled out of argv
 #

-proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsHook {flag} {}
+}

 # ::tcltest::processCmdLineArgs --
 #
@@ -672,7 +746,7 @@ proc ::tcltest::processCmdLineArgs {} {
    # -help is not listed since it has already been processed
    lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints
+	    -preservecore -limitconstraints -args
    set defaultFlags [concat $defaultFlags \
 	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]

@@ -685,6 +759,11 @@ proc ::tcltest::processCmdLineArgs {} {
 	}
    }

+    # Set ::tcltest::parameters to the arg of the -args flag, if given
+    if {[info exists flag(-args)]} {
+	set ::tcltest::parameters $flag(-args)
+    }
+
    # Set ::tcltest::verbose to the arg of the -verbose flag, if given

    if {[info exists flag(-verbose)]} {
@@ -751,9 +830,9 @@ proc ::tcltest::processCmdLineArgs {} {
    if {[info exists flag(-tmpdir)]} {
 	set ::tcltest::temporaryDirectory $flag(-tmpdir)

-	if {[string compare \
+	if {![string equal \
 		[file pathtype $::tcltest::temporaryDirectory] \
-		"absolute"] != 0} { 
+		"absolute"]} { 
 	    set ::tcltest::temporaryDirectory [file join [pwd] \
 		    $::tcltest::temporaryDirectory] 
 	}
@@ -793,7 +872,7 @@ proc ::tcltest::processCmdLineArgs {} {

    if {[info exists flag(-outfile)]} {
 	set tmp $flag(-outfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::outputChannel [open $tmp w]
@@ -801,7 +880,7 @@ proc ::tcltest::processCmdLineArgs {} {

    if {[info exists flag(-errfile)]} {
 	set tmp $flag(-errfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::errorChannel [open $tmp w]
@@ -947,7 +1026,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 	# exit only if running Tk in non-interactive mode

 	global tk_version tcl_interactive
-	if {[info exists tk_version] && !$tcl_interactive} {
+	if {[info exists tk_version] && ![info exists tcl_interactive]} {
 	    exit
 	}
    } else {
@@ -1050,7 +1129,9 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 #       additional things that should be done at cleanup.
 #

-proc ::tcltest::cleanupTestsHook {} {}
+if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
+    proc ::tcltest::cleanupTestsHook {} {}
+}

 # test --
 #
@@ -1135,16 +1216,14 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
-
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
 	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
+ 	    regsub -all {[.\w]+} $constraints \
 		    {$::tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
-
 	    set doTest 1
 	    foreach constraint $constraints {
 		if {(![info exists ::tcltest::testConstraints($constraint)]) \
@@ -1191,7 +1270,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
    }

    set code [catch {uplevel $script} actualAnswer]
-    if {([string compare $actualAnswer $expectedAnswer] == 0) && ($code == 0)} {
+    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
 	incr ::tcltest::numTests(Passed)
 	if {[string first p $::tcltest::verbose] != -1} {
 	    puts $::tcltest::outputChannel "++++ $name PASSED"
@@ -1261,7 +1340,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
    }
 }

-# ::tcltest::getMatchingTestFiles
+# ::tcltest::getMatchingFiles
 #
 #       Looks at the patterns given to match and skip files
 #       and uses them to put together a list of the tests that will be run.
@@ -1379,7 +1458,7 @@ proc ::tcltest::restoreState {} {
 	    if {$::tcltest::debug > 2} {
 		puts "::tcltest::restoreState: Removing variable $p"
 	    }
-	    uplevel #0 "unset $p"
+	    uplevel #0 "catch {unset $p}"
 	}
    }
 }
@@ -1508,7 +1587,7 @@ proc ::tcltest::viewFile {name} {
 # Example:
 #   grep {regexp a} $someList   
 #
-proc ::tcltest:grep { expression searchList } {
+proc ::tcltest::grep { expression searchList } {
    foreach element $searchList {
 	if {[regsub -all CURRENT_ELEMENT $expression $element \
 		newExpression] == 0} { 
@@ -1577,9 +1656,12 @@ proc ::tcltest::threadReap {} {
 	    foreach tid [testthread names] {
 		if {$tid != $::tcltest::mainThread} {
 		    catch {testthread send -async $tid {testthread exit}}
-		    update
 		}
 	    }
+	    ## Enter a bit a sleep to give the threads enough breathing
+	    ## room to kill themselves off, otherwise the end up with a
+	    ## massive queue of repeated events
+	    after 1
 	}
 	testthread errorproc ThreadError
 	return [llength [testthread names]]
@@ -1591,7 +1673,8 @@ proc ::tcltest::threadReap {} {
 # Initialize the constraints and set up command line arguments 
 namespace eval tcltest {
    ::tcltest::initConstraints
-    ::tcltest::processCmdLineArgs
+    if {[namespace children ::tcltest] == {}} {
+	::tcltest::processCmdLineArgs
+    }
 }

-return
@@ -10,9 +10,9 @@

 package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \
 	{{tcltest.tcl source {::tcltest::bytestring ::tcltest::cleanupTests \
-	::tcltest::dotests ::tcltest::makeDirectory ::tcltest::makeFile \
-	::tcltest::normalizeMsg ::tcltest::removeDirectory \
-	::tcltest::removeFile ::tcltest::restoreState ::tcltest::saveState \
-	::tcltest::test ::tcltest::threadReap ::tcltest::viewFile memory \
-	::tcltest:grep ::tcltest::getMatchingTestFiles }}}]
+	::tcltest::makeDirectory ::tcltest::makeFile ::tcltest::normalizeMsg \
+	::tcltest::removeDirectory ::tcltest::removeFile \
+	::tcltest::restoreState ::tcltest::saveState ::tcltest::test \
+	::tcltest::threadReap ::tcltest::viewFile \ 
+	::tcltest::grep ::tcltest::getMatchingFiles }}}]

@@ -12,7 +12,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: tcltest.tcl,v 1.9 1999/07/30 01:35:27 jenn Exp $
+# RCS: @(#) $Id: tcltest.tcl,v 1.9.4.4 1999/10/30 11:07:05 hobbs Exp $

 package provide tcltest 1.0

@@ -26,43 +26,62 @@ namespace eval tcltest {
    # Export the public tcltest procs
    set procList [list test cleanupTests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
-	    viewFile bytestring safeFetch threadReap getMatchingTestFiles]
+	    viewFile bytestring safeFetch threadReap getMatchingFiles]
    foreach proc $procList {
 	namespace export $proc
    }

    # ::tcltest::verbose defaults to "b"
-
-    variable verbose "b"
+    if {![info exists verbose]} {
+	variable verbose "b"
+    }

    # Match and skip patterns default to the empty list, except for
    # matchFiles, which defaults to all .test files in the testsDirectory

-    variable match {}
-    variable skip {}
-
-    variable matchFiles {*.test}
-    variable skipFiles {}
+    if {![info exists match]} {
+	variable match {}
+    }
+    if {![info exists skip]} {
+	variable skip {}
+    }
+    if {![info exists matchFiles]} {
+	variable matchFiles {*.test}
+    }
+    if {![info exists skipFiles]} {
+	variable skipFiles {}
+    }

    # By default, don't save core files
-    variable preserveCore 0
+    if {![info exists preserveCore]} {
+	variable preserveCore 0
+    }

    # output goes to stdout by default
-
-    variable outputChannel stdout
+    if {![info exists outputChannel]} {
+	variable outputChannel stdout
+    }

    # errors go to stderr by default
-
-    variable errorChannel stderr
+    if {![info exists errorChannel]} {
+	variable errorChannel stderr
+    }

    # debug output doesn't get printed by default; debug level 1 spits
-    # up only the tets that were skipped because they didn't match or were 
+    # up only the tests that were skipped because they didn't match or were 
    # specifically skipped.  A debug level of 2 would spit up the tcltest
    # variables and flags provided; a debug level of 3 causes some additional
    # output regarding operations of the test harness.  The tcltest package
    # currently implements only up to debug level 3.
+    if {![info exists debug]} {
+	variable debug 0
+    }

-    variable debug 0
+    # Save any arguments that we might want to pass through to other programs. 
+    # This is used by the -args flag.
+    if {![info exists parameters]} {
+	variable parameters {}
+    }

    # Count the number of files tested (0 if all.tcl wasn't called).
    # The all.tcl file will set testSingleFile to false, so stats will
@@ -71,10 +90,18 @@ namespace eval tcltest {
    # current test file has had any failures.  The failFiles list
    # stores the names of test files that had failures.

-    variable numTestFiles 0
-    variable testSingleFile true
-    variable currentFailure false
-    variable failFiles {}
+    if {![info exists numTestFiles]} {
+	variable numTestFiles 0
+    }
+    if {![info exists testSingleFile]} {
+	variable testSingleFile true
+    }
+    if {![info exists currentFailure]} {
+	variable currentFailure false
+    }
+    if {![info exists failFiles]} {
+	variable failFiles {}
+    }

    # Tests should remove all files they create.  The test suite will
    # check the current working dir for files created by the tests.
@@ -82,18 +109,29 @@ namespace eval tcltest {
    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
    # ::tcltest::filesExisted stores the names of pre-existing files.

-    variable filesMade {}
-    variable filesExisted {}
+    if {![info exists filesMade]} {
+	variable filesMade {}
+    }
+    if {![info exists filesExisted]} {
+	variable filesExisted {}
+    }

    # ::tcltest::numTests will store test files as indices and the list
    # of files (that should not have been) left behind by the test files.

-    array set ::tcltest::createdNewFiles {}
+    if {![info exists createdNewFiles]} {
+	variable createdNewFiles
+	array set ::tcltest::createdNewFiles {}
+    }

    # initialize ::tcltest::numTests array to keep track fo the number of
-    # tests that pass, fial, and are skipped.
+    # tests that pass, fail, and are skipped.

-    array set ::tcltest::numTests [list Total 0 Passed 0 Skipped 0 Failed 0] 
+    if {![info exists numTests]} {
+	variable numTests
+	array set ::tcltest::numTests \
+		[list Total 0 Passed 0 Skipped 0 Failed	0] 
+    }

    # initialize ::tcltest::skippedBecause array to keep track of
    # constraints that kept tests from running; a constraint name of
@@ -103,49 +141,70 @@ namespace eval tcltest {
    # both of these constraints are counted only if ::tcltest::debug is set to
    # true. 

-    array set ::tcltest::skippedBecause {}
+    if {![info exists skippedBecause]} {
+	variable skippedBecause
+	array set ::tcltest::skippedBecause {}
+    }

    # initialize the ::tcltest::testConstraints array to keep track of valid
    # predefined constraints (see the explanation for the
    # ::tcltest::initConstraints proc for more details).

-    array set ::tcltest::testConstraints {}
+    if {![info exists testConstraints]} {
+	variable testConstraints
+	array set ::tcltest::testConstraints {}
+    }

    # Don't run only the constrained tests by default
-    variable limitConstraints false
+    if {![info exists limitConstraints]} {
+	variable limitConstraints false
+    }

-    # tests that use thread need to know which is the main thread
+    # tests that use threads need to know which is the main thread

-    variable mainThread 1
-    if {[info commands testthread] != {}} {
-	set mainThread [testthread names]
+    if {![info exists mainThread]} {
+	variable mainThread 1
+	if {[info commands testthread] != {}} {
+	    set mainThread [testthread names]
+	}
    }

    # save the original environment so that it can be restored later
    
-    array set ::tcltest::originalEnv [array get ::env]
+    if {![info exists originalEnv]} {
+	variable originalEnv
+	array set ::tcltest::originalEnv [array get ::env]
+    }

    # Set ::tcltest::workingDirectory to [pwd]. The default output directory
    # for Tcl tests is the working directory.

-    variable workingDirectory [pwd]
-    variable temporaryDirectory $workingDirectory
+    if {![info exists workingDirectory]} {
+	variable workingDirectory [pwd]
+    }
+    if {![info exists temporaryDirectory]} {
+	variable temporaryDirectory $workingDirectory
+    }

    # Tests should not rely on the current working directory.
    # Files that are part of the test suite should be accessed relative to 
    # ::tcltest::testsDirectory.

-    set oDir [pwd]
-    catch {cd [file join [file dirname [info script]] .. .. tests]}
-    variable testsDirectory [pwd]
-    cd $oDir
+    if {![info exists testsDirectory]} {
+	set oDir [pwd]
+	catch {cd [file join [file dirname [info script]] .. .. tests]}
+	variable testsDirectory [pwd]
+	cd $oDir
+    }

    # the variables and procs that existed when ::tcltest::saveState was
    # called are stored in a variable of the same name
-    variable saveState {}
+    if {![info exists saveState]} {
+	variable saveState {}
+    }

    # Internationalization support
-    if {![info exists ::tcltest::isoLocale]} {
+    if {![info exists isoLocale]} {
 	variable isoLocale fr
        switch $tcl_platform(platform) {
 	    "unix" {
@@ -180,18 +239,22 @@ namespace eval tcltest {
    }

    # Set the location of the execuatble
-    variable tcltest [info nameofexecutable]
-
-    # save the platform information so it can be restored later
-    variable originalTclPlatform [array get tcl_platform]
-
-
-    # If a core file exists, save its modification time.
-    if {[file exists [file join $::tcltest::workingDirectory core]]} {
-	variable coreModificationTime [file mtime [file join \
-		$::tcltest::workingDirectory core]]
+    if {![info exists tcltest]} {
+	variable tcltest [info nameofexecutable]
    }

+    # save the platform information so it can be restored later
+    if {![info exists originalTclPlatform]} {
+	variable originalTclPlatform [array get tcl_platform]
+    }
+
+    # If a core file exists, save its modification time.
+    if {![info exists coreModificationTime]} {
+	if {[file exists [file join $::tcltest::workingDirectory core]]} {
+	    variable coreModificationTime [file mtime [file join \
+		    $::tcltest::workingDirectory core]]
+	}
+    }
 }   

 # ::tcltest::AddToSkippedBecause --
@@ -207,7 +270,7 @@ namespace eval tcltest {
 #       previously exist - otherwise, it just increments it.

 proc ::tcltest::AddToSkippedBecause { constraint } {
-    # add the constraint to the list of constraints the kept tests
+    # add the constraint to the list of constraints that kept tests
    # from running

    if {[info exists ::tcltest::skippedBecause($constraint)]} {
@@ -270,7 +333,9 @@ proc ::tcltest::PrintError {errorMsg} {
    return
 }

-proc ::tcltest::initConstraintsHook {} {}
+if {[namespace inscope ::tcltest info procs initConstraintsHook] == {}} {
+    proc ::tcltest::initConstraintsHook {} {}
+}

 # ::tcltest::initConstraints --
 #
@@ -291,8 +356,6 @@ proc ::tcltest::initConstraintsHook {} {}
 proc ::tcltest::initConstraints {} {
    global tcl_platform tcl_interactive tk_version

-    catch {unset ::tcltest::testConstraints}
-
    # The following trace procedure makes it so that we can safely refer to
    # non-existent members of the ::tcltest::testConstraints array without
    # causing an error.  Instead, reading a non-existent member will return 0.
@@ -339,9 +402,10 @@ proc ::tcltest::initConstraints {} {
    set ::tcltest::testConstraints(win32s) [string equal $tcl_platform(os) \
 	    "Win32s"]

-    # The following Constraints switches are used to mark tests that should work,
-    # but have been temporarily disabled on certain platforms because they don't
-    # and we haven't gotten around to fixing the underlying problem.
+    # The following Constraints switches are used to mark tests that should
+    # work, but have been temporarily disabled on certain platforms because
+    # they don't and we haven't gotten around to fixing the underlying
+    # problem. 

    set ::tcltest::testConstraints(tempNotPc) \
 	    [expr {!$::tcltest::testConstraints(pc)}]
@@ -381,7 +445,11 @@ proc ::tcltest::initConstraints {} {

    # Some tests must be skipped if the interpreter is not in interactive mode

-    set ::tcltest::testConstraints(interactive) $tcl_interactive
+    if {[info exists tcl_interactive]} {
+	set ::tcltest::testConstraints(interactive) $::tcl_interactive
+    } else {
+	set ::tcltest::testConstraints(interactive) 0
+    }

    # Some tests can only be run if the installation came from a CD image
    # instead of a web image
@@ -437,7 +505,7 @@ proc ::tcltest::initConstraints {} {
    # to the "e" format of floating-point numbers.

    set ::tcltest::testConstraints(eformat) 1
-    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+    if {![string equal "[format %g 5e-5]" "5e-05"]} {
 	set ::tcltest::testConstraints(eformat) 0
    }

@@ -550,7 +618,9 @@ proc ::tcltest::initConstraints {} {
 #       Hook used for customization of display of usage information.
 #

-proc ::tcltest::PrintUsageInfoHook {} {}
+if {[namespace inscope ::tcltest info procs PrintUsageInfoHook] == {}} {
+    proc ::tcltest::PrintUsageInfoHook {} {}
+}

 # ::tcltest::PrintUsageInfo
 #
@@ -612,7 +682,9 @@ proc ::tcltest::PrintUsageInfo {} {
 #       processed by ::tcltest::processCmdLineArgs. 
 #

-proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsAddFlagsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
+}

 # ::tcltest::processCmdLineArgsHook --
 #
@@ -623,7 +695,9 @@ proc ::tcltest::processCmdLineArgsAddFlagsHook {} {}
 #	flags      The flags that have been pulled out of argv
 #

-proc ::tcltest::processCmdLineArgsHook {flag} {}
+if {[namespace inscope ::tcltest info procs processCmdLineArgsHook] == {}} {
+    proc ::tcltest::processCmdLineArgsHook {flag} {}
+}

 # ::tcltest::processCmdLineArgs --
 #
@@ -672,7 +746,7 @@ proc ::tcltest::processCmdLineArgs {} {
    # -help is not listed since it has already been processed
    lappend defaultFlags -verbose -match -skip -constraints \
 	    -outfile -errfile -debug -tmpdir -file -notfile \
-	    -preservecore -limitconstraints
+	    -preservecore -limitconstraints -args
    set defaultFlags [concat $defaultFlags \
 	    [ ::tcltest::processCmdLineArgsAddFlagsHook ]]

@@ -685,6 +759,11 @@ proc ::tcltest::processCmdLineArgs {} {
 	}
    }

+    # Set ::tcltest::parameters to the arg of the -args flag, if given
+    if {[info exists flag(-args)]} {
+	set ::tcltest::parameters $flag(-args)
+    }
+
    # Set ::tcltest::verbose to the arg of the -verbose flag, if given

    if {[info exists flag(-verbose)]} {
@@ -751,9 +830,9 @@ proc ::tcltest::processCmdLineArgs {} {
    if {[info exists flag(-tmpdir)]} {
 	set ::tcltest::temporaryDirectory $flag(-tmpdir)

-	if {[string compare \
+	if {![string equal \
 		[file pathtype $::tcltest::temporaryDirectory] \
-		"absolute"] != 0} { 
+		"absolute"]} { 
 	    set ::tcltest::temporaryDirectory [file join [pwd] \
 		    $::tcltest::temporaryDirectory] 
 	}
@@ -793,7 +872,7 @@ proc ::tcltest::processCmdLineArgs {} {

    if {[info exists flag(-outfile)]} {
 	set tmp $flag(-outfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::outputChannel [open $tmp w]
@@ -801,7 +880,7 @@ proc ::tcltest::processCmdLineArgs {} {

    if {[info exists flag(-errfile)]} {
 	set tmp $flag(-errfile)
-	if {[string compare [file pathtype $tmp] "absolute"] != 0} {
+	if {![string equal [file pathtype $tmp] "absolute"]} {
 	    set tmp [file join $::tcltest::temporaryDirectory $tmp]
 	}
 	set ::tcltest::errorChannel [open $tmp w]
@@ -947,7 +1026,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 	# exit only if running Tk in non-interactive mode

 	global tk_version tcl_interactive
-	if {[info exists tk_version] && !$tcl_interactive} {
+	if {[info exists tk_version] && ![info exists tcl_interactive]} {
 	    exit
 	}
    } else {
@@ -1050,7 +1129,9 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 #       additional things that should be done at cleanup.
 #

-proc ::tcltest::cleanupTestsHook {} {}
+if {[namespace inscope ::tcltest info procs cleanupTestsHook] == {}} {
+    proc ::tcltest::cleanupTestsHook {} {}
+}

 # test --
 #
@@ -1135,16 +1216,14 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	if {[string match {*[$\[]*} $constraints] != 0} {
 	    # full expression, e.g. {$foo > [info tclversion]}
 	    catch {set doTest [uplevel #0 expr $constraints]}
-
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
 	    # something like {a || b} should be turned into 
 	    # $::tcltest::testConstraints(a) || $::tcltest::testConstraints(b).
- 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
+ 	    regsub -all {[.\w]+} $constraints \
 		    {$::tcltest::testConstraints(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
 	    # just simple constraints such as {unixOnly fonts}.
-
 	    set doTest 1
 	    foreach constraint $constraints {
 		if {(![info exists ::tcltest::testConstraints($constraint)]) \
@@ -1191,7 +1270,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
    }

    set code [catch {uplevel $script} actualAnswer]
-    if {([string compare $actualAnswer $expectedAnswer] == 0) && ($code == 0)} {
+    if {([string equal $actualAnswer $expectedAnswer]) && ($code == 0)} {
 	incr ::tcltest::numTests(Passed)
 	if {[string first p $::tcltest::verbose] != -1} {
 	    puts $::tcltest::outputChannel "++++ $name PASSED"
@@ -1261,7 +1340,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
    }
 }

-# ::tcltest::getMatchingTestFiles
+# ::tcltest::getMatchingFiles
 #
 #       Looks at the patterns given to match and skip files
 #       and uses them to put together a list of the tests that will be run.
@@ -1379,7 +1458,7 @@ proc ::tcltest::restoreState {} {
 	    if {$::tcltest::debug > 2} {
 		puts "::tcltest::restoreState: Removing variable $p"
 	    }
-	    uplevel #0 "unset $p"
+	    uplevel #0 "catch {unset $p}"
 	}
    }
 }
@@ -1508,7 +1587,7 @@ proc ::tcltest::viewFile {name} {
 # Example:
 #   grep {regexp a} $someList   
 #
-proc ::tcltest:grep { expression searchList } {
+proc ::tcltest::grep { expression searchList } {
    foreach element $searchList {
 	if {[regsub -all CURRENT_ELEMENT $expression $element \
 		newExpression] == 0} { 
@@ -1577,9 +1656,12 @@ proc ::tcltest::threadReap {} {
 	    foreach tid [testthread names] {
 		if {$tid != $::tcltest::mainThread} {
 		    catch {testthread send -async $tid {testthread exit}}
-		    update
 		}
 	    }
+	    ## Enter a bit a sleep to give the threads enough breathing
+	    ## room to kill themselves off, otherwise the end up with a
+	    ## massive queue of repeated events
+	    after 1
 	}
 	testthread errorproc ThreadError
 	return [llength [testthread names]]
@@ -1591,7 +1673,8 @@ proc ::tcltest::threadReap {} {
 # Initialize the constraints and set up command line arguments 
 namespace eval tcltest {
    ::tcltest::initConstraints
-    ::tcltest::processCmdLineArgs
+    if {[namespace children ::tcltest] == {}} {
+	::tcltest::processCmdLineArgs
+    }
 }

-return
@@ -8,7 +8,7 @@ Jim Ingham
 Cygnus Solutions
 jingham@cygnus.com

-RCS: @(#) $Id: README,v 1.8 1999/06/25 23:29:53 welch Exp $
+RCS: @(#) $Id: README,v 1.8.4.1 1999/10/30 11:07:32 hobbs Exp $

 1. Introduction
 ---------------
@@ -64,7 +64,7 @@ In order to compile Macintosh Tcl you must have the
 following items:

 	CodeWarrior Pro 2 or 3
-	Mac Tcl 8.1 (source)
+	Mac Tcl (source)
 	More Files 1.4.3

 The included project files should work fine.  However, for
@@ -9,7 +9,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclMacFCmd.c,v 1.5 1999/05/11 07:12:00 jingham Exp $
+ * RCS: @(#) $Id: tclMacFCmd.c,v 1.5.6.2 1999/10/30 11:07:33 hobbs Exp $
 */

 #include "tclInt.h"
@@ -1194,15 +1194,19 @@ static int
 GetFileFinderAttributes(
    Tcl_Interp *interp,		/* The interp to report errors with. */
    int objIndex,		/* The index of the attribute option. */
-    CONST char *fileName,	/* The name of the file. */
+    CONST char *fileName,	/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
 {
    OSErr err;
    FSSpec fileSpec;
    FInfo finfo;
-    
-    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
-    
+    Tcl_DString pathString;
+
+    Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+    err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+	    Tcl_DStringValue(&pathString), &fileSpec);
+    Tcl_DStringFree(&pathString);
+
    if (err == noErr) {
    	err = FSpGetFInfo(&fileSpec, &finfo);
    }
@@ -1269,14 +1273,18 @@ static int
 GetFileReadOnly(
    Tcl_Interp *interp,		/* The interp to report errors with. */
    int objIndex,		/* The index of the attribute. */
-    CONST char *fileName,	/* The name of the file. */
+    CONST char *fileName,	/* The name of the file (UTF-8). */
    Tcl_Obj **readOnlyPtrPtr)	/* A pointer to return the object with. */
 {
    OSErr err;
    FSSpec fileSpec;
    CInfoPBRec paramBlock;
-    
-    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    Tcl_DString pathString;
+
+    Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+    err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+	    Tcl_DStringValue(&pathString), &fileSpec);
+    Tcl_DStringFree(&pathString);
    
    if (err == noErr) {
    	if (err == noErr) {
@@ -1330,14 +1338,18 @@ static int
 SetFileFinderAttributes(
    Tcl_Interp *interp,		/* The interp to report errors with. */
    int objIndex,		/* The index of the attribute. */
-    CONST char *fileName,	/* The name of the file. */
+    CONST char *fileName,	/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The command line object. */
 {
    OSErr err;
    FSSpec fileSpec;
    FInfo finfo;
-    
-    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    Tcl_DString pathString;
+
+    Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+    err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+	    Tcl_DStringValue(&pathString), &fileSpec);
+    Tcl_DStringFree(&pathString);
    
    if (err == noErr) {
    	err = FSpGetFInfo(&fileSpec, &finfo);
@@ -1418,15 +1430,19 @@ static int
 SetFileReadOnly(
    Tcl_Interp *interp,		/* The interp to report errors with. */
    int objIndex,		/* The index of the attribute. */
-    CONST char *fileName,	/* The name of the file. */
+    CONST char *fileName,	/* The name of the file (UTF-8). */
    Tcl_Obj *readOnlyPtr)	/* The command line object. */
 {
    OSErr err;
    FSSpec fileSpec;
    HParamBlockRec paramBlock;
    int hidden;
-    
-    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    Tcl_DString pathString;
+
+    Tcl_UtfToExternalDString(NULL, fileName, -1, &pathString);
+    err = FSpLocationFromPath(Tcl_DStringLength(&pathString),
+	    Tcl_DStringValue(&pathString), &fileSpec);
+    Tcl_DStringFree(&pathString);
    
    if (err == noErr) {
    	if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclMacLoad.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
+ * RCS: @(#) $Id: tclMacLoad.c,v 1.3.6.1 1999/10/30 11:07:33 hobbs Exp $
 */

 #include <CodeFragments.h>
@@ -135,7 +135,7 @@ TclpLoadFile(
    *(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0;
    
    native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
-    err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+    err = FSpLocationFromPath(strlen(native), native, &fileSpec);
    Tcl_DStringFree(&ds);
    
    if (err != noErr) {
@@ -1,6 +1,6 @@
 README -- Tcl test suite design document.

-RCS: @(#) $Id: README,v 1.6 1999/06/26 03:54:09 jenn Exp $
+RCS: @(#) $Id: README,v 1.6.4.1 1999/09/22 21:06:14 jenn Exp $

 Contents:
 ---------
@@ -25,9 +25,12 @@ You can run the tests in three ways:
    (b) type "tcltest <testFile> ?<option> <value>?
 	Command line options include:

+	-help                display usage information
+
 	-verbose <level>     set the level of verbosity to a substring
 			     of "bps".  See the "Test output" section
-			     for an explanation of this option.
+			     of the tcltest man page for an
+			     explanation of this option. 

 	-match <matchList>   only run tests that match one or more of
 			     the glob patterns in <matchList>
@@ -35,27 +38,60 @@ You can run the tests in three ways:
 	-skip <skipList>     do not run tests that match one or more
 			     of the glob patterns in <skipList>

-	-file <globPattern>  only source test files that match
-			     <globPattern> (relative to the "tests"
-			     directory).  This option only applies
-			     when you run the test suite with the
-			     "all.tcl" file.
+	-file <globPatternList>  
+		             only source test files that match one or
+		             more of the glob patterns in
+		             <globPatternList> (relative to the
+		             "tests" directory).  This option only
+		             applies when you run the test suite with
+		             the "all.tcl" file.
+
+	-notfile <globPatternList>  
+	                     do not source test files that match one
+	                     or more of the patterns in
+	                     <globPatternList> (relative to the
+	                     "tests" directory).  This option only
+	                     applies when you run the test suite with
+	                     the "all.tcl" file.

 	-constraints <list>  tests with any constraints in <list> will
 			     not be skipped.  Not that elements of
 			     <list> must exactly match the existing
 			     constraints.

+        -limitconstraints <bool>
+                             If 1, limit test runs to those tests that
+                             match the constraints listed using the
+                             -constraints flag.  Use of this flag
+                             requires use of the -constraints flag.
+                             The default value is 0.
+
+        -tmpdir <dirname>    put temporary files created by
+                             ::tcltest::makeFile and
+                             ::tcltest::makeDirectory in the named
+                             directory.  The default location is
+                             ::tcltest::workingDirectory.
+
+        -preservecore <level>
+                             check for core files.  If level is 0,
+                             check for core files only when
+                             cleanupTests is called from an all.tcl
+                             file.  If 1, also check at the end of
+                             every test command.  If 2, also save core
+                             files in ::tcltest::temporaryDirectory.
+                             The default level is 0.
+ 
    (c) start up tcltest in this directory, then "source" the test
        file (for example, type "source parse.test").  To run all
 	of the tests, type "source all.tcl".  To use the options in
 	interactive mode, you can set their corresponding tcltest
-	namespace variables after sourcing the defs.tcl file.
+	namespace variables after loading the tcltest package.
+	For example, some of the tcltest variables are:
 		  ::tcltest::match
 		  ::tcltest::skip
-		  ::tcltest::testConfig(nonPortable)
-		  ::tcltest::testConfig(knownBug)
-		  ::tcltest::testConfig(userInteractive)
+		  ::tcltest::testConstraints(nonPortable)
+		  ::tcltest::testConstraints(knownBug)
+		  ::tcltest::testConstraints(userInteractive)

 Please see the tcltest man page for more information regarding how to
 write and run tests.
@@ -88,14 +124,9 @@ the constraints mechanism to skip those tests.
   --------   --------
   VERBOSE    ::tcltest::verbose
   TESTS      ::tcltest::match
-   testConfig ::tcltest::testConfig
+   testConfig ::tcltest::testConstraints

-   The introduction of the "tcltest" namespace is a precursor to using
-   a "tcltest" package.  This next step will be part of a future Tcl
-   version.
-
-2) VERBOSE values are no longer numeric.  Please see the section above
-   on "Test output" for the new usage of the ::tcltest::verbose variable.
+2) VERBOSE values are no longer numeric.  

 3) When you run "make test", the working dir for the test suite is now
   the one from which you called "make test", rather than the "tests"
@@ -104,7 +135,7 @@ the constraints mechanism to skip those tests.
   other or with existing files.  All tests must now run independently
   of their working directory.

-4) The "all" and "visual" files are now called "all.tcl" ane
+4) The "all" and "visual" files are now called "all.tcl" and
   "visual_bb.test".

 5) The "defs" file no longer exists.
@@ -112,5 +143,5 @@ the constraints mechanism to skip those tests.
 6) Instead of creating a doAllTests file in the tests directory, to
   run all nonPortable tests, just use the "-constraints nonPortable"
   command line flag.  If you are running interactively, you can set
-   the ::tcltest::testConfig(nonPortable) variable to 1 (after
-   sourcing the defs.tcl file).
+   the ::tcltest::testConstraints(nonPortable) variable to 1 (after
+   loading the tcltest package).
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: encoding.test,v 1.5 1999/07/02 06:41:29 welch Exp $
+# RCS: @(#) $Id: encoding.test,v 1.5.4.1 1999/10/30 11:07:53 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -61,24 +61,24 @@ test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
 test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
    set system [encoding system]
    set path [testencoding path]
-    encoding system jis0208		;# incr ref count
-    testencoding path .
-    set x [encoding convertto jis0208 \u4e4e]	;# old one found   
+    encoding system shiftjis		;# incr ref count
+    testencoding path [list [pwd]]
+    set x [encoding convertto shiftjis \u4e4e]	;# old one found   
    encoding system identity
-    lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg
+    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
    encoding system identity
    testencoding path $path
    encoding system $system
    set x
-} {8C 1 {unknown encoding "jis0208"}}
+} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

 test encoding-3.1 {Tcl_GetEncodingName, NULL} {
    set old [encoding system]
-    encoding system jis0208
+    encoding system shiftjis
    set x [encoding system]
    encoding system $old
    set x
-} {jis0208}
+} {shiftjis}
 test encoding-3.2 {Tcl_GetEncodingName, non-null} {
    set old [fconfigure stdout -encoding]
    fconfigure stdout -encoding jis0208
@@ -99,7 +99,7 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
    foreach encoding [encoding names] {
 	set encodings($encoding) 1
    }
-    testencoding path .
+    testencoding path [list [pwd]]
    foreach encoding [encoding names] {
 	if {![info exists encodings($encoding)]} {
 	    lappend x $encoding
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: env.test,v 1.9 1999/07/08 19:44:43 rjohnson Exp $
+# RCS: @(#) $Id: env.test,v 1.9.4.2 1999/09/22 21:06:15 jenn Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -78,12 +78,13 @@ puts $f {
 	lrem names ComSpec
 	lrem names ""
    }	
-    foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH PURE_PROG_NAME DISPLAY SHLIB_PATH } {
+    foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH } {
 	lrem names $name
    }
    foreach p $names {
 	puts "$p=$env($p)"
    }
+    exit
 }
 close $f
 	
@@ -106,7 +107,7 @@ foreach name [array names env] {
 # Added the following lines so that child tcltest can actually find its
 # library if the initial tcltest is run from a non-standard place.
 # ('saved' env vars)
-foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH DISPLAY SHLIB_PATH} {
+foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH} {
  if {[info exists env2($name)]} {
     set env($name) $env2($name);
  }
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: event.test,v 1.8 1999/07/01 17:36:17 jenn Exp $
+# RCS: @(#) $Id: event.test,v 1.8.4.1 1999/09/22 04:12:56 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -394,9 +394,9 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
 	puts $s foobar
 	close $s
    }
-    set s1 [socket -server accept 5001]
+    catch {set s1 [socket -server accept 5001]}
    after 1000
-    set s2 [socket 127.0.0.1 5001]
+    catch {set s2 [socket 127.0.0.1 5001]}
    close $s1
    set x 0
    set y 0
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: exec.test,v 1.5 1999/07/01 17:36:17 jenn Exp $
+# RCS: @(#) $Id: exec.test,v 1.5.4.1 1999/09/22 21:06:15 jenn Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -29,6 +29,7 @@ puts $f {
 	puts -nonewline " $str"
    }
    puts {}
+    exit
 }
 close $f

@@ -51,6 +52,7 @@ puts $f {
 	    close $f
 	}
    }
+    exit
 }
 close $f

@@ -61,6 +63,7 @@ puts $f {
    set words [regsub -all "\[^ \t\n]+" $data {} dummy]
    set chars [string length $data]
    puts [format "%8.d%8.d%8.d" $lines $words $chars]
+    exit
 }
 close $f

@@ -85,12 +88,14 @@ puts $f {
 	}
 	lappend newcmd $arg
    }
+    exit
 }
 close $f

 set f [open sleep w]
 puts $f {
    after [expr $argv*1000]
+    exit
 }
 close $f

@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: expr.test,v 1.5 1999/06/30 00:17:06 jenn Exp $
+# RCS: @(#) $Id: expr.test,v 1.5.4.1 1999/09/22 04:12:57 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -703,6 +703,14 @@ test expr-20.3 {broken substitution of integer digits} {
    # fails with 8.0.x, but not 8.1b2
    list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
 } {4096 1000}
+test expr-20.4 {proper double evaluation compilation, error case} {
+    catch {unset a}; # make sure $a doesn't exist
+    list [catch {expr 1?{$a}:0} msg] $msg
+} {1 {can't read "a": no such variable}}
+test expr-20.5 {proper double evaluation compilation, working case} {
+    set a yellow
+    expr 1?{$a}:0
+} yellow

 # cleanup
 if {[info exists a]} {
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: format.test,v 1.5 1999/06/26 03:54:14 jenn Exp $
+# RCS: @(#) $Id: format.test,v 1.5.4.1 1999/09/22 04:12:57 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -467,6 +467,19 @@ test format-14.2 {testing MAX_FLOAT_SIZE for 0 and 1} {
    format {%s} "a"
 } {a}

+test format-15.1 {testing %0..s 0 padding for chars/strings} {
+    format %05s a
+} {0000a}
+test format-15.2 {testing %0..s 0 padding for chars/strings} {
+    format "% 5s" a
+} {    a}
+test format-15.3 {testing %0..s 0 padding for chars/strings} {
+    format %5s a
+} {    a}
+test format-15.4 {testing %0..s 0 padding for chars/strings} {
+    format %05c 61
+} {0000=}
+
 set a "0123456789"
 set b ""
 for {set i 0} {$i < 290} {incr i} {
@@ -12,19 +12,19 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 #
-# RCS: @(#) $Id: http.test,v 1.12 1999/07/20 00:11:53 hershey Exp $
+# RCS: @(#) $Id: http.test,v 1.12.4.1 1999/11/19 23:32:28 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
 }

-if {[catch {package require http 2.1}]} {
+if {[catch {package require http 2.2}]} {
    if {[info exist http2]} {
-	catch {puts "Cannot load http 2.1 package"}
+	catch {puts "Cannot load http 2.2 package"}
 	return
    } else {
-	catch {puts "Running http 2.1 tests in slave interp"}
+	catch {puts "Running http 2.2 tests in slave interp"}
 	set interp [interp create http2]
 	$interp eval [list set http2 "running"]
 	$interp eval [list source [info script]]
@@ -74,7 +74,7 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {

 test http-1.1 {http::config} {
    http::config
-} {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.1}}
+} {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.2}}

 test http-1.2 {http::config} {
    http::config -proxyfilter
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: incr.test,v 1.4 1999/06/26 03:54:14 jenn Exp $
+# RCS: @(#) $Id: incr.test,v 1.4.4.1 1999/10/30 11:07:53 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -239,6 +239,12 @@ test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
    set x "  -  "
    list [catch {incr x 1} msg] $msg
 } {1 {expected integer but got "  -  "}}
+
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+    catch {unset array}
+    set array(\$foo) 4
+    incr {array($foo)}
+} 5
    
 # Check "incr" and computed command names.

@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: linsert.test,v 1.6 1999/06/26 03:54:16 jenn Exp $
+# RCS: @(#) $Id: linsert.test,v 1.6.4.1 1999/09/22 04:12:57 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -78,6 +78,9 @@ test linsert-1.18 {linsert command} {
 test linsert-1.19 {linsert command} {
    linsert {} end q r
 } {q r}
+test linsert-1.20 {linsert command, use of end-int index} {
+    linsert {a b c d} end-2 e f
+} {a b e f c d}

 test linsert-2.1 {linsert errors} {
    list [catch linsert msg] $msg
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: pkg.test,v 1.6 1999/06/26 20:55:09 rjohnson Exp $
+# RCS: @(#) $Id: pkg.test,v 1.6.4.1 1999/09/22 04:12:57 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -529,6 +529,9 @@ test pkg-5.3 {CheckVersion procedure} {
 test pkg-5.4 {CheckVersion procedure} {
    list [catch {package vcompare 1.2.3. 2.1} msg] $msg
 } {1 {expected version number but got "1.2.3."}}
+test pkg-5.5 {CheckVersion procedure} {
+    list [catch {package vcompare 1.2..3 2.1} msg] $msg
+} {1 {expected version number but got "1.2..3"}}

 test pkg-6.1 {ComparePkgVersions procedure} {
    package vcompare 1.23 1.22
@@ -3,10 +3,13 @@
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
 # generates output for errors.  No output means no errors were found.
+# (Don't panic if you are seeing this as part of the reg distribution
+# and aren't using Tcl -- reg's own regression tester also knows how
+# to read this file, ignoring the Tcl-isms.)
 #
 # Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 #
-# RCS: @(#) $Id: reg.test,v 1.10 1999/08/05 01:21:09 stanton Exp $
+# RCS: @(#) $Id: reg.test,v 1.10.4.1 1999/11/02 02:10:05 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -21,13 +24,18 @@ set ::tcltest::testConstraints(testregexp) \

 # This file uses some custom procedures, defined below, for regexp regression
 # testing.  The name of the procedure indicates the general nature of the
-# test:  e for compile error expected, f for match failure expected, m
-# for a successful match, and i for a successful match with -indices (used
-# in checking things like nonparticipating subexpressions).  There is also
-# a "doing" procedure which sets up title and major test number for each
-# block of tests, and an "xx" procedure which ignores its arguments and
-# arranges for the next invocation of "doing" to announce that some tests
-# were bypassed (which is better than just commenting them out).
+# test:
+#	e	compile error expected
+#	f	match failure expected
+#	m	successful match
+#	i	successful match with -indices (used in checking things like
+#		nonparticipating subexpressions)
+#	p	unsuccessful match with -indices (!!) (used in checking
+#		partial-match reporting)
+# There is also "doing" which sets up title and major test number for each
+# block of tests, and "xx" which ignores its arguments and arranges for the
+# next "doing" to announce that some tests were bypassed (which is better
+# than just commenting them out).

 # The first 3 arguments are constant:  a minor number (which often gets
 # a letter or two suffixed to it internally), some flags, and the RE itself.
@@ -36,10 +44,10 @@ set ::tcltest::testConstraints(testregexp) \
 # to try the match against.  Remaining arguments are the substring expected
 # to be matched, and any substrings expected to be matched by subexpressions.
 # (For f, these arguments are optional, and if present are ignored except
-# that they indicate how many subexpressions should be presents in the RE.)
+# that they indicate how many subexpressions should be present in the RE.)
 # It is an error for the number of subexpression arguments to be wrong.
 # Cases involving nonparticipating subexpressions, checking where empty
-# substrings are located, etc. should be done using i.
+# substrings are located, etc. should be done using i and p.

 # The flag characters are complex and a bit eclectic.  Generally speaking, 
 # lowercase letters are compile options, uppercase are expected re_info
@@ -51,11 +59,11 @@ set ::tcltest::testConstraints(testregexp) \
 # useful in this file.
 #
 #	-	no-op (placeholder)
-#	+	provide fake xy equivalence class
+#	+	provide fake xy equivalence class and ch collating element
 #	%	force small state-set cache in matcher (to test cache replace)
 #	^	beginning of string is not beginning of line
 #	$	end of string is not end of line
-#	?	report information on partial and limited matches
+#	*	test is Unicode-specific, needs big character set
 #
 #	&	test as both ARE and BRE
 #	b	BRE
@@ -69,6 +77,7 @@ set ::tcltest::testConstraints(testregexp) \
 #	w	newlines are half-magic, significant to ^ and $ only
 #	n	newlines are fully magic, both effects
 #	x	expanded RE syntax
+#	t	incomplete-match reporting
 #
 #	A	backslash-_a_lphanumeric seen
 #	B	ERE/ARE literal-_b_race heuristic used
@@ -82,6 +91,7 @@ set ::tcltest::testConstraints(testregexp) \
 #	Q	{} _q_uantifier seen
 #	R	back _r_eference seen
 #	S	POSIX-un_s_pecified syntax seen
+#	T	prefers shortest (_t_iny)
 #	U	saw original-POSIX botch:  unmatched right paren in ERE (_u_gh)

 # The one area we can't easily test is memory-allocation failures (which
@@ -109,8 +119,9 @@ set infonames(P) "REG_UNONPOSIX"
 set infonames(Q) "REG_UBOUNDS"
 set infonames(R) "REG_UBACKREF"
 set infonames(S) "REG_UUNSPEC"
+set infonames(T) "REG_USHORTEST"
 set infonames(U) "REG_UPBOTCH"
-set infonameorder "RHQBAUEPSMLNI"	;# must match bit order, lsb first
+set infonameorder "RHQBAUEPSMLNIT"	;# must match bit order, lsb first

 # set major test number and description
 proc doing {major desc} {
@@ -182,6 +193,12 @@ proc infoflags {fl} {
 proc e {testid flags re err} {
 	global prefix ask errorCode

+	# Tcl locale stuff doesn't do the ch/xy test fakery yet
+	if {[string first "+" $flags] >= 0} {
+		xx
+		return
+	}
+
 	# if &, test as both ARE and BRE
 	set amp [string first "&" $flags]
 	if {$amp >= 0} {
@@ -201,6 +218,12 @@ proc e {testid flags re err} {
 proc f {testid flags re target args} {
 	global prefix description ask

+	# Tcl locale stuff doesn't do the ch/xy test fakery yet
+	if {[string first "+" $flags] >= 0} {
+		xx
+		return
+	}
+
 	# if &, test as both ARE and BRE
 	set amp [string first "&" $flags]
 	if {$amp >= 0} {
@@ -240,6 +263,12 @@ proc f {testid flags re target args} {
 proc matchexpected {opts testid flags re target args} {
 	global prefix description ask

+	# Tcl locale stuff doesn't do the ch/xy test fakery yet
+	if {[string first "+" $flags] >= 0} {
+		xx
+		return
+	}
+
 	# if &, test as both BRE and ARE
 	set amp [string first "&" $flags]
 	if {$amp >= 0} {
@@ -270,10 +299,10 @@ proc matchexpected {opts testid flags re target args} {
 		append refs " \$$name"
 		set $name ""
 	}
-	if {[string first "o" $flags] >= 0} {	;# REG_NOSUB
+	if {[string first "o" $flags] >= 0} {	;# REG_NOSUB kludge
 		set nsub 0		;# unsigned value cannot be -1
 	}
-	if {[string first "?" $flags] >= 0} {	;# REG_EXPECT
+	if {[string first "t" $flags] >= 0} {	;# REG_EXPECT
 		incr nsub -1		;# the extra does not count
 	}
 	set ecmd [concat $ecmd $names]
@@ -431,11 +460,11 @@ m  7	bN	**		***	***
 e  8	&	a**		BADRPT
 e  9	&	a**b		BADRPT
 e 10	&	***		BADRPT
-e 11	*	a++		BADRPT
-e 12	*	a?+		BADRPT
-e 13	*	a?*		BADRPT
-e 14	*	a+*		BADRPT
-e 15	*	a*+		BADRPT
+e 11	-	a++		BADRPT
+e 12	-	a?+		BADRPT
+e 13	-	a?*		BADRPT
+e 14	-	a+*		BADRPT
+e 15	-	a*+		BADRPT



@@ -514,7 +543,7 @@ m 40	eE	{a[\\]b}	"a\\b"	"a\\b"
 m 41	bE	{a[\\]b}	"a\\b"	"a\\b"
 e 42	-	{a[\Z]b}	EESCAPE
 m 43	&	{a[[b]c}	"a\[c"	"a\[c"
-m 44	EMP	{a[\u00fe-\u0507][\u00ff-\u0300]b} \
+m 44	EMP*	{a[\u00fe-\u0507][\u00ff-\u0300]b} \
 			"a\u0102\u02ffb"	"a\u0102\u02ffb"


@@ -645,26 +674,26 @@ m 26	MP	"a\\010b"	"a\bb"	"a\bb"

 doing 14 "back references"
 # ugh
-m  1	{R[1P}	{a(b*)c\1}	abbcbb	abbcbb	bb
-m  2	{R[1P}	{a(b*)c\1}	ac	ac	""
-f  3	{R[1P}	{a(b*)c\1}	abbcb
-m  4	{R[1P}	{a(b*)\1}	abbcbb	abb	b
-m  5	{R[1P}	{a(b|bb)\1}	abbcbb	abb	b
-m  6	{R[1P}	{a([bc])\1}	abb	abb	b
-f  7	{R[1P}	{a([bc])\1}	abc
-m  8	{R[1P}	{a([bc])\1}	abcabb	abb	b
-f  9	{R[1P}	{a([bc])*\1}	abc
-f 10	{R[1P}	{a([bc])\1}	abB
-m 11	{iR[1P}	{a([bc])\1}	abB	abB	b
-m 12	{R[1P}	{a([bc])\1+}	abbb	abbb	b
-m 13	{QR[1P}	"a(\[bc])\\1{3,4}"	abbbb	abbbb	b
-f 14	{QR[1P}	"a(\[bc])\\1{3,4}"	abbb
-m 15	{R[1P}	{a([bc])\1*}	abbb	abbb	b
-m 16	{R[1P}	{a([bc])\1*}	ab	ab	b
-m 17	{R[2P}	{a([bc])(\1*)}	ab	ab	b	""
+m  1	RP	{a(b*)c\1}	abbcbb	abbcbb	bb
+m  2	RP	{a(b*)c\1}	ac	ac	""
+f  3	RP	{a(b*)c\1}	abbcb
+m  4	RP	{a(b*)\1}	abbcbb	abb	b
+m  5	RP	{a(b|bb)\1}	abbcbb	abb	b
+m  6	RP	{a([bc])\1}	abb	abb	b
+f  7	RP	{a([bc])\1}	abc
+m  8	RP	{a([bc])\1}	abcabb	abb	b
+f  9	RP	{a([bc])*\1}	abc
+f 10	RP	{a([bc])\1}	abB
+m 11	iRP	{a([bc])\1}	abB	abB	b
+m 12	RP	{a([bc])\1+}	abbb	abbb	b
+m 13	QRP	"a(\[bc])\\1{3,4}"	abbbb	abbbb	b
+f 14	QRP	"a(\[bc])\\1{3,4}"	abbb
+m 15	RP	{a([bc])\1*}	abbb	abbb	b
+m 16	RP	{a([bc])\1*}	ab	ab	b
+m 17	RP	{a([bc])(\1*)}	ab	ab	b	""
 e 18	-	{a((b)\1)}	ESUBREG
 e 19	-	{a(b)c\2}	ESUBREG
-m 20	{bR[1}	{a\(b*\)c\1}	abbcbb	abbcbb	bb
+m 20	bR	{a\(b*\)c\1}	abbcbb	abbcbb	bb



@@ -804,29 +833,28 @@ m 34	N	(a*)*		bc	""	""

 doing 22 "multicharacter collating elements"
 # again ugh
-# currently disabled because the fake MCCE we use for testing is unavailable
-xx m  1	&+L	{a[c]e}		ace	ace
-xx f  2	&+I	{a[c]h}		ach
-xx m  3	&+L	{a[[.ch.]]}	ach	ach
-xx f  4	&+L	{a[[.ch.]]}	ace
-xx m  5	&+L	{a[c[.ch.]]}	ac	ac
-xx m  6	&+L	{a[c[.ch.]]}	ace	ac
-xx m  7	&+L	{a[c[.ch.]]}	ache	ach
-xx f  8	&+L	{a[^c]e}	ace
-xx m  9	&+L	{a[^c]e}	abe	abe
-xx m 10	&+L	{a[^c]e}	ache	ache
-xx f 11	&+L	{a[^[.ch.]]}	ach
-xx m 12	&+L	{a[^[.ch.]]}	ace	ac
-xx m 13	&+L	{a[^[.ch.]]}	ac	ac
-xx m 14	&+L	{a[^[.ch.]]}	abe	ab
-xx f 15	&+L	{a[^c[.ch.]]}	ach
-xx f 16	&+L	{a[^c[.ch.]]}	ace
-xx f 17	&+L	{a[^c[.ch.]]}	ac
-xx m 18	&+L	{a[^c[.ch.]]}	abe	ab
-xx m 19	&+L	{a[^b]}		ac	ac
-xx m 20	&+L	{a[^b]}		ace	ac
-xx m 21	&+L	{a[^b]}		ach	ach
-xx f 22	&+L	{a[^b]}		abe
+m  1	&+L	{a[c]e}		ace	ace
+f  2	&+IL	{a[c]h}		ach
+m  3	&+L	{a[[.ch.]]}	ach	ach
+f  4	&+L	{a[[.ch.]]}	ace
+m  5	&+L	{a[c[.ch.]]}	ac	ac
+m  6	&+L	{a[c[.ch.]]}	ace	ac
+m  7	&+L	{a[c[.ch.]]}	ache	ach
+f  8	&+L	{a[^c]e}	ace
+m  9	&+L	{a[^c]e}	abe	abe
+m 10	&+L	{a[^c]e}	ache	ache
+f 11	&+L	{a[^[.ch.]]}	ach
+m 12	&+L	{a[^[.ch.]]}	ace	ac
+m 13	&+L	{a[^[.ch.]]}	ac	ac
+m 14	&+L	{a[^[.ch.]]}	abe	ab
+f 15	&+L	{a[^c[.ch.]]}	ach
+f 16	&+L	{a[^c[.ch.]]}	ace
+f 17	&+L	{a[^c[.ch.]]}	ac
+m 18	&+L	{a[^c[.ch.]]}	abe	ab
+m 19	&+L	{a[^b]}		ac	ac
+m 20	&+L	{a[^b]}		ace	ac
+m 21	&+L	{a[^b]}		ach	ach
+f 22	&+L	{a[^b]}		abe



@@ -843,27 +871,27 @@ f  8	HP	(?=b)b		a


 doing 24 "non-greedy quantifiers"
-m  1	P	ab+?		abb	ab
-m  2	P	ab+?c		abbc	abbc
-m  3	P	ab*?		abb	a
-m  4	P	ab*?c		abbc	abbc
-m  5	P	ab??		ab	a
-m  6	P	ab??c		abc	abc
-m  7	PQ	"ab{2,4}?"	abbbb	abb
-m  8	PQ	"ab{2,4}?c"	abbbbc	abbbbc
+m  1	PT	ab+?		abb	ab
+m  2	PT	ab+?c		abbc	abbc
+m  3	PT	ab*?		abb	a
+m  4	PT	ab*?c		abbc	abbc
+m  5	PT	ab??		ab	a
+m  6	PT	ab??c		abc	abc
+m  7	PQT	"ab{2,4}?"	abbbb	abb
+m  8	PQT	"ab{2,4}?c"	abbbbc	abbbbc
 m  9	-	3z*		123zzzz456	3zzzz
-m 10	P	3z*?		123zzzz456	3
+m 10	PT	3z*?		123zzzz456	3
 m 11	-	z*4		123zzzz456	zzzz4
-m 12	P	z*?4		123zzzz456	zzzz4
+m 12	PT	z*?4		123zzzz456	zzzz4



 doing 25 "mixed quantifiers"
+# this is very incomplete as yet
 # should include |
-m  1	PN	{^(.*?)(a*)$}	xyza	xyza	xyz	a
-m  2	PN	{^(.*?)(a*)$}	xyzaa	xyzaa	xyz	aa
-m  3	PN	{^(.*?)(a*)$}	xyz	xyz	xyz	""
-xx lots more to be done
+m  1	PNT	{^(.*?)(a*)$}	xyza	xyza	xyz	a
+m  2	PNT	{^(.*?)(a*)$}	xyzaa	xyzaa	xyz	aa
+m  3	PNT	{^(.*?)(a*)$}	xyz	xyz	xyz	""



@@ -913,22 +941,24 @@ i 12	%LP	{\w+(abcdefghijklmnopqrst)?}	xyzabcdefghijklmnopqrs \


 doing 29 "incomplete matches"
-p  1	?	def		abc	{3 2} ""
-p  2	?	bcd		abc	{1 2} ""
-p  3	?	abc		abab	{0 3} ""
-p  4	?	abc		abdab	{3 4} ""
-i  5	?	abc		abc	{0 2} {0 2}
-i  6	?	abc		xyabc	{2 4} {2 4}
-p  7	?	abc+		xyab	{2 3} ""
-i  8	?	abc+		xyabc	{2 4} {2 4}
-p  9	?P	abc+?		xyab	{2 3} ""
+p  1	t	def		abc	{3 2}	""
+p  2	t	bcd		abc	{1 2}	""
+p  3	t	abc		abab	{0 3}	""
+p  4	t	abc		abdab	{3 4}	""
+i  5	t	abc		abc	{0 2}	{0 2}
+i  6	t	abc		xyabc	{2 4}	{2 4}
+p  7	t	abc+		xyab	{2 3}	""
+i  8	t	abc+		xyabc	{2 4}	{2 4}
+xx i  9	t	abc+		xyabcd	{2 4}	{6 5}
+i  10	t	abc+		xyabcdd	{2 4}	{7 6}
+p  11	tPT	abc+?		xyab	{2 3}	""
 # the retain numbers in these two may look wrong, but they aren't
-i  10	?P	abc+?		xyabc	{2 4} {5 4}
-i  11	?P	abc+?		xyabcc	{2 4} {6 5}
-i  12	?P	abc+?		xyabcd	{2 4} {6 5}
-i  13	?	abcd|bc		xyabc	{3 4} {2 4}
-i  14	?	abc+		xyabcdd	{2 4} {7 6}
-
+i  12	tPT	abc+?		xyabc	{2 4}	{5 4}
+i  13	tPT	abc+?		xyabcc	{2 4}	{6 5}
+i  14	tPT	abc+?		xyabcd	{2 4}	{6 5}
+i  15	tPT	abc+?		xyabcdd	{2 4}	{7 6}
+i  16	t	abcd|bc		xyabc	{3 4}	{2 4}
+p  17	tn	.*k		"xx\nyyy"	{3 5}	""


 doing 30 "misc. oddities and old bugs"
@@ -936,8 +966,8 @@ e  1	&	***		BADRPT
 m  2	N	a?b*		abb	abb
 m  3	N	a?b*		bb	bb
 m  4	&	a*b		aab	aab
-m  5	&	^a*b		aaaab aaaab
-m  6	&M	 {[0-6][1-2][0-3][0-6][1-6][0-6]}	010010	010010
+m  5	&	^a*b		aaaab	aaaab
+m  6	&M	{[0-6][1-2][0-3][0-6][1-6][0-6]}	010010	010010
 # temporary REG_BOSONLY kludge
 m  7	s	abc		abcd	abc
 f  8	s	abc		xabcd
@@ -945,8 +975,8 @@ f  8	s	abc		xabcd
 m  9	HLP	{(?n)^(?![t#])\S+}	"tk\n\n#\n#\nit0"	it0


-
-doing 0 "flush"			;# to flush any leftover complaints
+# flush any leftover complaints
+doing 0 "flush"

 # cleanup
 ::tcltest::cleanupTests
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: set-old.test,v 1.6 1999/06/26 20:55:12 rjohnson Exp $
+# RCS: @(#) $Id: set-old.test,v 1.6.4.1 1999/09/22 04:12:57 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -501,6 +501,15 @@ test set-old-8.37.4 {array command, empty set with populated array} {
    array set aVaRnAmE [list e3 v3]
    list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
 } {{e1 e2 e3} 0 v2}
+test set-old-8.37.5 {array command, set with non-existent namespace} {
+    list [catch {array set bogusnamespace::var {}} msg] $msg
+} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
+test set-old-8.37.6 {array command, set with non-existent namespace} {
+    list [catch {array set bogusnamespace::var {a b}} msg] $msg
+} {1 {can't set "bogusnamespace::var(a)": parent namespace doesn't exist}}
+test set-old-8.37.7 {array command, set with non-existent namespace} {
+    list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
+} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
 test set-old-8.38 {array command, size option} {
    catch {unset a}
    array size a
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: set.test,v 1.5 1999/06/26 20:55:12 rjohnson Exp $
+# RCS: @(#) $Id: set.test,v 1.5.4.1 1999/10/30 11:07:54 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -200,6 +200,12 @@ test set-1.24 {TclCompileSetCmd: too many arguments} {
    set msg
 } {wrong # args: should be "set varName ?newValue?"}

+test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
+    # This was a known error in 8.1a* - 8.2.1
+    catch {unset array}
+    set {array($foo)} 5
+} 5
+
 test set-2.1 {set command: runtime error, bad variable name} {
    list [catch {set {"foo}} msg] $msg $errorInfo
 } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
@@ -486,15 +492,3 @@ catch {unset x}
 catch {unset z}
 ::tcltest::cleanupTests
 return 
-
-
-
-
-
-
-
-
-
-
-
-
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: string.test,v 1.20 1999/08/10 05:09:20 hobbs Exp $
+# RCS: @(#) $Id: string.test,v 1.20.4.1 1999/10/30 11:07:54 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -244,6 +244,11 @@ test string-5.15 {string index, bytearray object} {
    set i2 [string index $b 1]
    string compare $i1 $i2
 } 0
+test string-5.16 {string index, bytearray object with string obj shimmering} {
+    set str "0123456789\x00 abcdedfghi"
+    binary scan $str H* dump
+    string compare [string index $str 10] \x00
+} 0

 proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: stringObj.test,v 1.8 1999/06/26 20:55:14 rjohnson Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.8.4.1 1999/09/22 04:12:58 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -299,6 +299,23 @@ test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} {
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
 } {string int abc￮ghi9 9 string int}
+test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
+    # bug 2678, in <=8.2.0, the second obj (the one to append) in
+    # Tcl_AppendObjToObj was not correctly checked to see if it was
+    # all one byte chars, so a unicode string would be added as one
+    # byte chars.
+    set x abcdef
+    set len [string length $x]
+    set y aübåcï
+    set len [string length $y]
+    append x $y
+    string length $x
+    set q {}
+    for {set i 0} {$i < 12} {incr i} {
+	lappend q [string index $x $i]
+    }
+    set q
+} {a b c d e f a ü b å c ï}

 test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {
    set x "abcdef"
@@ -1,7 +1,7 @@
 # Command line options covered:
-#  -help, -verbose, -match, -skip, -file, -notfile, -relateddir, -asidefromdir
-#  -constraints, -limitconstraints, -preservecore, -tmpdir, -debug, -outfile,
-#  -errfile 
+#  -help, -verbose, -match, -skip, -file, -notfile, -constraints,
+#  -limitconstraints, -preservecore, -tmpdir, -debug, -outfile, 
+#  -errfile, -args
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -10,7 +10,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: tcltest.test,v 1.5 1999/08/10 05:09:20 hobbs Exp $
+# RCS: @(#) $Id: tcltest.test,v 1.5.4.1 1999/09/22 21:06:16 jenn Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -29,12 +29,13 @@ makeFile {
    test c-1.0 {test c} {knownBug} {
    } {}
    ::tcltest::cleanupTests
-    return
+    exit
 } test.tcl

 # test -help
 test tcltest-1.1 {tcltest -help} {
    set result [catch {exec $::tcltest::tcltest test.tcl -help} msg]
+    set result [catch {runCmd $cmd}]
    list $result [regexp Usage $msg]
 } {1 1} 
 test tcltest-1.2 {tcltest -help -something} {
@@ -157,6 +158,7 @@ makeFile {
    ::tcltest::PrintError "a really really long string containing a \
 	    \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\"" 
    ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
+    exit
 } printerror.tcl

 # -outfile, -errfile
@@ -216,7 +218,7 @@ makeFile {
    package require tcltest
    namespace import ::tcltest::*
    makeFile {} a.tmp
-    return
+    exit
 } a.tcl

 makeFile {} thisdirectoryisafile
@@ -234,8 +236,46 @@ test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
    list [regexp "not a directory" [join $msg]]
 } {1}

-# Platform-specific attribute testing still needs to be set up
-# (non-writeable directories, non-readable directories) as tmpdir -- jlh
+# Test non-writeable directories, non-readable directories with tmpdir
+set notReadableDir [file join $::tcltest::temporaryDirectory notreadable]
+set notWriteableDir [file join $::tcltest::temporaryDirectory notwriteable]
+
+::tcltest::makeDirectory notreadable
+::tcltest::makeDirectory notwriteable
+
+switch $tcl_platform(platform) {
+    "unix" {
+	file attributes $notReadableDir -permissions 00333
+	file attributes $notWriteableDir -permissions 00555
+    }
+    default {
+	file attributes $notWriteableDir -readonly 1
+    }
+}
+
+test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} {
+    catch {exec $::tcltest::tcltest a.tcl -tmpdir $notReadableDir} msg 
+    # The join is necessary because the message can be split on multiple lines
+    list [regexp {not readable} [join $msg]]
+} {1}
+
+test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
+    catch {exec $::tcltest::tcltest a.tcl -tmpdir $notWriteableDir} msg
+    # The join is necessary because the message can be split on multiple lines
+    list [regexp {not writeable} [join $msg]]
+} {1}
+
+switch $tcl_platform(platform) {
+    "unix" {
+	file attributes $notReadableDir -permissions 777
+	file attributes $notWriteableDir -permissions 777
+    }
+    default {
+	file attributes $notWriteableDir -readonly 0
+    }
+}
+
+file delete -force $notReadableDir $notWriteableDir

 # -file -notfile
 test tcltest-9.1 {-file a*.tcl} {
@@ -284,10 +324,33 @@ test tcltest-10.4 {-preservecore 3} {
 	    [regexp "core-" $msg] [file delete core-makecore]
 } {1 1 1 {}}

+makeFile {
+    package require tcltest
+    namespace import ::tcltest::*
+    puts "=$::tcltest::parameters="
+    exit
+} args.tcl
+
+# -args
+test tcltest-11.1 {-args foo} {
+    catch {exec $::tcltest::tcltest args.tcl -args foo} msg
+    list $msg
+} {=foo=}
+
+test tcltest-11.2 {-args {}} {
+    catch {exec $::tcltest::tcltest args.tcl -args {}} msg
+    list $msg
+} {==}
+
+test tcltest-11.3 {-args {-foo bar -baz}} {
+    catch {exec $::tcltest::tcltest args.tcl -args {-foo bar -baz}} msg
+    list $msg
+} {{=-foo bar -baz=}}
+
 # Begin testing of tcltest procs ...

 # PrintError
-test tcltest-11.1 {PrintError} {
+test tcltest-20.1 {PrintError} {
    set result [catch {exec $::tcltest::tcltest printerror.tcl} msg]
    list $result [regexp "Error:  a really short string" $msg] \
 	    [regexp "     \"quotes\"" $msg] [regexp "    \"Path" $msg] \
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: timer.test,v 1.5 1999/06/26 20:55:15 rjohnson Exp $
+# RCS: @(#) $Id: timer.test,v 1.5.4.1 1999/09/22 04:12:58 hobbs Exp $

 if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
@@ -412,7 +412,7 @@ test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
    }
    set x "hello world"
    set id junk
-    set id [after 1 set x ab\0cd]
+    set id [after 10 set x ab\0cd]
    update
    set y [string length [lindex [lindex [after info $id] 0] 2]]
    foreach i [after info] {
@@ -12,7 +12,7 @@ item: Global
  Log Pathname=%MAINDIR%\INSTALL.LOG
  Message Font=MS Sans Serif
  Font Size=8
-  Disk Label=tcl8.2.0
+  Disk Label=tcl8.2.3
  Disk Filename=setup
  Patch Flags=0000000000000001
  Patch Threshold=85
@@ -1061,6 +1061,16 @@ item: Install File
  Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.0\msgcat.tcl
  Flags=0000000010000010
 end
+item: Install File
+  Source=${__TCLBASEDIR__}\library\tcltest1.0\pkgIndex.tcl
+  Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\pkgIndex.tcl
+  Flags=0000000000000010
+end
+item: Install File
+  Source=${__TCLBASEDIR__}\library\tcltest1.0\tcltest.tcl
+  Destination=%MAINDIR%\lib\tcl%VER%\tcltest1.0\tcltest.tcl
+  Flags=0000000000000010
+end
 item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
@@ -1138,7 +1148,7 @@ item: Install File
 end
 item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
-  Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
+  Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
  Flags=0000000010000010
 end
 item: Install File
@@ -1715,7 +1725,7 @@ item: Install File
 end
 item: Install File
  Source=${__TKBASEDIR__}\library\demos\twind.tcl
-  Destination=%MAINDIR%\lib\tk%VER%\demos\twin\released.tcl
+  Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
  Flags=0000000000000010
 end
 item: Install File
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.44 1999/08/11 20:51:54 redman Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.44.2.3 1999/10/30 11:09:43 hobbs Exp $

 VERSION 		= @TCL_VERSION@

@@ -64,9 +64,6 @@ MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
 # Tcl commands:
 MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann

-# Directory in which to install the include file tcl.h:
-INCLUDE_INSTALL_DIR = @includedir@
-
 # Package search path.
 TCL_PACKAGE_PATH	= @TCL_PACKAGE_PATH@

@@ -216,7 +213,7 @@ DLTEST_DIR =		@TCL_SRC_DIR@/unix/dltest
 # Must be absolute to so the corresponding tcltest's tcl_library is absolute.
 TCL_BUILDTIME_LIBRARY=  @TCL_SRC_DIR@/library

-#CC =			purify @CC@
+#CC =			purify -best-effort @CC@
 CC =			@CC@

 #----------------------------------------------------------------
@@ -431,6 +428,7 @@ tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}

 test: tcltest
 	LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+	LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
 	SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
 	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
 	./tcltest $(TOP_DIR)/tests/all.tcl
@@ -438,6 +436,7 @@ test: tcltest
 # Useful target to launch a built tcltest with the proper path,...
 runtest: tcltest
 	LD_LIBRARY_PATH=`pwd`:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH; \
+	LIBPATH=`pwd`:${LIBPATH}; export LIBPATH; \
 	SHLIB_PATH=`pwd`:${SHLIB_PATH}; export SHLIB_PATH; \
 	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
 	./tcltest
@@ -461,9 +460,10 @@ topDirName:
 gendate:
 	yacc -l $(GENERIC_DIR)/tclGetDate.y
 	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
-	    -e "s/SCCSID/RCS: @(#) \$Id\$"
+	    -e 's?SCCSID?RCS: @(#) $$Id: Makefile.in,v 1.44.2.3 1999/10/30 11:09:43 hobbs Exp $$?' \
 	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
 	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
+	    -e '/#include <inttypes.h>/d' \
 	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
 	rm y.tab.c

@@ -485,13 +485,13 @@ dltest/Makefile: $(DLTEST_DIR)/configure $(DLTEST_DIR)/Makefile.in tclConfig.sh
 	cd dltest; if test -f configure; then ./configure; else \
 	    $(DLTEST_DIR)/configure; fi

-install: all install-binaries install-libraries install-doc
+install: install-binaries install-libraries install-doc

 # Note: before running ranlib below, must cd to target directory because
 # some ranlibs write to current directory, and this might not always be
 # possible (e.g. if installing as root).

-install-binaries: 
+install-binaries: binaries
 	@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
 	    do \
 	    if [ ! -d $$i ] ; then \
@@ -521,7 +521,7 @@ install-binaries:
 			 $(LIB_INSTALL_DIR)/$(TCL_STUB_LIB_FILE); \
 	    fi

-install-libraries:
+install-libraries: libraries
 	@for i in $(INSTALL_ROOT)$(prefix)/lib $(INCLUDE_INSTALL_DIR) \
 		$(SCRIPT_INSTALL_DIR); \
 	    do \
@@ -565,7 +565,7 @@ install-libraries:
 		$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/encoding; \
 	done;

-install-doc:
+install-doc: doc
 	@chmod +x $(UNIX_DIR)/mkLinks
 	@for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \
 	    do \
@@ -1064,8 +1064,8 @@ dist: $(UNIX_DIR)/configure
 	cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
 	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
-	cp -p $(TOP_DIR)/changes $(TOP_DIR)/README* $(TOP_DIR)/license.terms \
-		$(DISTDIR)
+	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \
+		$(TOP_DIR)/license.terms $(DISTDIR)
 	mkdir $(DISTDIR)/library
 	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
 		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
@@ -578,7 +578,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	    ;;
 	AIX-*)
 	    SHLIB_CFLAGS=""
-	    SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512"
+	    SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
 	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
@@ -646,7 +646,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
 	    SHLIB_CFLAGS=""
 	    SHLIB_LD="ld -n32 -shared -rdata_shared"
-	    SHLIB_LD_LIBS=""
+	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
@@ -726,7 +726,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	    LDFLAGS="-Wl,-Bexport"
 	    LD_SEARCH_FLAGS=""
 	    ;;
-	NetBSD-*|FreeBSD-[[12]].*|OpenBSD-*)
+	NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*)
 	    # Not available on all versions:  check for include file.
 	    AC_CHECK_HEADER(dlfcn.h, [
 		SHLIB_CFLAGS="-fpic"
@@ -2,12 +2,12 @@ dnl	This file is an input file used by the GNU "autoconf" program to
 dnl	generate the file "configure", which is run during Tcl installation
 dnl	to configure the system for the local environment.
 AC_INIT(../generic/tcl.h)
-# RCS: @(#) $Id: configure.in,v 1.48 1999/08/11 22:48:09 wart Exp $
+# RCS: @(#) $Id: configure.in,v 1.48.2.3 1999/11/19 23:32:52 hobbs Exp $

 TCL_VERSION=8.2
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=2
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".3"
 VERSION=${TCL_VERSION}

 #------------------------------------------------------------------------
@@ -1,11 +1,11 @@
 # This Makefile is used to create several test cases for Tcl's load
 # command.  It also illustrates how to take advantage of configuration
 # exported by Tcl to set up Makefiles for shared libraries.
-# RCS: @(#) $Id: Makefile.in,v 1.5 1999/04/16 00:48:06 stanton Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.5.6.1 1999/09/22 04:13:07 hobbs Exp $

 TCL_DBGX =		@TCL_DBGX@
 CC = @CC@
-LIBS =			@TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@
+LIBS =			@TCL_BUILD_STUB_LIB_SPEC@ @TCL_LIBS@ -lc
 AC_FLAGS =		@EXTRA_CFLAGS@
 SHLIB_CFLAGS =		@SHLIB_CFLAGS@
 SHLIB_LD =		@SHLIB_LD@
@@ -578,7 +578,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	    ;;
 	AIX-*)
 	    SHLIB_CFLAGS=""
-	    SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512"
+	    SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
 	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
@@ -646,7 +646,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
 	    SHLIB_CFLAGS=""
 	    SHLIB_LD="ld -n32 -shared -rdata_shared"
-	    SHLIB_LD_LIBS=""
+	    SHLIB_LD_LIBS='${LIBS}'
 	    SHLIB_SUFFIX=".so"
 	    DL_OBJS="tclLoadDl.o"
 	    DL_LIBS=""
@@ -726,7 +726,7 @@ AC_DEFUN(SC_CONFIG_CFLAGS, [
 	    LDFLAGS="-Wl,-Bexport"
 	    LD_SEARCH_FLAGS=""
 	    ;;
-	NetBSD-*|FreeBSD-[[12]].*|OpenBSD-*)
+	NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*)
 	    # Not available on all versions:  check for include file.
 	    AC_CHECK_HEADER(dlfcn.h, [
 		SHLIB_CFLAGS="-fpic"
@@ -11,7 +11,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclUnixNotfy.c,v 1.5 1999/07/02 06:05:34 welch Exp $
+ * RCS: @(#) $Id: tclUnixNotfy.c,v 1.5.4.1 1999/10/30 11:09:45 hobbs Exp $
 */

 #include "tclInt.h"
@@ -719,15 +719,12 @@ Tcl_WaitForEvent(timePtr)
        waitingListPtr = tsdPtr;
 	tsdPtr->onList = 1;
 	
-	Tcl_MutexUnlock(&notifierMutex);
 	write(triggerPipe, "", 1);
-	Tcl_MutexLock(&notifierMutex);
    }

    memset((VOID *) tsdPtr->readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));

    if (!tsdPtr->eventReady) {
-
        Tcl_ConditionWait(&tsdPtr->waitCV, &notifierMutex, timePtr);
    }
    tsdPtr->eventReady = 0;
@@ -750,10 +747,7 @@ Tcl_WaitForEvent(timePtr)
        }
        tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
 	tsdPtr->onList = 0;
-        Tcl_MutexUnlock(&notifierMutex);
 	write(triggerPipe, "", 1);
-        Tcl_MutexLock(&notifierMutex);
-
    }

    
@@ -870,10 +864,18 @@ NotifierThreadProc(clientData)
    if (fcntl(receivePipe, F_SETFL, status) < 0) {
 	panic("NotifierThreadProc: could not make receive pipe non blocking.");
    }
+    status = fcntl(fds[1], F_GETFL);
+    status |= O_NONBLOCK;
+    if (fcntl(fds[1], F_SETFL, status) < 0) {
+	panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+    }
 #else
    if (ioctl(receivePipe, (int) FIONBIO, &status) < 0) {
 	panic("NotifierThreadProc: could not make receive pipe non blocking.");
    }
+    if (ioctl(fds[1], (int) FIONBIO, &status) < 0) {
+	panic("NotifierThreadProc: could not make trigger pipe non blocking.");
+    }
 #endif

    /*
@@ -10,7 +10,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclUnixPipe.c,v 1.3 1999/04/16 00:48:05 stanton Exp $
+ * RCS: @(#) $Id: tclUnixPipe.c,v 1.3.6.1 1999/10/30 11:09:45 hobbs Exp $
 */

 #include "tclInt.h"
@@ -333,7 +333,9 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
    TclFile errPipeIn, errPipeOut;
    int joinThisError, count, status, fd;
    char errSpace[200 + TCL_INTEGER_SPACE];
-    int pid;
+    Tcl_DString *dsArray;
+    char **newArgv;
+    int pid, i;
    
    errPipeIn = NULL;
    errPipeOut = NULL;
@@ -350,13 +352,20 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
 	goto error;
    }

+    /*
+     * We need to allocate and convert this before the (v)fork
+     * so it is properly deallocated later
+     */
+    dsArray = (Tcl_DString *) ckalloc(argc * sizeof(Tcl_DString));
+    newArgv = (char **) ckalloc((argc+1) * sizeof(char *));
+    newArgv[argc] = NULL;
+    for (i = 0; i < argc; i++) {
+	newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
+    }
+
    joinThisError = (errorFile == outputFile);
    pid = vfork();
    if (pid == 0) {
-	Tcl_DString *dsArray;
-	char *oldArgv0;
-	int i;
-
 	fd = GetFd(errPipeOut);

 	/*
@@ -370,8 +379,7 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
 			((dup2(1,2) == -1) ||
 			 (fcntl(2, F_SETFD, 0) != 0)))) {
 	    sprintf(errSpace,
-		    "%dforked process couldn't set up input/output: ",
-		    errno);
+		    "%dforked process couldn't set up input/output: ", errno);
 	    write(fd, errSpace, (size_t) strlen(errSpace));
 	    _exit(1);
 	}
@@ -381,22 +389,21 @@ TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile,
 	 */

 	RestoreSignals();
-	for (i = 0; argv[i] != NULL; i++) {
-	    /*
-	     * How many arguments?
-	     */
-	}
-	oldArgv0 = argv[0];
-	dsArray = (Tcl_DString *) ckalloc(i * sizeof(Tcl_DString));
-	for (i = 0; argv[i] != NULL; i++) {
-	    argv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
-	}
-	execvp(argv[0], argv);				/* INTL: Native. */
-	sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno,
-		oldArgv0);
+	execvp(newArgv[0], newArgv);			/* INTL: Native. */
+	sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
 	write(fd, errSpace, (size_t) strlen(errSpace));
 	_exit(1);
    }
+    
+    /*
+     * Free the mem we used for the fork
+     */
+    for (i = 0; i < argc; i++) {
+	Tcl_DStringFree(&dsArray[i]);
+    }
+    ckfree((char *) dsArray);
+    ckfree((char *) newArgv);
+
    if (pid == -1) {
 	Tcl_AppendResult(interp, "couldn't fork child process: ",
 		Tcl_PosixError(interp), (char *) NULL);
@@ -9,7 +9,7 @@
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
- * RCS: @(#) $Id: tclUnixTest.c,v 1.10 1999/04/16 00:48:05 stanton Exp $
+ * RCS: @(#) $Id: tclUnixTest.c,v 1.10.6.1 1999/10/30 11:09:45 hobbs Exp $
 */

 #include "tclInt.h"
@@ -465,6 +465,9 @@ TestfindexecutableCmd(clientData, interp, argc, argv)
 	Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
 	ckfree(tclExecutableName);
    }
+    if (tclNativeExecutableName != NULL) {
+	ckfree(tclNativeExecutableName);
+    }

    tclExecutableName       = oldName;
    tclNativeExecutableName = oldNativeName;
@@ -1,11 +1,11 @@
-Tcl/Tk 8.2b2 for Windows, Binary Distribution
+Tcl/Tk 8.2 for Windows, Binary Distribution

-RCS: @(#) $Id: README.binary,v 1.10 1999/08/10 23:16:27 redman Exp $ 
+RCS: @(#) $Id: README.binary,v 1.10.2.3 1999/11/19 23:32:55 hobbs Exp $ 

 1. Introduction
 --------------- 

-This directory contains the binary distribution of Tcl/Tk 8.2.0 for
+This directory contains the binary distribution of Tcl/Tk 8.2.3 for
 Windows.  It was compiled with Microsoft Visual C++ 5.0 using Win32
 API, so that it will run under Windows NT, Windows 95, and Windows 98.

@@ -32,7 +32,7 @@ Information about new features in Tcl/Tk 8.2 can be found at
    http://www.scriptics.com/software/whatsnew82.html

 Detailed release notes can be found at
-    http://www.scriptics.com/software/relnotes/tcl8.2.0
+    http://www.scriptics.com/software/relnotes/tcl8.2.3

 Information about Tcl itself can be found at
    http://www.scriptics.com/scripting/
@@ -2,14 +2,14 @@
 # generate the file "configure", which is run during Tcl installation
 # to configure the system for the local environment.
 #
-# RCS: @(#) $Id: configure.in,v 1.13 1999/08/10 23:16:27 redman Exp $
+# RCS: @(#) $Id: configure.in,v 1.13.2.3 1999/11/19 23:32:55 hobbs Exp $

 AC_INIT(../generic/tcl.h)

 TCL_VERSION=8.2
 TCL_MAJOR_VERSION=8
 TCL_MINOR_VERSION=2
-TCL_PATCH_LEVEL=".0"
+TCL_PATCH_LEVEL=".3"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

 #--------------------------------------------------------------------
@@ -10,7 +10,7 @@
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * Changes by Rolf.Schroedter@dlr.de June 25-27, 1999
 *
- * RCS: @(#) $Id: tclWinSerial.c,v 1.7 1999/08/12 17:38:49 redman Exp $
+ * RCS: @(#) $Id: tclWinSerial.c,v 1.7.2.1 1999/09/24 22:49:14 hobbs Exp $
 */

 #include "tclWinInt.h"
@@ -130,10 +130,10 @@ static int      SerialOutputProc(ClientData instanceData, char *buf,
 static void     SerialSetupProc(ClientData clientData, int flags);
 static void     SerialWatchProc(ClientData instanceData, int mask);
 static void     ProcExitHandler(ClientData clientData);
-static int       SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
+static int	SerialGetOptionProc _ANSI_ARGS_((ClientData instanceData,
                Tcl_Interp *interp, char *optionName,
                Tcl_DString *dsPtr));
-static int       SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
+static int	SerialSetOptionProc _ANSI_ARGS_((ClientData instanceData,
                Tcl_Interp *interp, char *optionName,
                char *value));

@@ -1008,7 +1008,7 @@ SerialSetOptionProc(instanceData, interp, optionName, value)
 	return Tcl_BadChannelOption(interp, optionName,
 		"mode pollinterval");
    }
-    return TCL_ERROR;
+    return TCL_OK;
 }

 /*
Author	SHA1	Message	Date
cvs	778522c2ea	Creating branch scriptics-sc-1-1-branch	1999-11-19 23:32:56 +00:00
hobbs	2507424091	* README: * generic/tcl.h: * unix/configure.in: * win/configure.in: * win/README.binary: updated to patchlevel 3	1999-11-19 23:32:52 +00:00
hobbs	9360b0c07e	* tools/tcl.wse.in: updated to patchlevel 3, as well as making sure tcltest1.0 is installed, and koi-r encoding is installed correctly	1999-11-19 23:32:40 +00:00
hobbs	d7e84a0d1c	* tests/http.test: updated http package to 2.2 * doc/http.n: * library/http2.1/http.tcl: added register and unregister commands to http:: package (better support for tls/SSL), as well as -type argument to http::geturl. [RFE: 2617] * library/http2.1/http.tcl: Correctly fixed the -timeout problem mentioned in the 10-29 change. Also added error handling for failed writes on the socket during the protocol.	1999-11-19 23:32:24 +00:00
hobbs	327e02ad1c	* generic/tclCkalloc.c: fixed Tcl_DbCkfree to return a value on NULL input. [Bug: 3400] * generic/tclStringObj.c: fixed support for passing in negative length to Tcl_SetUnicodeObj, et al handling routines. [Bug: 3380] * tests/http.test: updated http package to 2.2 * doc/http.n: * library/http2.1/http.tcl: added register and unregister commands to http:: package (better support for tls/SSL), as well as -type argument to http::geturl. [RFE: 2617] * library/http2.1/http.tcl: Correctly fixed the -timeout problem mentioned in the 10-29 change. Also added error handling for failed writes on the socket during the protocol. * generic/tclBasic.c: removed extra decr of numLevels in Tcl_EvalObjEx that could cause seg fault. (mjansen@wendt.de) * generic/tclEvent.c: fixed possible lack of MutexUnlock in Tcl_DeleteExitHandler [Bug: 3545]	1999-11-19 23:32:02 +00:00
hobbs	559ad7b58b	* tests/http.test: updated http package to 2.2 * doc/http.n: * library/http2.1/http.tcl: added register and unregister commands to http:: package (better support for tls/SSL), as well as -type argument to http::geturl. [RFE: 2617] * library/http2.1/http.tcl: Correctly fixed the -timeout problem mentioned in the 10-29 change. Also added error handling for failed writes on the socket during the protocol.	1999-11-19 23:31:46 +00:00
hobbs	0d7201ef81	updated for 8.2.3	1999-11-19 23:31:25 +00:00
hobbs	72aebeb0e0	* library/dde1.1/pkgIndex.tcl: * library/reg1.0/pkgIndex.tcl: fixed packaging to use the debug versions of the libraries when compiled with symbols [Bug: 3254]	1999-11-03 02:00:43 +00:00
hobbs	3043b7b021	see log	1999-11-03 02:00:06 +00:00
hobbs	3f916836f0	updated for 8.2.2 release	1999-11-03 00:42:06 +00:00
hobbs	d5aa5663f3	see log	1999-11-02 22:01:08 +00:00
hobbs	7fbc352012	* tests/reg.test: updated to Henry Spencer's new regexp engine (mid-Sept 99). Should greatly reduce stack space reqs.	1999-11-02 02:10:05 +00:00
hobbs	9e26d55149	* generic/regc_color.c: * generic/regc_cvec.c: * generic/regc_lex.c: * generic/regc_locale.c: * generic/regcomp.c: * generic/regcustom.h: * generic/regerrs.h: * generic/regex.h: * generic/regexec.c: * generic/regguts.h: * generic/tclRegexp.c: * generic/tclTest.c: * tests/reg.test: updated to Henry Spencer's new regexp engine (mid-Sept 99). Should greatly reduce stack space reqs.	1999-11-02 02:09:47 +00:00
hobbs	b6a5656b86	see log	1999-11-02 02:09:37 +00:00
hobbs	a749ffc6bb	updated for patchlevel 2	1999-10-30 11:09:57 +00:00
hobbs	fd533c1ea0	* unix/Makefile.in: purify has to use -best-effort to instrument * unix/tclUnixPipe.c: fixed mem leak in TclpCreateProcess when doing alloc between vfork and execvp. * unix/tclUnixTest.c: fixed mem leak in findexecutable test command * unix/tclUnixNotfy.c: fixed event/io threading problems by making triggerPipe non-blocking	1999-10-30 11:09:43 +00:00
hobbs	997d8bc95b	* tools/tcl.wse.in: made demos\twind.tcl install in correct place	1999-10-30 11:09:16 +00:00
hobbs	9a22a7fb98	* tests/string.test: * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when indexing into one (test case string-5.16) [Bug: 2871] * tests/incr.test: * tests/set.test: * generic/tclCompCmds.c: fixed improper bytecode handling of 'eval {set array($unknownvar) 5}' (also for incr)	1999-10-30 11:07:53 +00:00
hobbs	e50a4ccd52	* library/tcltest1.0/tcltest.tcl: * generic/tclThreadTest.c: fixed mem leaks in threads	1999-10-30 11:07:05 +00:00
hobbs	026affa06c	* library/http2.1/http.tcl: protected gets with catch [Bug: 2665] Fixed a bug in the handling of the state(status) variable when the -timeout flag is specified. Previously it was possible to leave the status undefined instead of empty, which caused errors in http::status	1999-10-30 11:06:30 +00:00
hobbs	cee92d2123	* library/init.tcl: removed [info nameof]/../bin from auto_path	1999-10-30 11:06:17 +00:00
hobbs	ab02c72438	* generic/tcl.h: updated to patchlevel 2 * generic/tclCmdMZ.c: fixed [string index] to return ByteArrayObj when indexing into one (test case string-5.16) [Bug: 2871] * tests/incr.test: * tests/set.test: * generic/tclCompCmds.c: fixed improper bytecode handling of 'eval {set array($unknownvar) 5}' (also for incr) * generic/tclThreadTest.c: fixed mem leaks in threads * generic/tclStringObj.c: fixed Tcl_AppendStringsToObjVA and * generic/tclResult.c: fixed Tcl_AppendResultVA to only iterates once over the va_list (avoiding a memcpy of it, which is not portable). * generic/tclCompile.c: removed savedChar trick that appeared to be causing a segv when the literal table was released * generic/tclEnv.c: fixed mem leak with putenv and DStrings and fixed possible ABR error in environ array	1999-10-30 11:05:57 +00:00
hobbs	33ecba92bf	see log	1999-10-30 11:05:14 +00:00
jenn	cc6438765e	* library/tcltest1.0/pkgIndex.tcl: Removed nonexistent procs from pkgIndex.tcl. * library/tcltest1.0/tcltest.tcl: Fixed the way that the interactive constraint is set so that it checks the content of the tcl_interactive flag as well as its existence, and removed the extra return at the end of tcltest.tcl.	1999-10-20 01:21:11 +00:00
hobbs	5266850d3a	1999-10-01 Jeff Hobbs <hobbs@scriptics.com> * All frozen for 10/4/99 8.2.1 release * changes: updated from ChangeLog * unix/Makefile.in: added ChangeLog to source dist	1999-10-02 01:09:51 +00:00
hobbs	de292a9d9f	updated patchlevel to 1	1999-09-30 21:26:58 +00:00
hobbs	36336894ed	fixed possible ref to global 'c' var in namespace init code	1999-09-30 02:05:53 +00:00
jenn	6051e0b7f6	* library/tcltest1.0/tcltest.tcl: Changed checks for value of tcl_interactive to checks for existence of tcl_interactive.	1999-09-25 02:12:10 +00:00
hobbs	90cbff24c4	1999-09-24 Jeff Hobbs <hobbs@scriptics.com> * mac/tclMacFCmd.c: fixed filename stuff to support UTF-8 [Bug: 2869] * win/tclWinSerial.c: changed SerialSetOptionProc to return TCL_OK by default. (patch from Rolf Schroedter)	1999-09-24 22:49:09 +00:00
hobbs	200423b2be	1999-09-23 Jeff Hobbs <hobbs@scriptics.com> * README: * generic/tcl.h: * tools/tcl.wse.in: updated text to reflect 8.2.1 where necessary	1999-09-24 02:01:41 +00:00
jenn	382dc12d62	* tests/tcltest.test: Added 'exit' calls to the scripts that the test creates and added tests for -tmpdir and -args. * tests/env.test: * tests/exec.test: Added 'exit' calls to scripts that the tests themselves write. * tests/README: Cleaned up documentation in README so that it refers to variables and documentation that actually exist. Also added missing documentation for flag usage.	1999-09-22 21:06:14 +00:00
jenn	9454094a1f	* library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a variable named ::tcltest::parameters based on whatever's being sent in as the argument to the -args flag. Modified tcltest so that tcltest namespace variables are only initialized to their default values if they did not previously exist. Modified the ::tcltest::testConstraints variable so that it isn't unset every time ::tcltest::initConstraints is called. Modified command line processing so that they are only processed if ::tcltest doesn't have a child namespace (if there is a child namespace, then the command line arguments must be processed in that namespace).	1999-09-22 21:05:50 +00:00
jenn	7552a963ef	* tests/tcltest.test: Added 'exit' calls to the scripts that the test creates and added tests for -tmpdir and -args. * tests/env.test: * tests/exec.test: Added 'exit' calls to scripts that the tests themselves write. * tests/README: Cleaned up documentation in README so that it refers to variables and documentation that actually exist. Also added missing documentation for flag usage. * library/tcltest1.0/tcltest.tcl: Added a -args flag that sets a variable named ::tcltest::parameters based on whatever's being sent in as the argument to the -args flag. Modified tcltest so that tcltest namespace variables are only initialized to their default values if they did not previously exist. Modified the ::tcltest::testConstraints variable so that it isn't unset every time ::tcltest::initConstraints is called. Modified command line processing so that they are only processed if ::tcltest doesn't have a child namespace (if there is a child namespace, then the command line arguments must be processed in that namespace).	1999-09-22 21:05:40 +00:00
hobbs	de797a1c88	1999-09-21 Jeff Hobbs <hobbs@scriptics.com> * tests/env.test: * unix/Makefile.in: added support for AIX LIBPATH env var [Bug: 2793] removed second definition of INCLUDE_INSTALL_DIR (the one that referenced @includedir@) [Bug: 2805] * unix/dltest/Makefile.in: added -lc to LIBS [Bug: 2794] * tests/timer.test: changed after delay in timer test 6.29 from 1 to 10. [Bug: 2796] * tests/pkg.test: * generic/tclPkg.c: fixed package version check to disallow 1.2..3 [Bug: 2539] * unix/Makefile.in: fixed gendate target - this never worked since RCS was intro'd. * generic/tclGetDate.y: updated to reflect previous changes to tclDate.c (leap year calc) and added CEST and UCT time zone recognition. Fixed 4 missing UCHAR() casts. [Bug: 2717, 954, 1245, 1249] * generic/tclCkalloc.c: changed Tcl_DumpActiveMemory to really dump to stderr and close it [Bug: 725] and changed Tcl_Ckrealloc and Tcl_Ckfree to not bomb when NULL was passed in [Bug: 1719] and changed Tcl_Alloc, et al to not panic when a alloc request for zero came through and NULL was returned (valid on AIX, Tru64) [Bug: 2795, etc] * generic/tclIOCmd.c: fixed potential core dump in conjunction with stacked channels with result obj manipulation in Tcl_ReadChars [Bug: 2623] * tests/format.test: * generic/tclCmdAH.c: fixed translation of %0#s in format [Bug: 2605] * tests/set-old.test: * generic/tclVar.c: Added fix in TclArraySet to check when trying to set in a non-existent namespace. [Bug: 2613] * tests/linsert.test: * generic/tclCmdIL.c: fixed end-int interpretation of linsert to correctly calculate value for end, added test and docs [Bug: 2693] * doc/switch.n: added proper use of comments to example. * generic/tclCmdMZ.c: changed switch to complain when an error occurs that seems to be due to a misplaced comment. * generic/tclCmdMZ.c: fixed illegal ref for \[0-9] substitutions in regsub [Bug: 2723] * generic/tclCmdMZ.c: changed [string equal] to return an Int type object (was a Boolean) * generic/tclParseExpr.c: changed '"' to '\"' to make FreeBSD happy [Bug: 2625] * generic/tclProc.c: moved static buf to better location and changed static msg that would overflow in ProcessProcResultCode [Bug: 2483] and added Tcl_DStringFree to Tcl_ProcObjCmd. Also reworked size of static buffers. * tests/stringObj.test: added test 9.11 * generic/tclStringObj.c: changed Tcl_AppendObjToObj to properly handle the 1-byte dest and mixed src case where both had had Unicode string len checks made on them. [Bug: 2678] * unix/aclocal.m4: * unix/tcl.m4: added -bnoentry to the AIX-* case [Bug: 1909] added fix for FreeBSD-[1-2] recognition [Bug: 2070] and fix for IRIX SHLIB_LB_LIBS. [Bug: 2610] * generic/tclPosixStr.c: fixed typo [Bug: 2592] * win/README.binary: fixed version info and some typos [Bug: 2561] * generic/tclIO.c: changed Tcl_GetChannelNames* to use style guide headers (pleases HP cc) * tests/expr.test: * generic/tclCompile.c: add TCL_TOKEN_VARIABLE to the part types that cause differed compilation for exprs, to correct the expr double-evaluation problem for vars. Added test cases. Related to [Bug: 732]	1999-09-22 04:12:37 +00:00