2012-05-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c:	When using Tcl_SetObjLength() calls to grow
	* generic/tclPathObj.c:	and shrink the objPtr->bytes buffer, care must be
	taken that the value cannot possibly become pure Unicode.  Calling
	Tcl_AppendToObj() has the possibility of making such a conversion.  Bug
	found while valgrinding the trunk.

2012-05-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:      TIP #106: Add Encoding Abilities to the [dde]
	* library/dde/pkgIndex.tcl:   Command. Dde version is now 1.4.0.
	* tests/winDde.test:
	* doc/dde.n:

2012-05-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
	the amount of hackiness in class constructors, and refactor some of
	the error message handling from [oo::define] to be saner in the face
	of odd happenings.

2012-05-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
	resulting indexes from -indexvar option to be usable with [string
	range]; this was always the intention (and is consistent with [regexp
	-indices] too).
	***POTENTIAL INCOMPATIBILITY***
	Uses of [switch -regexp -indexvar] that previously compensated for the
	wrong offsets (by subtracting 1 from the end indices) now do not need
	to do so as the value is correct.

	* library/safe.tcl (safe::InterpInit): Ensure that the module path is
	constructed in the correct order.
	(safe::AliasGlob): [Bug 2964715]: More extensive handling of what
	globbing is required to support package loading.

	* doc/expr.n: [Bug 3525462]: Corrected statement about what happens
	when comparing "0y" and "0x12"; the previously documented behavior was
	actually a subtle bug (now long-corrected).

2012-05-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3445787]: Improve
	the compatibility of safe interpreters' version of 'file' with that of
	unsafe interpreters.
	* library/safe.tcl (::safe::InterpInit): Teach the safe-interp scripts
	about how to expose 'file' properly.

2012-05-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:   Protect against receiving strings without ending
	\0, as external applications (or Tcl with TIP #106) could generate
	that.

2012-05-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:    [Bug 473946]: special characters not correctly sent
	* library/dde/pkgIndex.tcl  Increase version to 1.3.3
	* win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent
	* library/dde/pkgIndex.tcl:  Increase version to 1.3.3

2012-05-10  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* {win,unix}/configure{,.in} [Bug 2812981]: Clean up bundled
	* {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled
	packages' build directory from within Tcl's ./configure, to avoid
	stale configuration.

2012-05-09  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c [Bug 3522560]: Fixed the crash, enabled the
	test case. Modified [chan postevent] to properly inject the
	event(s) into the owner thread's event queue for execution in the
	correct context. Renamed the ForwardOpTo...Thread() function to
	match with our terminology.
	

	* tests/ioCmd.test [Bug 3522560]: Added a test which crashes the
	core if it were not disabled as knownBug. For a reflected channel
	transfered to a different thread the [chan postevent] run in the
	handler thread tries to execute the owner threads's fileevent
	scripts by itself, wrongly reaching across thread boundaries.

2012-04-28  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: Properly close nonblocking channels even when
	not flushing them.

2012-05-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/*:      Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
	* compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
	will be upgraded as soon as the official build is available)

2012-05-03  Don Porter  <dgp@users.sourceforge.net>

	* tests/socket.test:	[Bug 3428754] Test socket-14.2 tolerate
	* tests/socket.test:	[Bug 3428754]: Test socket-14.2 tolerate
	[socket -async] connection that connects synchronously.

	* unix/tclUnixSock.c:	[Bug 3428753] Fix [socket -async] connections
	* unix/tclUnixSock.c:	[Bug 3428753]: Fix [socket -async] connections
	that manage to connect synchronously.

2012-05-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/configure.in:    Better detection and implementation for cpuid
	* generic/configure:       instruction on Intel-derived processors, both
	* generic/tclUnixCompat.c: 32-bit and 64-bit.
	* generic/tclTest.c:       Move cpuid testcase from win-specific to generic
	* win/tclWinTest.c:        tests, as it should work on all Intel-related
	* tests/platform.test:     platforms now
	* generic/configure.in:    Better detection and implementation for
	* generic/configure:       cpuid instruction on Intel-derived
	* generic/tclUnixCompat.c: processors, both 32-bit and 64-bit.
	* generic/tclTest.c:       Move cpuid testcase from win-specific to
	* win/tclWinTest.c:        generic tests, as it should work on all
	* tests/platform.test:     Intel-related platforms now.

2012-04-30  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/ioCmd.test: Tame deadlocks in broken refchan tests [Bug 3522560]
	* tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan
	tests.

2012-04-28  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	IMPLEMENTATION OF TIP#398

	* generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
	* tests/io.test  : *** POTENTIAL INCOMPATIBILITY ***

	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	   Tcl_DStringFree(&ds);
	with this:
	   obj=TclDStringToObj(&ds);

2012-04-24  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:      [Bug 3508771] load tclreg.dll in cygwin tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, TclWinGetServByName
	* generic/tclStubInit.c:     and TclWinCPUID for Cygwin
	* generic/tclUnixCompat.c:
	* generic/tclInt.decls:      [Bug 3508771]: load tclreg.dll in cygwin
				     tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt,
	* generic/tclStubInit.c:     TclWinGetServByName and TclWinCPUID for
	* generic/tclUnixCompat.c:   Cygwin.
	* unix/configure.in:
	* unix/configure:
	* unix/tclUnixCompat.c:

2012-04-18  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Casablanca:

	not when a path doesn't exist or a dictionary is poorly formatted (the
	two cases can't be easily distinguished).

2012-01-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:        [Bug 3474726]: Eliminate detection of struct
	* generic/tclWinPort.h: _stat32i64, just use _stati64 in combination
	* generic/tclFCmd.c:    with _USE_32BIT_TIME_T, which is the same then.
	* generic/tclTest.c:    Only keep _stat32i64 usage for cygwin, so it
	* win/configure.in:     will not conflict with cygwin's own struct stat.
	* win/configure:
	* generic/tclFCmd.c:    with _USE_32BIT_TIME_T, which is the same
	* generic/tclTest.c:    then. Only keep _stat32i64 usage for cygwin,
	* win/configure.in:     so it will not conflict with cygwin's own
	* win/configure:	struct stat.

2012-01-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c:	[Bug 3475667]: Prevent buffer read overflow.
	Thanks to "sebres" for the report and fix.

2012-01-17  Donal K. Fellows  <dkf@users.sf.net>

2012-01-12  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tclvars.n: [Bug 3466506]: Document more environment variables.

2012-01-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUtf.c:      [Bug 3464428]: string is graph \u0120 is wrong
	* generic/regc_locale.c: Add table for Unicode [:cntrl:] class
	* tools/uniClass.tcl:    Generate Unicode [:cntrl:] class table
	* generic/tclUtf.c:      [Bug 3464428]: [string is graph \u0120] was
	* generic/regc_locale.c: wrong. Add table for Unicode [:cntrl:] class.
	* tools/uniClass.tcl:    Generate Unicode [:cntrl:] class table.
	* tests/utf.test:

2012-01-08  Kevin B. Kenny  <kennykb@acm.org>

	* library/clock.tcl (ReadZoneinfoFile): [Bug 3470928]: Corrected a bug
	* tests/clock.test (clock-56.4):        where loading zoneinfo would
	fail if one timezone abbreviation was a proper tail of another, and

	* library/tzdata/Europe/Simferopol
	* library/tzdata/Europe/Uzhgorod
	* library/tzdata/Europe/Zaporozhye
	* library/tzdata/Pacific/Fiji

2011-12-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUtf.c:     [Bug 3464428]: string is graph \u0120 is wrong.
	* generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong.
	* generic/tclUniData.c:
	* generic/regc_locale.c:
	* tests/utf.test:
	* tools/uniParse.tcl:   Clean up some unused stuff, and be more robust
	against changes in UnicodeData.txt syntax

2011-12-13  Andreas Kupries  <andreask@activestate.com>

2011-06-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclLink.c:	[Bug 3317466]: Prevent multiple links to a
	single Tcl variable when calling Tcl_LinkVar().

2011-06-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStrToD.c:  [Bug 3315098]: Mem leak fix from Gustaf Neumann.
	* generic/tclStrToD.c:  [Bug 3315098]: Mem leak fix from Gustaf
	Neumann.

2011-06-08  Andreas Kupries  <andreask@activestate.com>

	* generic/tclExecute.c: Reverted the fix for [Bug 3274728] committed
	on 2011-04-06 and replaced with one which is 64bit-safe. The existing
	fix crashed tclsh on Windows 64bit.

	* doc/RegExp.3: [Bug 3165108]: Corrected documentation of description
	of subexpression info in Tcl_RegExpInfo structure.

2011-01-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPreserve.c:  Don't miss 64-bit address bits in panic
				  message.
	* win/tclWinChan.c:       Fix various gcc-4.5.2 64-bit warning messages
	* win/tclWinConsole.c     e.g. by using full 64-bits for socket fd's
	* win/tclWinDde.c
	* win/tclWinChan.c:       Fix various gcc-4.5.2 64-bit warning
	* win/tclWinConsole.c:    messages, e.g. by using full 64-bits for
	* win/tclWinDde.c:	  socket fd's
	* win/tclWinPipe.c
	* win/tclWinReg.c
	* win/tclWinSerial.c
	* win/tclWinSock.c
	* win/tclWinThrd.c

2011-01-19  Jan Nijtmans  <nijtmans@users.sf.net>

2010-11-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer
	* win/cat.c:       to reality. See for what's missing:
	* win/tcl.m4:      <https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps>
	* win/configure:   (re-generated)
	* win/tclWinPort.h:[Bug #3110161]: Extensions using TCHAR don't compile
	on VS2005 SP1
	* win/tclWinPort.h: [Bug #3110161]: Extensions using TCHAR don't
	compile on VS2005 SP1

2010-11-15  Andreas Kupries  <andreask@activestate.com>

	* doc/interp.n: [Bug 3081184]: TIP #378.
	* doc/tclvars.n: Performance fix for TIP #280.
	* generic/tclBasic.c:
	* generic/tclExecute.c:

	[fconfigure -sockname] and [fconfigure -peername] from doing
	reverse DNS queries.

2010-10-24  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]
	* generic/tclAssembly.c:
	* tests/assembly.test (assemble-17.15): Reworked branch handling so that
	forward branches can use jump1 (jumpTrue1, jumpFalse1). Added test
	cases that the forward branches will expand to jump4, jumpTrue4,
	* tests/assembly.test (assemble-17.15): Reworked branch handling so
	that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added
	test cases that the forward branches will expand to jump4, jumpTrue4,
	jumpFalse4 when needed.

2010-10-23  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]
	* generic/tclAssembly.h (removed):
				Removed file that was included in only one

2010-10-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:    [FRQ 2965056]: Windows build with -DUNICODE
	* win/tclWinReg.c:
	* win/tclWinTest.c:   More cleanups
	* win/tclWinFile.c:   Add netapi32 to the link line, so we no longer
	* win/tcl.m4:         have to use LoadLibrary to access those functions.
	* win/tcl.m4:         have to use LoadLibrary to access those
			      functions.
	* win/makefile.vc:
	* win/configure:      (Re-generate with autoconf-2.59)
	* win/rules.vc        Update for VS10

2010-10-09  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due

	implementation on what to do with the obsolete internal stub for
	TclBackgroundException() (eliminate it!)
	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2010-07-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:  [Bug 803489]: Tcl_FindNamespace problem in the
	* generic/tclIntDecls.h: Stubs table
	* generic/tclInt.decls:  [Bug 803489]: Tcl_FindNamespace problem in
	* generic/tclIntDecls.h: the Stubs table
	* generic/tclStubInit.c:

2010-07-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made
	sure that errors caused by an argument to an operator being outside
	the domain of the operator all result in ::errorCode being ARITH

	from:
		typedef unsigned long mp_digit;
	to:
		typedef unsigned int mp_digit;
	For 32-bit builds where "long" and "int" are two names for the same
	thing, this is no change at all.  For 64-bit builds, though, this
	causes the dp[] array of an mp_int to be made up of 32-bit elements
	instead of 64-bit elements.  This is a huge improvement because details
	elsewhere in the mp_int implementation cause only 28 bits of each
	element to be actually used storing number data.  Without this change
	bignums are over 50% wasted space on 64-bit systems.  [Bug 2800740].
	instead of 64-bit elements.  This is a huge improvement because
	details elsewhere in the mp_int implementation cause only 28 bits of
	each element to be actually used storing number data.  Without this
	change bignums are over 50% wasted space on 64-bit systems.  [Bug
	2800740].

	***POTENTIAL INCOMPATIBILITY***
	For 64-bit builds, callers of routines with (mp_digit) or (mp_digit *)
	arguments *will*, and callers of routines with (mp_int *) arguments
	*may* suffer both binary and stubs incompatibilities with Tcl releases
	8.5.0 - 8.5.7.  Such possibilities should be checked, and if such
	incompatibilities are present, suitable [package require] requirements

	(Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared):
	[Bug 2871908]: Enforce separation of concerns between the lineCLPtr
	and objThreadMap thread specific data members.

2009-10-18  Joe Mistachkin  <joe@mistachkin.com>

	* tests/thread.test (thread-4.[345]): [Bug 1565466]: Correct tests to
	save their error state before the final call to threadReap just in case
	it triggers an "invalid thread id" error.  This error can occur if one
	or more of the target threads has exited prior to the attempt to send
	it an asynchronous exit command.
	save their error state before the final call to threadReap just in
	case it triggers an "invalid thread id" error.  This error can occur
	if one or more of the target threads has exited prior to the attempt
	to send it an asynchronous exit command.

2009-10-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c (UnsetVarStruct, TclDeleteNamespaceVars)
	(TclDeleteCompiledLocalVars, DeleteArray):
	* generic/tclTrace.c (Tcl_UntraceVar2): [Bug 2629338]: Stop traces
	that are deleted part way through (a feature used by tdom) from

work on.  The \fIdata\fR field is given to the remote application.
Typically, the application treats the \fIdata\fR field as a script, and the
script is run in the application.  The \fB\-async\fR option requests
asynchronous invocation.  The command returns an error message if the
script did not run, unless the \fB\-async\fR flag was used, in which case
the command returns immediately with no error.
.VS 8.6
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
string is sent.  Combining \fB-binary\fR with the result of
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise a
unicode string is sent.
\fBencoding convertto\fR may be used to send data in arbitrary encodings.
.VE 8.6
.TP
\fBdde poke ?\fB\-binary\fR? \fIservice topic item data\fR
.
\fBdde poke\fR passes the \fIdata\fR to the server indicated by
\fIservice\fR using the \fItopic\fR and \fIitem\fR specified.  Typically,
\fIservice\fR is the name of an application.  \fItopic\fR is application
specific but can be a command to the server or the name of a file to work
on.  The \fIitem\fR is also application specific and is often not used, but
it must always be non-null.  The \fIdata\fR field is given to the remote
application.
.VS 8.6
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
string is sent.
The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise a
unicode string is sent.
.VE 8.6
.TP
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.
\fBdde request\fR is typically used to get the value of something; the
value of a cell in Microsoft Excel or the text of a selection in
Microsoft Word. \fIservice\fR is typically the name of an application,

.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
String values may be used as operands of the comparison operators,
although the expression evaluator tries to do comparisons as integer
or floating-point when it can,
i.e., when all arguments to the operator allow numeric interpretations,
except in the case of the \fBeq\fR and \fBne\fR operators.
If one of the operands of a comparison is a string and the other
has a numeric value, a canonical string representation of the numeric
operand value is generated to compare with the string operand.
Canonical string representation for integer values is a decimal string
format.  Canonical string representation for floating-point values
is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.  For example, the commands
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
\fBexpr\fR {"0y" < "0x12"}
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
both return 1.  The first comparison is done using integer
comparison, and the second is done using string comparison after
comparison, and the second is done using string comparison.
the second operand is converted to the string \fB18\fR.
Because of Tcl's tendency to treat values as numbers whenever
possible, it is not generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
operands could be arbitrary;  it is better in these cases to use
the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP

declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}

################################
# Mac OS X specific functions

declare 0 {unix macosx} {
declare 0 macosx {
    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
	    const char *bundleName, int hasResourceFile,
	    int maxPathLen, char *libraryPath)
}
declare 1 {unix macosx} {
declare 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, int maxPathLen, char *libraryPath)
}

##############################################################################

static Tcl_NRPostProc	ForSetupCallback;
static Tcl_NRPostProc	ForCondCallback;
static Tcl_NRPostProc	ForNextCallback;
static Tcl_NRPostProc	ForPostNextCallback;
static Tcl_NRPostProc	ForeachLoopStep;
static Tcl_NRPostProc	EvalCmdErrMsg;

static Tcl_ObjCmdProc	BadFileSubcommand;
static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc FileAttrIsExistingCmd;
static Tcl_ObjCmdProc FileAttrIsFileCmd;
static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc FileAttrIsReadableCmd;

	    Tcl_DStringFree(&ds);
	}

	Tcl_FreeEncoding(encoding);
	break;
    }
    case ENC_DIRS:
	return EncodingDirsObjCmd(dummy, interp, objc-1, objv+1);
	return EncodingDirsObjCmd(dummy, interp, objc, objv);
    case ENC_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_GetEncodingNames(interp);
	break;

int
EncodingDirsObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc > 2) {
    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
	return TCL_ERROR;
    }
    objc -= 1;
    objv += 1;
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
	return TCL_OK;
    }
    if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) {
	Tcl_AppendResult(interp, "expected directory list but got \"",
		TclGetString(objv[1]), "\"", NULL);

	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
		Tcl_Panic("problem making 'file %s' safe: %s",
			unsafeInfo[i].cmdName,
			Tcl_GetString(Tcl_GetObjResult(interp)));
	    }
	    Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
		    (ClientData) unsafeInfo[i].cmdName, NULL);
	}
    }
    Tcl_DStringFree(&oldBuf);
    Tcl_DStringFree(&newBuf);

    /*
     * Ugh. The [file] command is now actually safe, but it is assumed by
     * scripts that it is not, which messes up security policies. [Bug
     * 3211758]
     */

    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
	Tcl_Panic("problem making 'file' safe: %s",
		Tcl_GetString(Tcl_GetObjResult(interp)));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadFileSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	"file" are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is always the full official subcommand name.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadFileSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *subcommandName = (const char *) clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of file", subcommandName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See

	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
		rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
		    rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
		    rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
		} else {
		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, indicesObj,
			Tcl_NewListObj(2, rangeObjAry));

    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    length++;
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    length++;
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

}, clsMethods[] = {
    DCM("create", 1,	TclOO_Class_Create),
    DCM("new", 1,	TclOO_Class_New),
    DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
};

/*
 * And for the oo::class constructor...
 */

static const Tcl_MethodType classConstructor = {
    TCL_OO_METHOD_VERSION_CURRENT,
    "oo::class constructor",
    TclOO_Class_Constructor, NULL, NULL
};

/*
 * Scripted parts of TclOO. First, the master script (cannot be outside this
 * file).
 */

static const char *initScript =
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The body of the constructor for oo::class.
 */

static const char *classConstructorBody =
"set script [list ::oo::define [self] $definitionScript];"
"lassign [::oo::UpCatch $script] msg opts;"
"if {[dict get $opts -code] == 1} {"
"    dict set opts -errorline 0xDeadBeef"
"};"
"return -options $opts $msg;";

/*
 * The scripted part of the definitions of slots.
 */

static const char *slotScript =
"::oo::define ::oo::Slot {\n"
"    method Get {} {error unimplemented}\n"

	    DeletedHelpersNamespace);
    fPtr->epoch = 0;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
    Tcl_IncrRefCount(fPtr->constructorName);
    Tcl_IncrRefCount(fPtr->destructorName);
    Tcl_IncrRefCount(fPtr->clonedName);
    Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
	    TclOONRUpcatch, NULL, NULL);
    Tcl_IncrRefCount(fPtr->defineName);
    Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
	    TclOOUnknownDefinition, NULL, NULL);
    TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*

     */

    TclNewLiteralStringObj(argsPtr, "originObject");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
	    bodyPtr, NULL);
    Tcl_DecrRefCount(argsPtr);
    TclDecrRefCount(argsPtr);

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     *
     * The 0xDeadBeef is a special signal to the errorInfo logger that is used
     * by constructors that stops it from generating extra error information
     * that is confusing.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);

    TclNewLiteralStringObj(argsPtr, "{definitionScript {}}");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(classConstructorBody, -1);
    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
    Tcl_DecrRefCount(argsPtr);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
     */

    Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,

    Tcl_Interp *interp)		/* The interpreter containing the OO system
				 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);

    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->objectCls);
    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
    Tcl_DecrRefCount(fPtr->constructorName);
    Tcl_DecrRefCount(fPtr->destructorName);
    Tcl_DecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --

    /*
     * If this is a rename and not a delete of the object, we just flush the
     * cache of the object name.
     */

    if (flags & TCL_TRACE_RENAME) {
	if (oPtr->cachedNameObj) {
	    Tcl_DecrRefCount(oPtr->cachedNameObj);
	    TclDecrRefCount(oPtr->cachedNameObj);
	    oPtr->cachedNameObj = NULL;
	}
	return;
    }

    /*
     * Oh dear, the object really is being deleted. Handle this by running the

     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	    TclDecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our metadata.

	TclOORemoveFromInstances(oPtr, mixinPtr);
    }
    if (i) {
	ckfree(oPtr->mixins.list);
    }

    FOREACH(filterObj, oPtr->filters) {
	Tcl_DecrRefCount(filterObj);
	TclDecrRefCount(filterObj);
    }
    if (i) {
	ckfree(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	ckfree(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(oPtr->variables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    if (oPtr->cachedNameObj) {
	Tcl_DecrRefCount(oPtr->cachedNameObj);
	TclDecrRefCount(oPtr->cachedNameObj);
	oPtr->cachedNameObj = NULL;
    }

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	    }
	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
	    ckfree(clsPtr->metadataPtr);
	    clsPtr->metadataPtr = NULL;
	}

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	    TclDecrRefCount(filterObj);
	}
	if (i) {
	    ckfree(clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}
	FOREACH(mixinPtr, clsPtr->mixins) {
	    if (!Deleted(mixinPtr->thisPtr)) {

	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(&clsPtr->classMethods);
	TclOODelMethodRef(clsPtr->constructorPtr);
	TclOODelMethodRef(clsPtr->destructorPtr);

	FOREACH(variableObj, clsPtr->variables) {
	    Tcl_DecrRefCount(variableObj);
	    TclDecrRefCount(variableObj);
	}
	if (i) {
	    ckfree(clsPtr->variables.list);
	}

	DelRef(clsPtr);
    }

    if (oPtr->mapMethodNameProc != NULL) {
	register Class **startClsPtr = &startCls;
	Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr);

	result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
		(Tcl_Class *) startClsPtr, mappedMethodName);
	if (result != TCL_OK) {
	    Tcl_DecrRefCount(mappedMethodName);
	    TclDecrRefCount(mappedMethodName);
	    if (result == TCL_BREAK) {
		goto noMapping;
	    } else if (result == TCL_ERROR) {
		Tcl_AddErrorInfo(interp, "\n    (while mapping method name)");
	    }
	    return result;
	}

	/*
	 * Get the call chain for the remapped name.
	 */

	Tcl_IncrRefCount(mappedMethodName);
	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
	Tcl_DecrRefCount(mappedMethodName);
	TclDecrRefCount(mappedMethodName);
	if (contextPtr == NULL) {
	    Tcl_AppendResult(interp, "impossible to invoke method \"",
		    TclGetString(methodNamePtr),
		    "\": no defined method or unknown method", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;

#endif
#include "tclInt.h"
#include "tclOOInt.h"

static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static int		AfterNRDestructor(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		DecrRefsPostClassConstructor(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeConstruction(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeEval(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		RestoreFrame(ClientData data[],
			    Tcl_Interp *interp, int result);


    if (result != TCL_OK) {
	return result;
    }
    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Constructor --
 *
 *	Implementation for oo::class constructor.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_Constructor(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj *invoke[3];

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
     */

    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    Tcl_IncrRefCount(invoke[2]);
    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
	    invoke[0], invoke[1], invoke[2], NULL);

    /*
     * Tricky point: do not want the extra reported level in the Tcl stack
     * trace, so use TCL_EVAL_NOERR.
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    TclDecrRefCount((Tcl_Obj *) data[0]);
    TclDecrRefCount((Tcl_Obj *) data[1]);
    TclDecrRefCount((Tcl_Obj *) data[2]);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Create --
 *
 *	Implementation for oo::class->create method.

    /*
     * Return the name of the cloned object.
     */

    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOUpcatchCmd --
 *
 *	Implementation of the [oo::UpCatch] command, which is a combination of
 *	[uplevel 1] and [catch] that makes it easier to write transparent
 *	error handling in scripts.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOUpcatchCmd(
    ClientData ignored,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv);
}

static int
UpcatchCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *savedFramePtr = data[0];
    Tcl_Obj *resultObj[2];
    int rewind = iPtr->execEnvPtr->rewind;

    iPtr->varFramePtr = savedFramePtr;
    if (rewind || Tcl_LimitExceeded(interp)) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
	return TCL_ERROR;
    }
    resultObj[0] = Tcl_GetObjResult(interp);
    resultObj[1] = Tcl_GetReturnOptions(interp, result);
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
    return TCL_OK;
}

int
TclOONRUpcatch(
    ClientData ignored,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *savedFramePtr = iPtr->varFramePtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "script");
	return TCL_ERROR;
    }
    if (iPtr->varFramePtr->callerVarPtr != NULL) {
	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
    }

    Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL);
    return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR,
	    iPtr->cmdFramePtr, 1);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * The maximum length of fully-qualified object name to use in an errorinfo
 * message. Longer than this will be curtailed.
 */

#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30

/*
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
static void		GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,

 */

Tcl_Object
TclOOGetDefineCmdContext(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object;

    if ((iPtr->varFramePtr == NULL)
	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
	Tcl_AppendResult(interp, "this command may only be called from within"
		" the context of an ::oo::define or ::oo::objdefine command",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    return (Tcl_Object) iPtr->varFramePtr->clientData;
    object = iPtr->varFramePtr->clientData;
    if (Tcl_ObjectDeleted(object)) {
	Tcl_AppendResult(interp, "this command cannot be called when the "
		"object has been deleted", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    return object;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetClassInOuterContext --
 *	Wrapper round Tcl_GetObjectFromObj to perform the lookup in the

	Tcl_AppendResult(interp, errMsg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(className), NULL);
	return NULL;
    }
    return oPtr->classPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * GenerateErrorInfo --
 *	Factored out code to generate part of the error trace messages.
 *
 * ----------------------------------------------------------------------
 */

static void
GenerateErrorInfo(
    Tcl_Interp *interp,		/* Where to store the error info trace. */
    Object *oPtr,		/* What object (or class) was being configured
				 * when the error occurred? */
    Tcl_Obj *savedNameObj,	/* Name of object saved from before script was
				 * evaluated, which is needed if the object
				 * goes away part way through execution. OTOH,
				 * if the object isn't deleted then its
				 * current name (post-execution) has to be
				 * used. This matters, because the object
				 * could have been renamed... */
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    int length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjCmd --
 *	Implementation of the "oo::define" command. Works by effectively doing
 *	the same as 'namespace eval', but with extra magic applied so that the

    if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
	return TCL_ERROR;
    }

    AddRef(oPtr);
    if (objc == 3) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[2], 0,
		((Interp *)interp)->cmdFramePtr, 2);

	if (result == TCL_ERROR) {
	    int length;
	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
	    int limit = 60;
	    int overflow = (length > limit);

	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
		    "\n    (in definition script for object \"%.*s%s\" line %d)",
		    (overflow ? limit : length), objName,
		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
	}
	TclDecrRefCount(objNameObj);
    } else {
	Tcl_Obj *objPtr, *obj2Ptr, **objs;
	Interp *iPtr = (Interp *) interp;
	Tcl_Command cmd;
	int dummy;

	/*

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
	return TCL_ERROR;
    }

    AddRef(oPtr);
    if (objc == 3) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[2], 0,
		((Interp *)interp)->cmdFramePtr, 2);

	if (result == TCL_ERROR) {
	    int length;
	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
	    int limit = 60;
	    int overflow = (length > limit);

	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
		    "\n    (in definition script for object \"%.*s%s\" line %d)",
		    (overflow ? limit : length), objName,
		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
	}
	TclDecrRefCount(objNameObj);
    } else {
	Tcl_Obj *objPtr, *obj2Ptr, **objs;
	Interp *iPtr = (Interp *) interp;
	Tcl_Command cmd;
	int dummy;

	/*

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
	return TCL_ERROR;
    }

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0,
		((Interp *)interp)->cmdFramePtr, 2);

	if (result == TCL_ERROR) {
	    int length;
	    const char *objName = Tcl_GetStringFromObj(
		    TclOOObjectName(interp, oPtr), &length);
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
	    int limit = 60;
	    int overflow = (length > limit);

	}
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (in definition script for object \"%.*s%s\" line %d)",
		    (overflow ? limit : length), objName,
	TclDecrRefCount(objNameObj);
		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
	}
    } else {
	Tcl_Obj *objPtr, *obj2Ptr, **objs;
	Interp *iPtr = (Interp *) interp;
	Tcl_Command cmd;
	int dummy;

	/*

				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
				 * constructor. */
    Tcl_Obj *destructorName;	/* Shared object containing the "name" of a
				 * destructor. */
    Tcl_Obj *clonedName;	/* Shared object containing the name of a
				 * "<cloned>" pseudo-constructor. */
    Tcl_Obj *defineName;	/* Fully qualified name of oo::define. */
} Foundation;

/*
 * A call context structure is built when a method is called. They contain the
 * chain of method implementations that are to be invoked by a particular
 * call, and the process of calling walks the chain, with the [next] command
 * proceeding to the next entry in the chain.

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

/*
 * Method implementations (in tclOOBasic.c).
 */

MODULE_SCOPE int	TclOO_Class_Constructor(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_CreateNs(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_New(ClientData clientData,

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, int objc,
			    Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE int	TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
			    Class *mixinPtr);
MODULE_SCOPE void	TclOORemoveFromSubclasses(Class *subPtr,
			    Class *superPtr);
MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
			    CallChain *callPtr);
MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
			    CallContext *contextPtr);
MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
MODULE_SCOPE int	TclOOUpcatchCmd(ClientData ignored,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 * Include all the private API, generated from tclOO.decls.
 */

#include "tclOOIntDecls.h"


{
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    int objectNameLen;

    if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
	/*
	 * Horrible hack to deal with certain constructors that must not add
	 * information to the error trace.
	 */

	return;
    }

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}

		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		length++;
		Tcl_GetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
#endif /* WIN */

				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    const struct TclPlatStubHooks *hooks;

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* MACOSX */

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \

    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
}

#define Tcl_MacOSXOpenBundleResources (int (*) ( \
		Tcl_Interp *, const char *, int, int, char *)) Tcl_WinUtfToTChar
#define Tcl_MacOSXOpenVersionedBundleResources (int (*) ( \
		Tcl_Interp *, const char *, const char *, int, int, char *)) Tcl_WinTCharToUtf
#define TclMacOSXGetFileAttribute (int (*) (Tcl_Interp *,  \
		int, Tcl_Obj *, Tcl_Obj **)) TclpCreateProcess
#define TclMacOSXMatchType (int (*) (Tcl_Interp *, const char *, \
		const char *, Tcl_StatBuf *, Tcl_GlobTypeData *)) TclpMakeFile
#define TclMacOSXNotifierAddRunLoopMode (void (*) (const void *)) TclpOpenFile
#define TclpLocaltime_unix (struct tm *(*) (const time_t *)) TclGetAndDetachPids
#define TclpGmtime_unix (struct tm *(*) (const time_t *)) TclpCloseFile

    TclUnixWaitForFile, /* 38 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    Tcl_WinUtfToTChar, /* 0 */
    Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
#endif /* MACOSX */

if {![package vsatisfies [package provide Tcl] 8.4]} return
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[string compare [info sharedlibextension] .dll]} return
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
} else {
    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
}

    } {
	::interp alias $slave $command {} [namespace current]::$alias $slave
    }

    # This alias lets the slave have access to a subset of the 'file'
    # command functionality.

    AliasSubset $slave file \
	file  dir.* join root.* ext.* tail path.* split
    ::interp expose $slave file
    foreach subcommand {dirname extension rootname tail} {
	::interp alias $slave ::tcl::file::$subcommand {} file $subcommand
    }
    foreach subcommand {
	atime attributes copy delete executable exists isdirectory isfile
	link lstat mtime mkdir nativename normalize owned readable readlink
	rename size stat tempfile type volumes writable
    } {
	::interp alias $slave ::tcl::file::$subcommand {} \
	    ::safe::BadSubcommand $slave file $subcommand
    }

    # Subcommands of info
    foreach {subcommand alias} {
	nameofexecutable   AliasExeName
    } {
	::interp alias $slave ::tcl::info::$subcommand \
	    {} [namespace current]::$alias $slave

	return -code error "can't source tm.tcl into slave $slave ($msg)"
    }

    # Sync the paths used to search for Tcl modules. This can be done only
    # now, after tm.tcl was loaded.
    namespace upvar ::safe S$slave state
    if {[llength $state(tm_path_slave)] > 0} {
	::interp eval $slave [list ::tcl::tm::add {*}$state(tm_path_slave)]
	::interp eval $slave [list \
		::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
    }
    return $slave
}

# Add (only if needed, avoid duplicates) 1 level of sub directories to an
# existing path list.  Also removes non directories from the returned
# list.

	-nocomplain 0
	-join 0
	-tails 0
	-- 0
    }

    if {$::tcl_platform(platform) eq "windows"} {
	set dirPartRE {^(.*)[\\/]}
	set dirPartRE {^(.*)[\\/]([^\\/]*)$}
    } else {
	set dirPartRE {^(.*)/}
	set dirPartRE {^(.*)/([^/]*)$}
    }

    set dir        {}
    set virtualdir {}

    while {$at < [llength $args]} {
	switch -glob -- [set opt [lindex $args $at]] {

    # we know if -nocomplain is set.
    if {$got(-directory)} {
	try {
	    set dir [TranslatePath $slave $virtualdir]
	    DirInAccessPath $slave $dir
	} on error msg {
	    Log $slave $msg
	    if {$got(-nocomplain)} {
	    if {$got(-nocomplain)} return
		return
	    }
	    return -code error "permission denied"
	}
	lappend cmd -directory $dir
    }

    # Apply the -join semantics ourselves
    if {$got(-join)} {
	set args [lreplace $args $at end [join [lrange $args $at end] "/"]]
    }

    # Process remaining pattern arguments
    set firstPattern [llength $cmd]
    while {$at < [llength $args]} {
	set opt [lindex $args $at]
    foreach opt [lrange $args $at end] {
	incr at
	if {[regexp $dirPartRE $opt -> thedir]} {
	    try {
	if {![regexp $dirPartRE $opt -> thedir thefile]} {
	    set thedir .
	}
	if {$thedir eq "*" &&
		($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} {
	    set mapped 0
	    foreach d [glob -directory [TranslatePath $slave $virtualdir] \
			   -types d -tails *] {
		catch {
		    DirInAccessPath $slave \
			[TranslatePath $slave [file join $virtualdir $d]]
		    lappend cmd [file join $d $thefile]
		    set mapped 1
		}
	    }
	    if {$mapped} continue
	}
	try {
		set thedir [file join $virtualdir $thedir]
		DirInAccessPath $slave [TranslatePath $slave $thedir]
	    } on error msg {
		Log $slave $msg
		if {$got(-nocomplain)} {
	    DirInAccessPath $slave [TranslatePath $slave \
		    [file join $virtualdir $thedir]]
	} on error msg {
	    Log $slave $msg
	    if {$got(-nocomplain)} continue
		    continue
		}
		return -code error "permission denied"
	    return -code error "permission denied"
	    }
	}
	lappend cmd $opt
    }

    Log $slave "GLOB = $cmd" NOTICE

    if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
	return
    }
    try {
	set entries [::interp invokehidden $slave glob {*}$cmd]
    } on error msg {
	Log $slave $msg
	return -code error "script error"
    }

    Log $slave "GLOB @ $entries" NOTICE
    Log $slave "GLOB < $entries" NOTICE

    # Translate path back to what the slave should see.
    set res {}
    set l [string length $dir]
    foreach p $entries {
	if {[string equal -length $l $dir $p]} {
	    set p [string replace $p 0 [expr {$l-1}] $virtualdir]
	}
	lappend res $p
    }

    Log $slave "GLOB @ $res" NOTICE
    Log $slave "GLOB > $res" NOTICE
    return $res
}

# AliasSource is the target of the "source" alias in safe interpreters.

proc ::safe::AliasSource {slave args} {
    set argc [llength $args]

    namespace upvar ::safe S$slave state
    if {$norm_dir ni $state(access_path,norm)} {
	return -code error "\"$dir\": not in access_path"
    }
}

# This procedure enables access from a safe interpreter to only a subset
# of the subcommands of a command:
# This procedure is used to report an attempt to use an unsafe member of an
# ensemble command.

proc ::safe::Subset {slave command okpat args} {
proc ::safe::BadSubcommand {slave command subcommand args} {
    set subcommand [lindex $args 0]
    if {[regexp $okpat $subcommand]} {
	return [$command {*}$args]
    }
    set msg "not allowed to invoke subcommand $subcommand of $command"
    Log $slave $msg
    return -code error $msg
    return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}

# This procedure installs an alias in a slave that invokes "safesubset" in
# the master to execute allowed subcommands. It precomputes the pattern of
# allowed subcommands; you can use wildcards in the pattern if you wish to
# allow subcommand abbreviation.
#
# Syntax is: AliasSubset slave alias target subcommand1 subcommand2...

proc ::safe::AliasSubset {slave alias target args} {
    set pat "^([join $args |])\$"
    ::interp alias $slave $alias {}\
	[namespace current]::Subset $slave $target $pat
}

# AliasEncoding is the target of the "encoding" alias in safe interpreters.

proc ::safe::AliasEncoding {slave option args} {
    # Careful; do not want empty option to get through to the [string equal]
    if {[regexp {^(name.*|convert.*|)$} $option]} {
	return [::interp invokehidden $slave encoding $option {*}$args]
    # Note that [encoding dirs] is not supported in safe slaves at all
    }

    set subcommands {convertfrom convertto names system}
    if {[string equal -length [string length $option] $option "system"]} {
	if {![llength $args]} {
	    # passed all the tests , lets source it:
	    try {
		return [::interp invokehidden $slave encoding system]
	    } on error msg {
    try {
	set option [tcl::prefix match -error [list -level 1 -errorcode \
		[list TCL LOOKUP INDEX option $option]] $subcommands $option]
	# Special case: [encoding system] ok, but [encoding system foo] not
	if {$option eq "system" && [llength $args]} {
		Log $slave $msg
		return -code error "script error"
	    return -code error -errorcode {TCL WRONGARGS} \
	    }
	}
	set msg "wrong # args: should be \"encoding system\""
		"wrong # args: should be \"encoding system\""
	set code {TCL WRONGARGS}
    } else {
	set msg "bad option \"$option\": must be convertfrom, convertto, names, or system"
	set code [list TCL LOOKUP INDEX option $option]
    }
    Log $slave $msg
    return -code error -errorcode $code $msg
	}
    } on error {msg options} {
	Log $slave $msg
	return -options $options $msg
    }
    tailcall ::interp invokehidden $slave encoding $option {*}$args
}

# Various minor hiding of platform features. [Bug 2913625]

proc ::safe::AliasExeName {slave} {
    return ""
}

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package prefer latest
package require Tcl 8.5
package require tcltest 2.2
namespace import tcltest::*
configure {*}$argv -testdir [file dir [info script]]
runAllTests
proc exit args {}

    }}
} 1,2

proc linenumber {} {
    dict get [info frame -1] line
}
test dict-23.1 {dict compilation crash: Bug 3487626} {
    apply {n {
    apply {{} {apply {n {
	set e {}
	set k {}
	dict for {a b} {c {d {e {f g}}}} {
	    ::tcl::dict::for {h i} $b {
		dict update i e j {
		    ::tcl::dict::update j f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]
    }} [linenumber]}}
} 5
test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
    # Something isn't quite right in line number and continuation line
    # tracking; at time of writing, this test produces 7, not 5, which
    # indicates that the extra newlines in the non-script argument are
    # confusing things.
    apply {n {
    apply {{} {apply {n {
	set e {}
	set k {}
	dict for {a {
b
}} {c {d {e {f g}}}} {
	    ::tcl::dict::for {h {
i

j
} f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]
    }} [linenumber]}}
} 5
rename linenumber {}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

} -result {}

test oo-18.1 {OO: define command support} {
    list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
} {1 foo {foo
    while executing
"error foo"
    (in definition script for object "oo::object" line 1)
    (in definition script for class "::oo::object" line 1)
    invoked from within
"oo::define oo::object {error foo}"}}
test oo-18.2 {OO: define command support} {
    list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
} {1 foo {foo
    while executing
"oo::define oo::object error foo"}}
test oo-18.3 {OO: define command support} {
    list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    (in definition script for object "::foo" line 1)
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::class create foo {error bar}"}}
test oo-18.3a {OO: define command support} {
    list [catch {oo::class create foo {
    error bar
}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    (in definition script for object "::foo" line 2)
    (in definition script for class "::foo" line 2)
    invoked from within
"oo::class create foo {
    error bar
}"}}
test oo-18.3b {OO: define command support} {
    list [catch {oo::class create foo {
    eval eval error bar
}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    ("eval" body line 1)
    invoked from within
"eval error bar"
    ("eval" body line 1)
    invoked from within
"eval eval error bar"
    (in definition script for object "::foo" line 2)
    (in definition script for class "::foo" line 2)
    invoked from within
"oo::class create foo {
    eval eval error bar
}"}}
test oo-18.4 {OO: more error traces from the guts} -setup {
    oo::object create obj
} -body {

"error bar"
    (in "::obj eval" script line 1)
    invoked from within
"next $script"
    (class "::cls" method "eval" line 1)
    invoked from within
"obj eval {error bar}"}}
test oo-18.6 {class construction reference management and errors} -setup {
    oo::class create super_abc
} -body {
    catch {
oo::class create abc {
    superclass super_abc
    ::rename abc ::def
    ::error foo
}
    } msg opt
    dict get $opt -errorinfo
} -cleanup {
    super_abc destroy
} -result {foo
    while executing
"::error foo"
    (in definition script for class "::def" line 4)
    invoked from within
"oo::class create abc {
    superclass super_abc
    ::rename abc ::def
    ::error foo
}"}
test oo-18.7 {OO: objdefine command support} -setup {
    oo::object create ::inst
} -body {
    list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
} -cleanup {
    catch {::inst destroy}
    catch {::INST destroy}
} -result {1 foo {foo
    while executing
"error foo"
    (in definition script for object "::INST" line 1)
    invoked from within
"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
test oo-18.8 {OO: define/self command support} -setup {
    oo::class create master
    oo::class create ::foo {superclass master}
} -body {
    catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    master destroy
} -result {foobar
    while executing
"error foobar"
    (in definition script for class object "::bar" line 1)
    invoked from within
"self {error foobar}"
    (in definition script for class "::bar" line 1)
    invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
    oo::class create master
    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
        superclass master
    }]
} -body {
    catch {oo::define $c {error err}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    master destroy
} -result {err
    while executing
"error err"
    (in definition script for class "::now_this_is_a_very_very_long..." line 1)
    invoked from within
"oo::define $c {error err}"}
test oo-18.10 {OO: define/self command support} -setup {
    oo::class create master
    oo::class create ::foo {superclass master}
} -body {
    catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    master destroy
} -result {foobar
    while executing
"error foobar"
    (in definition script for class object "::foo" line 1)
    invoked from within
"self {rename ::foo {}; error foobar}"
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::define foo {self {rename ::foo {}; error foobar}}"}
test oo-18.11 {OO: define/self command support} -setup {
    oo::class create master
    oo::class create ::foo {superclass master}
} -body {
    catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    master destroy
} -result {this command cannot be called when the object has been deleted
    while executing
"self {error foobar}"
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::define foo {rename ::foo {}; self {error foobar}}"}

test oo-19.1 {OO: varname method} -setup {
    oo::object create inst
    oo::objdefine inst export eval
    set result {}
    inst eval { variable x }
} -body {

test oo-33.2 {TIP 380: slots - defaulting} -setup {
    set s [SampleSlot new]
} -body {
    list [$s destroy; $s unknown] [$s contents]
} -cleanup {
    rename $s {}
} -result {{} {a b c destroy unknown}}
test oo-32.3 {TIP 380: slots - defaulting} -setup {
test oo-33.3 {TIP 380: slots - defaulting} -setup {
    set s [SampleSlot new]
} -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup {
    rename $s {}
} -result {{} unknown {1 Set destroy 1 Set unknown}}

set saveAutoPath $::auto_path
set ::auto_path [info library]

# Force actual loading of the safe package because we use un exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}


proc equiv {x} {return $x}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]

test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
    safe::interpConfigure

test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    lsort [a aliases]
} -cleanup {
    safe::interpDelete a
} -result {::tcl::info::nameofexecutable clock encoding exit file glob load source}
} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    interp eval a {source [file join $tcl_library init.tcl]}
} -cleanup {
    safe::interpDelete a

} -cleanup {
    safe::interpDelete $i
} -result {}
test safe-12.7 {glob is restricted} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob *
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied}

proc buildEnvironment {filename} {
    upvar 1 testdir testdir testdir2 testdir2 testfile testfile
    set testdir [makeDirectory deletethisdir]
    set testdir2 [makeDirectory deletemetoo $testdir]
    set testfile [makeFile {} $filename $testdir2]
}
#### New tests for Safe base glob, with patches @ Bug 2964715
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob *
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied}
test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment deleteme.tm
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
    if {$result eq [list $testfile]} {
        return "glob match"
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {glob match}
test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment deleteme.tm
} -body {
    $i eval glob -directory $testdir2 *.tm
} -returnCodes error -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {permission denied}
test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment deleteme.tm
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval \
	    glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
    if {$result eq [list $testfile]} {
        return "glob match"
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {glob match}
test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment deleteme.tm
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    $i eval \
	glob -directory $testdir [file join deletemetoo *.tm]
} -returnCodes error -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {permission denied}
test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment deleteme.tm
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    $i eval \
	glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -match glob -result *

test safe-13.1 {safe file ensemble does not surprise code} -setup {
} -result {}
test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment pkgIndex.tcl
} -body {
    set safeTD [::safe::interpAddToAccessPath $i $testdir]
    ::safe::interpAddToAccessPath $i $testdir2
    string map [list $safeTD EXPECTED] [$i eval [list \
	glob -directory $safeTD -join * pkgIndex.tcl]]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}}
# Note the extra {} around the result above; that's *expected* because of the
# format of virtual path roots.
test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment notIndex.tcl
} -body {
    set safeTD [::safe::interpAddToAccessPath $i $testdir]
    ::safe::interpAddToAccessPath $i $testdir2
    $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {}
test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment notIndex.tcl
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval \
	    glob -directory $testdir -join -nocomplain * notIndex.tcl]
    if {$result eq [list $testfile]} {
        return {glob match}
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {no match: }
test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment notIndex.tcl
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {}
rename buildEnvironment {}

#### Test for the module path
test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
    set i [safe::interpCreate]
} -body {
    set tm {}
    foreach token [$i eval ::tcl::tm::path list] {
        lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
    }
    return $tm
} -cleanup {
    safe::interpDelete $i
} -result [::tcl::tm::path list]

test safe-15.1 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp invokehidden $i file isdirectory .}]
    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
} -cleanup {
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {invalid command name "::tcl::file::isdirectory"}}
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}

set ::auto_path $saveAutoPath
# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.

package require tcltest 2
namespace import -force ::tcltest::*

# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.6.6}]}]
testConstraint exec [llength [info commands exec]]

# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} { expr {int(rand()*16383+49152)} }

# Test the latency of tcp connections over the loopback interface. Some OSes

test switch-11.6 {-matchvar unwritable} {
    set x {}
    list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {can't set "x(x)": variable isn't array}}

test switch-12.1 {regexp matching with -indexvar} {
    switch -regexp -indexvar x -- abc {.(.). {set x}}
} {{0 3} {1 2}}
} {{0 2} {1 1}}
test switch-12.2 {regexp matching with -indexvar} {
    set x GOOD
    switch -regexp -indexvar x -- abc {.(.).. {list $x z}}
    set x
} GOOD
test switch-12.3 {regexp matching with -indexvar} {
    switch -regexp -indexvar x -- "a b c" {.(.). {set x}}
} {{0 3} {1 2}}
} {{0 2} {1 1}}
test switch-12.4 {regexp matching with -indexvar} {
    set x BAD
    switch -regexp -indexvar x -- "a b c" {
	bc {list $x YES}
	default {list $x NO}
    }
} {{} NO}
test switch-12.5 {-indexvar without -regexp} {
    set x {}
    list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg
} {1 {} {-indexvar option requires -regexp option}}
test switch-12.6 {-indexvar unwritable} {
    set x {}
    list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
} {1 {} {can't set "x(x)": variable isn't array}}
test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
    set str abcdef
    switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
} abc
test switch-12.8 {-indexvar and matched empty strings} {
    switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
} {{0 2} {3 2}}
test switch-12.9 {-indexvar and unmatched strings} {
    switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
} {{0 2} {-1 -1}}

test switch-13.1 {-indexvar -matchvar combinations} {
    switch -regexp -indexvar x -matchvar y abc {
	. {list $x $y}
    }
} {{{0 1}} a}
} {{{0 0}} a}
test switch-13.2 {-indexvar -matchvar combinations} {
    switch -regexp -indexvar x -matchvar y abc {
	.$ {list $x $y}
    }
} {{{2 3}} c}
} {{{2 2}} c}
test switch-13.3 {-indexvar -matchvar combinations} {
    switch -regexp -indexvar x -matchvar y abc {
	(.)(.)(.) {list $x $y}
    }
} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}}
} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}}
test switch-13.4 {-indexvar -matchvar combinations} {
    set x -
    set y -
    switch -regexp -indexvar x -matchvar y abc {
	(.)(.)(.). -
	default {list $x $y}
    }

} {1 - - {can't set "x(x)": variable isn't array}}
test switch-13.6 {-indexvar -matchvar combinations} {
    set x -
    set y -
    list [catch {
	switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
    } msg] $x $y $msg
} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
} {1 {{0 0}} - {can't set "y(y)": variable isn't array}}

test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
    switch -regexp -- 0 {
	{[0-9]+} {return yes}
	default  {return no}
    }
    foo

	fconfigure $sin -translation binary
	zlib push gunzip $sin
	after 1000 {set total timeout}
	fcopy $sin $fout -command {apply {{c {e {}}} {
	    set ::total [expr {$e eq {} ? $c : $e}]
	}}}
	vwait total
	after cancel {set total timeout}
    } finally {
	close $sin
    }
    append total --> [file size $file]
} -cleanup {
    close $fout
    close $srv

    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -command {apply {{c {e {}}} {
        set ::total [expr {$e eq {} ? $c : $e}]
    }}}
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list read $::total size [file size $file]
} -cleanup {
    close $srv
    removeFile $file
} -returnCodes {ok error} -result {read 81920 size 81920}
test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {

    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -command {apply {{c {e {}}} {
        set ::total [expr {$e eq {} ? $c : $e}]
    }}}
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list read $::total size [file size $file]
} -cleanup {
    close $srv
    removeFile $file
} -result {read 81920 size 81920}
test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {

    chan configure $sin -translation binary
    zlib push gunzip $sin
    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0]
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list $::total size [file size $file]
} -cleanup {
    close $srv
    rename zlib95copy {}
    removeFile $file
} -result {{eof 81920} size 81920}

        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    close $srv
    unset -nocomplain total
} -result {eof 500}
test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {

        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    close $srv
    unset -nocomplain total
} -result {eof 500}
test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {

        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
} -result {eof 500}
test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {

            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}

            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}

            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}

    }} $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
} -returnCodes error \
  -result {bad event name "xyzzy": must be readable or writable}
test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {

    chan event $s readable [list zlibRead $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}
test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {

    chan event $s readable [list zlibRead $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}

    append lfname [string range $fname 1 end]

    set text "    "
    if {$args eq ""} {
	append text $rtype " *" $lfname "; /* $index */\n"
	return $text
    }
    if {[string range $rtype end-7 end] eq "CALLBACK"} {
	append text [string trim [string range $rtype 0 end-8]] " (CALLBACK *" $lfname ") "
    if {[string range $rtype end-8 end] eq "__stdcall"} {
	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
    } else {
	append text $rtype " (*" $lfname ") "
    }
    set arg1 [lindex $args 0]
    switch -exact $arg1 {
	void {
	    append text "(void)"

#  include <stdint.h>
# endif
#endif
#if HAVE_UNISTD_H
# include <unistd.h>
#endif"

ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_DDE_PATCH_LEVEL TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION TCL_REG_PATCH_LEVEL RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
ac_subst_files=''

# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
# The variables have the same names as the options, with
# dashes changed to underlines.

TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.3
TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
TCL_DDE_PATCH_LEVEL="0"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

PKG_CFG_ARGS=$@

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------

                              ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems.  If it contains results you don't
# want to keep, you may remove or edit it.

s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t
s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t
s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
s,@TCL_DDE_PATCH_LEVEL@,$TCL_DDE_PATCH_LEVEL,;t t
s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
s,@TCL_REG_PATCH_LEVEL@,$TCL_REG_PATCH_LEVEL,;t t
s,@RC_OUT@,$RC_OUT,;t t
s,@RC_TYPE@,$RC_TYPE,;t t
s,@RC_INCLUDE@,$RC_INCLUDE,;t t
s,@RC_DEFINE@,$RC_DEFINE,;t t
s,@RC_DEFINES@,$RC_DEFINES,;t t
s,@RES@,$RES,;t t
s,@LIBOBJS@,$LIBOBJS,;t t

TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.3
TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
TCL_DDE_PATCH_LEVEL="0"
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
TCL_REG_PATCH_LEVEL="0"
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

PKG_CFG_ARGS=$@

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------

AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PACKAGE_PATH)

# win only
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
AC_SUBST(TCL_DDE_PATCH_LEVEL)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)
AC_SUBST(TCL_REG_PATCH_LEVEL)

AC_SUBST(RC)
AC_SUBST(RC_OUT)
AC_SUBST(RC_TYPE)
AC_SUBST(RC_INCLUDE)
AC_SUBST(RC_DEFINE)
AC_SUBST(RC_DEFINES)

######################################################################

NAMEPREFIX	= tcl
STUBPREFIX	= $(NAMEPREFIX)stub
DOTVERSION	= 8.6
VERSION		= 86

DDEVERSION = 13
DDEDOTVERSION = 1.3
DDEVERSION = 14
DDEDOTVERSION = 1.4

REGVERSION = 13
REGDOTVERSION = 1.3

BINROOT		= ..
!IF "$(NODEBUG)" == "1"
TMPDIRNAME	= Release

PROJECT	= tcl
!include "rules.vc"

STUBPREFIX      = $(PROJECT)stub
DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)

DDEDOTVERSION = 1.3
DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)

REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)

BINROOT		= $(MAKEDIR)     # originally .
ROOT		= $(MAKEDIR)\..  # originally ..

    case XTYP_EXECUTE: {
	/*
	 * Execute this script. The results will be saved into a list object
	 * which will be retreived later. See ExecuteRemoteObject.
	 */

	Tcl_Obj *returnPackagePtr;
	Tcl_UniChar *uniStr;

	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
	    /*
	     * Empty loop body.
	     */
	}

	if (convPtr == NULL) {
	    return (HDDEDATA) DDE_FNOTPROCESSED;
	}

	utilString = (TCHAR *) DdeAccessData(hData, &dlen);
	len = dlen;
	ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
	utilString = (char *) DdeAccessData(hData, &dlen);
	uniStr = (Tcl_UniChar *) utilString;
	if (!dlen) {
	    /* Empty string. Just for protection against crash. */
	    ddeObjectPtr = Tcl_NewObj();
	} else if ((dlen & 1) || uniStr[(dlen>>1)-1]) {
	    /* Cannot be unicode, so assume utf-8 */
	    if (!utilString[dlen-1]) {
		dlen--;
	    }
	    ddeObjectPtr = Tcl_NewStringObj(utilString, dlen);
	} else {
	    /* unicode */
	    dlen >>= 1;
	    ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen);
	}
	Tcl_IncrRefCount(ddeObjectPtr);
	DdeUnaccessData(hData);
	if (convPtr->returnPackagePtr != NULL) {
	    Tcl_DecrRefCount(convPtr->returnPackagePtr);
	}
	convPtr->returnPackagePtr = NULL;
	returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);

	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	int dataLength;
	BYTE *dataString;
	const Tcl_UniChar *dataString;

	if (binary) {
	    dataString = (BYTE *)
	    dataString = (const Tcl_UniChar *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    dataString = (BYTE *)
		    Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
	    dataLength += 1;
	    dataString =
		    Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
	    dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
	}

	if (dataLength <= (binary ? 0 : sizeof(TCHAR))) {
	if (dataLength <= (binary ? 0 : sizeof(Tcl_UniChar))) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("cannot execute null data", -1));
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    break;
	}
	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	DdeFreeStringHandle(ddeInstance, ddeService);
	DdeFreeStringHandle(ddeInstance, ddeTopic);

	if (hConv == NULL) {
	    SetDdeError(interp);
	    result = TCL_ERROR;
	    break;
	}

	ddeData = DdeCreateDataHandle(ddeInstance, dataString,
		(DWORD) dataLength, 0, 0, CF_TEXT, 0);
	ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
		(DWORD) dataLength, 0, 0, binary ? CF_TEXT : CF_UNICODETEXT, 0);
	if (ddeData != NULL) {
	    if (async) {
		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
			binary ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
	    } else {
		ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
			hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
			hConv, 0, binary ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
		if (ddeReturn == 0) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		}
	    }
	    DdeFreeDataHandle(ddeData);
	} else {

	    result = TCL_ERROR;
	} else {
	    Tcl_Obj *returnObjPtr;
	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
		    CP_WINUNICODE);
	    if (ddeItem != NULL) {
		ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
			CF_TEXT, XTYP_REQUEST, 5000, NULL);
			binary ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		} else {
		    DWORD tmp;
		    const BYTE *dataString = DdeAccessData(ddeData, &tmp);
		    const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);

		    if (binary) {
			returnObjPtr =
				Tcl_NewByteArrayObj(dataString, (int) tmp);
				Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
		    } else {
			tmp >>= 1;
			if (tmp && !dataString[(tmp-1)]) {
			    --tmp;
			}
			returnObjPtr = Tcl_NewStringObj((char *)dataString, -1);
			returnObjPtr = Tcl_NewUnicodeObj(dataString,
				(int) tmp);
		    }
		    DdeUnaccessData(ddeData);
		    DdeFreeDataHandle(ddeData);
		    Tcl_SetObjResult(interp, returnObjPtr);
		}
	    } else {
		SetDdeError(interp);

	    SetDdeError(interp);
	    result = TCL_ERROR;
	} else {
	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
		    CP_WINUNICODE);
	    if (ddeItem != NULL) {
		ddeData = DdeClientTransaction(dataString, (DWORD) length,
			hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
			hConv, ddeItem, binary ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL);
		if (ddeData == NULL) {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		}
	    } else {
		SetDdeError(interp);
		result = TCL_ERROR;

			Tcl_NewStringObj("invalid data returned from server", -1));
		Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    objPtr = Tcl_ConcatObj(objc, objv);
	    string = Tcl_GetStringFromObj(objPtr, &length);
	    string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
	    ddeItemData = DdeCreateDataHandle(ddeInstance,
		    (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
		    (BYTE *) string, (DWORD) (2*length+2), 0, 0, CF_UNICODETEXT, 0);

	    if (async) {
		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
			0xFFFFFFFF, hConv, 0,
			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
			CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
	    } else {
		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
			0xFFFFFFFF, hConv, 0,
			CF_TEXT, XTYP_EXECUTE, 30000, NULL);
			CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
		if (ddeData != 0) {
		    ddeCookie = DdeCreateStringHandle(ddeInstance,
			    TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
		    ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
			    CF_TEXT, XTYP_REQUEST, 30000, NULL);
			    CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL);
		}
	    }

	    Tcl_DecrRefCount(objPtr);

	    if (ddeData == 0) {
		SetDdeError(interp);
		result = TCL_ERROR;
		goto cleanup;
	    }

	    if (async == 0) {
		Tcl_Obj *resultPtr;
		Tcl_UniChar *ddeDataString;

		/*
		 * The return handle has a two or four element list in it. The
		 * first element is the return code (TCL_OK, TCL_ERROR, etc.).
		 * The second is the result of the script. If the return code
		 * is TCL_ERROR, then the third element is the value of the
		 * variable "errorCode", and the fourth is the value of the
		 * variable "errorInfo".
		 */

		resultPtr = Tcl_NewObj();
		length = DdeGetData(ddeData, NULL, 0, 0);
		Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1);
		string = Tcl_GetString(resultPtr);
		DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
		Tcl_SetObjLength(resultPtr, (int) strlen(string));
		ddeDataString = ckalloc(length);
		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
		length = (length >> 1) - 1;
		resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
		ckfree(ddeDataString);

		if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    goto invalidServerResponse;
		}
		if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);