Tcl Source Code

2011-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c, generic/tclOOBasic.c, generic/tclOODefineCmds.c
	* generic/tclOOInfo.c, generic/tclOOMethod.c: More generation of
	error codes (TclOO miscellany).

	* generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error
	codes (miscellaneous commands mostly already handled).

2011-04-04  Don Porter  <[email protected]>

	* README:	Updated README files, repairing broken URLs and
	* macosx/README:	removing other bits that were clearly wrong.
	* unix/README:	Still could use more eyeballs on the detailed build
	* win/README:	advice on various plaforms. [Bug 3202030]

2011-04-04  Donal K. Fellows  <[email protected]>

	* library/init.tcl (tcl::mathfunc::rmmadwiw): Disable by default to
	make test suite work.

	* generic/tclBasic.c, generic/tclStringObj.c, generic/tclTimer.c,
	* generic/tclTrace.c, generic/tclUtil.c: More generation of error
	codes ([format], [after], [trace], RE optimizer).

2011-04-04  Jan Nijtmans  <[email protected]>

	* generic/tclCmdAH.c:  Better error-message in case of errors
	* generic/tclCmdIL.c:  related to setting a variable. This fixes
	* generic/tclDictObj.c: a warning: "Why make your own error
	* generic/tclScan.c:   message? Why?"
	* generic/tclTest.c:
	* test/error.test:
	* test/info.test:
	* test/scan.test:
	* unix/tclUnixThrd.h:  Remove this unused header file.

2011-04-03  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
	* generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
	* generic/tclScan.c: More generation of error codes (namespace
	creation, path normalization, pipeline creation, package handling,
	procedures, [scan] formats)

README:  Tcl
    This is the Tcl 8.6b1 source distribution.

	http://tcl.sourceforge.net/
    You can get any source release of Tcl from the file distributions
    link at the above URL.

Contents
--------
    1. Introduction
    2. Documentation
    3. Compiling and installing Tcl
    4. Development tools
    5. Tcl newsgroup
    6. The Tcler's Wiki

    7. Mailing lists
    8. Support and Training
    9. Tracking Development
    10. Thank You

1. Introduction
---------------
Tcl provides a powerful platform for creating integration applications that
tie together diverse applications, protocols, devices, and frameworks.
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
The home for Tcl/Tk releases and bug/patch database is on SourceForge:

	http://tcl.sourceforge.net/

with the Tcl Developer Xchange hosted at:

	http://www.tcl.tk/

Extensive documentation is available at our website.
The home page for this release, including new features, is
	http://www.tcl.tk/software/tcltk/8.6.html

Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
	http://sourceforge.net/projects/tcl/files/

Information about Tcl itself can be found at
	http://www.tcl.tk/about/

There have been many Tcl books on the market.  Many are mentioned in the Wiki:
	http://wiki.tcl.tk/_/ref?N=25206

To view the complete set of reference manual entries for Tcl 8.6 online,
visit the URL:
	http://www.tcl.tk/man/tcl8.6/

2a. Unix Documentation
----------------------

The "doc" subdirectory in this release contains a complete set of
reference manual entries for Tcl.  Files with extension ".1" are for
programs (for example, tclsh.1); files with extension ".3" are for C

for users.  If you need help we suggest that you post questions to
comp.lang.tcl.  We read the newsgroup and will attempt to answer esoteric
questions for which no one else is likely to know the answer.  In addition,
see the following Web site for links to other organizations that offer
Tcl/Tk training:

	http://wiki.tcl.tk/training

9. Tracking Development
-----------------------

Tcl is developed in public.  To keep an eye on how Tcl is changing, see
	http://core.tcl.tk/

10. Thank You
-------------

We'd like to express our thanks to the Tcl community for all the
helpful suggestions, bug reports, and patches we have received.
Tcl/Tk has improved vastly and will continue to do so with your help.

        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
	Tcl_AppendResult(interp, "can't rename to \"", newName,
		 "\": command already exists", NULL);
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
                "TARGET_EXISTS", NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*
     * Warning: any changes done in the code here are likely to be needed in
     * Tcl_HideCommand code too (until the common parts are extracted out).

Tcl_Canceled(
    Tcl_Interp *interp,
    int flags)
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * Has the current script in progress for this interpreter been canceled
     * or is the stack being unwound due to the previous script cancellation?

     */

    if (!TclCanceled(iPtr)) {
        return TCL_OK;
    }

    /*
     * The CANCELED flag is a one-shot flag that is reset immediately upon
     * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will
     * continue to report that the script in progress has been canceled
     * thereby allowing the evaluation stack for the interp to be fully
     * unwound.
     */

    iPtr->flags &= ~CANCELED;

    /*
     * The CANCELED flag was detected and reset; however, if the caller
     * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR
     * (indicating that the script in progress has been canceled) if the
     * evaluation stack for the interp is being fully unwound.

     */

    if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
        return TCL_OK;
    }

    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        int length;

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
            message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);

        } else {
            length = 0;
        }

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
                message = "eval unwound";
            }
        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp, message, NULL);
        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.

     */

    return TCL_ERROR;




}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CancelEval --
 *

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
	return TCL_ERROR;
    }

    if (objc >= 3) {
	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
		Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {



	    return TCL_ERROR;
	}
    }
    if (objc == 4) {
	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);

	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
		options, TCL_LEAVE_ERR_MSG)) {
	    Tcl_DecrRefCount(options);



	    return TCL_ERROR;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;

    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);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[1]);
    return TCL_OK;
}

/*

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fsInfo = Tcl_FSFileSystemInfo(objv[1]);
    if (fsInfo == NULL) {
	Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		Tcl_GetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, fsInfo);
    return TCL_OK;
}

/*

	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
	Tcl_AppendResult(interp, "could not read \"", TclGetString(objv[1]),
		"\": no such file or directory", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

/*

	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
    } else {
	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);

	if (separatorObj == NULL) {
	    Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		    Tcl_GetString(objv[1]), NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, separatorObj);
    }
    return TCL_OK;
}


	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
		&statePtr->varcList[i], &statePtr->varvList[i]);
	if (statePtr->varcList[i] < 1) {
	    Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
		    "NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}

	statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	if (statePtr->aCopyList[i] == NULL) {
	    result = TCL_ERROR;

InfoDefaultCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *procName, *argName;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *valueObjPtr;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
	return TCL_ERROR;

    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)
		&& (strcmp(argName, localPtr->name) == 0)) {
	    if (localPtr->defValuePtr != NULL) {
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr = Tcl_NewObj();

		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	    }
	    return TCL_OK;
	}
    }

    Tcl_AppendResult(interp, "procedure \"", procName,
	    "\" doesn't have an argument \"", argName, "\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
    return TCL_ERROR;






}

/*
 *----------------------------------------------------------------------
 *
 * InfoErrorStackCmd --
 *

    Tcl_Interp *target;
    Interp *iPtr;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    target = interp;
    if (objc == 2) {
        target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
        if (target == NULL) {
            return TCL_ERROR;
        }
    }

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInfoExistsCmd --

	 * A coroutine: must fix the level computations AND the cmdFrame chain,
	 * which is interrupted at the base.
	 */

        CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
        CmdFrame *runPtr = iPtr->cmdFramePtr;
        CmdFrame *lastPtr = NULL;

        topLevel += corPtr->caller.cmdFramePtr->level;
        while (runPtr && (runPtr != corPtr->caller.cmdFramePtr)) {
            lastPtr = runPtr;
            runPtr = runPtr->nextPtr;
        }
        if (lastPtr && !runPtr) {
            lastPtr->nextPtr = corPtr->caller.cmdFramePtr;

    name = Tcl_GetHostName();
    if (name) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
	return TCL_OK;
    }
    Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoLevelCmd --

    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
    if (libDirName != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
	return TCL_OK;
    }
    Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoLoadedCmd --

    /*
     * Set the interpreter's object result to the last element extracted.
     */

    if (elemPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);
    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinsertObjCmd --
 *

{
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise set the interpreter's result object to be a list object.
     */

    if (objc > 1) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    if (result != TCL_OK) {
	return result;
    }

    if (Tcl_IsShared(objv[1]) ||
	    (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1)) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
		&elemPtrs[first]));
    } else {
	/*
	 * In-place is possible.
	 */

	if (last < (listLen - 1)) {
	    Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,

    }
    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_Format(NULL,
		"bad count \"%d\": must be integer >= 0", 1, objv+1));
        Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPEAT","NEGARG", NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;

    /*
     * Final sanity check. Total number of elements must fit in a signed
     * integer. We also limit the number of elements to 512M-1 so allocations
     * on 32-bit machines are guaranteed to be less than 2GB! [Bug 2130992]
     */

    totalElems = objc * elementCount;
    if (totalElems != 0 && (totalElems/objc != elementCount
	    || totalElems/elementCount != objc)) {
	Tcl_AppendResult(interp, "too many elements in result list", NULL);
        Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    if (totalElems >= 0x20000000) {
	Tcl_AppendResult(interp, "too many elements in result list", NULL);
        Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first >= listLen) && (listLen > 0)) {
	Tcl_AppendResult(interp, "list doesn't contain element ",
		TclGetString(objv[2]), NULL);
        Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPLACE","BADIDX", NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;

	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    if (i > objc-4) {
		Tcl_AppendResult(interp, "missing starting index", NULL);
                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    i++;
	    if (objv[i] == objv[objc - 2]) {
		/*
		 * Take copy to prevent shimmering problems. Note that it does

	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_AppendResult(interp,
			"\"-index\" option must be followed by list index",
			NULL);
                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Store the extracted indices for processing by sublist
	     * extraction. Note that we don't do this using objects because
	     * that has shimmering problems.

    if (returnSubindices && sortInfo.indexc==0) {
	if (startPtr != NULL) {
	    Tcl_DecrRefCount(startPtr);
	}
	Tcl_AppendResult(interp,
		"-subindices cannot be used without -index option", NULL);
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
                "BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
    }

    if (bisect && (allMatches || negatedMatch)) {
	Tcl_AppendResult(interp,
		"-bisect is not compatible with -all or -not", NULL);
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
                "BAD_OPTION_MIX", NULL);
	return TCL_ERROR;
    }

    if (mode == REGEXP) {
	/*
	 * We can shimmer regexp/list if listv[i] == pattern, so get the
	 * regexp rep before the list rep. First time round, omit the interp

	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i == objc-2) {
		Tcl_AppendResult(interp,
			"\"-command\" option must be followed "
			"by comparison command", NULL);
                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];
	    i++;
	    break;

	case LSORT_INDEX: {
            int indexc, dummy;
	    Tcl_Obj **indexv;

	    if (i == objc-2) {
		Tcl_AppendResult(interp, "\"-index\" option must be "
			"followed by list index", NULL);
                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
                sortInfo.resultCode = TCL_ERROR;
                goto done2;
	    }
	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
		    &indexv) != TCL_OK) {
                sortInfo.resultCode = TCL_ERROR;
                goto done2;

	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i == objc-2) {
		Tcl_AppendResult(interp, "\"-stride\" option must be ",
			"followed by stride length", NULL);
                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    if (groupSize < 2) {
		Tcl_AppendResult(interp, "stride length must be at least 2",
			NULL);
                Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
                        "BADSTRIDE", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done2;
	    }
	    group = 1;
	    i++;
	    break;
	}

     */

    if (group) {
	if (length % groupSize) {
	    Tcl_AppendResult(interp,
		    "list size must be a multiple of the stride length",
		    NULL);
            Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
                    NULL);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	length = length / groupSize;
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = sortInfo.indexv[0];
	    if (groupOffset <= SORTIDX_END) {
		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
	    }
	    if (groupOffset < 0 || groupOffset >= groupSize) {
		Tcl_AppendResult(interp, "when used with \"-stride\", the "
			"leading \"-index\" value must be within the group",
			NULL);
                Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
                        "BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {

	 */

	if (TclGetIntFromObj(infoPtr->interp,
		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
	    Tcl_ResetResult(infoPtr->interp);
	    Tcl_AppendResult(infoPtr->interp,
		    "-compare command returned non-integer result", NULL);
            Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
                    "COMPARISONFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return 0;
	}
    }
    if (!infoPtr->isIncreasing) {
	order = -order;
    }

	if (currentObj == NULL) {
	    char buffer[TCL_INTEGER_SPACE];

	    TclFormatInt(buffer, index);
	    Tcl_AppendResult(infoPtr->interp, "element ", buffer,
		    " missing from sublist \"", TclGetString(objPtr), "\"",
		    NULL);
            Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
                    "INDEXFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
    }
    return objPtr;
}

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * variable.
     */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {



	TclDecrRefCount(valueObj);
	goto error;
    }
    TclDecrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {



	goto error;
    }

    /*
     * Run the script.
     */

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * variable.
     */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {



	TclDecrRefCount(valueObj);
	result = TCL_ERROR;
	goto done;
    }
    TclDecrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {



	result = TCL_ERROR;
	goto done;
    }

    /*
     * Run the script.
     */

     * that's not allowed.
     */

    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
	    TCL_NAMESPACE_ONLY)) {
	Tcl_AppendResult(interp, "can't create object \"", nameStr,
		"\": command already exists with that name", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	return NULL;
    }

    /*
     * Create the object.
     */

	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...) [Bug 2903011]
	     */

	    if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
		Tcl_SetResult(interp, "object deleted in constructor",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    TclOODeleteContext(contextPtr);
	    if (result != TCL_OK) {
		Tcl_DiscardInterpState(state);

		/*

     * that's not allowed.
     */

    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
	    TCL_NAMESPACE_ONLY)) {
	Tcl_AppendResult(interp, "can't create object \"", nameStr,
		"\": command already exists with that name", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	return TCL_ERROR;
    }

    /*
     * Create the object.
     */

     * It's an error if the object was whacked in the constructor. Force this
     * if it isn't already an error (don't want to lose errors by accident...)
     * [Bug 2903011]
     */

    if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
	Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    TclOODeleteContext(contextPtr);
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*

    /*
     * Sanity checks.
     */

    if (targetName == NULL && oPtr->classPtr != NULL) {
	Tcl_AppendResult(interp, "must supply a name when copying a class",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "NO_COPY_TARGET", NULL);
	return NULL;
    }
    if (oPtr->flags & ROOT_CLASS) {
	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
	Tcl_DecrRefCount(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;
	}
    } else {
	/*
	 * Get the call chain.
	 */

    noMapping:
	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
		flags | (oPtr->flags & FILTER_HANDLING), NULL);
	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",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Check to see if we need to apply magical tricks to start part way
     * through the call chain.

	    if (miPtr->mPtr->declaringClassPtr == startCls) {
		break;
	    }
	}
	if (contextPtr->index >= contextPtr->callPtr->numChain) {
	    Tcl_SetResult(interp, "no valid method implementation",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    TclOODeleteContext(contextPtr);
	    return TCL_ERROR;
	}
    }

    /*
     * Invoke the call chain, locking the object structure against deletion

	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix

	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix

	}
    }
    return cmdPtr->objClientData;

  notAnObject:
    Tcl_AppendResult(interp, TclGetString(objPtr),
	    " does not refer to an object", NULL);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
	    NULL);
    return NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOIsReachable --

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
		"\" is not a class", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
		"\" is not a class", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
		"\" is not a class", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

    int isNew;

    if (!useClass) {
	if (!oPtr->methodsPtr) {
	noSuchMethod:
	    Tcl_AppendResult(interp, "method ", TclGetString(fromPtr),
		    " does not exist", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(fromPtr), NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr);
	if (hPtr == NULL) {
	    goto noSuchMethod;
	}
	if (toPtr) {
	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr,
		    &isNew);
	    if (hPtr == newHPtr) {
	    renameToSelf:
		Tcl_AppendResult(interp, "cannot rename method to itself",
			NULL);
		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
		return TCL_ERROR;
	    } else if (!isNew) {
	    renameToExisting:
		Tcl_AppendResult(interp, "method called ",
			TclGetString(toPtr), " already exists", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
		return TCL_ERROR;
	    }
	}
    } else {
	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
		(char *) fromPtr);
	if (hPtr == NULL) {

    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    int soughtLen;
    const char *soughtStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_AppendResult(interp, "bad call of unknown handler", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);

	Tcl_DecrRefCount(newObjv[0]);
	TclStackFree(interp, newObjv);
	return result;
    }

  noMatch:
    Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * FindCommand --

    CallFrame *framePtr, **framePtrPtr = &framePtr;
    int result;

    if (namespacePtr == NULL) {
	Tcl_AppendResult(interp,
		"cannot process definitions; support namespace deleted",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */

    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    namespacePtr, FRAME_IS_OO_DEFINE);

    Interp *iPtr = (Interp *) interp;

    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;
}

/*
 * ----------------------------------------------------------------------

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
    iPtr->varFramePtr = savedFramePtr;
    if (oPtr == NULL) {
	return NULL;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_AppendResult(interp, errMsg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(className), NULL);
	return NULL;
    }
    return oPtr->classPtr;
}

/*
 * ----------------------------------------------------------------------

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_AppendResult(interp, TclGetString(objv[1]),
		" does not refer to a class", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(objv[1]), NULL);
	return TCL_ERROR;
    }

    /*
     * Make the oo::define namespace the current namespace and evaluate the
     * command(s).
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_OBJECT) {
	Tcl_AppendResult(interp,
		"may not modify the class of the root object class", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_CLASS) {
	Tcl_AppendResult(interp,
		"may not modify the class of the class of classes", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse the argument to get the class to set the object's class to.
     */

     * produce an error if any attempt is made to swap from one to the other.
     */

    if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
	Tcl_AppendResult(interp, "may not change a ",
		(oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
		(oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
	return TCL_ERROR;
    }

    /*
     * Set the object's class.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Delete the method structure from the appropriate hash table.
	 */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceExport && !clsPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
	 * record. If there is no such method in this object or class (i.e.

    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceFilter && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    if (!isInstanceFilter) {
	TclOOClassSetFilters(interp, oPtr->classPtr, objc-1, objv+1);
    } else {
	TclOOObjectSetFilters(oPtr, objc-1, objv+1);

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceForward && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;

    /*
     * Create the method structure.

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceMethod && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;

    /*
     * Create the method by using the right back-end API.

    int i;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceMixin && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));

    for (i=1 ; i<objc ; i++) {
	Class *clsPtr = GetClassInOuterContext(interp, objv[i],
		"may only mix in classes");

	if (clsPtr == NULL) {
	    goto freeAndError;
	}
	if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
	    Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
	    goto freeAndError;
	}
	mixins[i-1] = clsPtr;
    }

    if (isInstanceMixin) {
	TclOOObjectSetMixins(oPtr, objc-1, mixins);

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceRenameMethod && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Delete the method entry from the appropriate hash table, and transfer
     * the thing it points to to its new entry. To do this, we first need to
     * get the entries from the appropriate hash tables (this can generate a

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_AppendResult(interp, "only classes may have superclasses defined",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "OBJECT_NOT_CLASS", NULL);
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_OBJECT) {
	Tcl_AppendResult(interp,
		"may not modify the superclass of the root object", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

	if (clsPtr == NULL) {
	    goto failedAfterAlloc;
	}
	for (j=0 ; j<i ; j++) {
	    if (superclasses[j] == clsPtr) {
		Tcl_AppendResult(interp,
			"class should only be a direct superclass once",NULL);
		Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
		goto failedAfterAlloc;
	    }
	}
	if (TclOOIsReachable(oPtr->classPtr, clsPtr)) {
	    Tcl_AppendResult(interp,
		    "attempt to form circular dependency graph", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	failedAfterAlloc:
	    ckfree(superclasses);
	    return TCL_ERROR;
	}
	superclasses[i] = clsPtr;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceUnexport && !clsPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
	 * method record. If there is no such method in this object or class

    int i;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceVars && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	const char *varName = Tcl_GetString(objv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not contain namespace separators",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not refer to an array element", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }
    for (i=1 ; i<objc ; i++) {
	Tcl_IncrRefCount(objv[i]);
    }

    }

    if (objc == 2) {
	Tcl_SetObjResult(interp,
		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
	return TCL_OK;
    } else {

	Class *mixinPtr, *o2clsPtr;
	int i;

	o2clsPtr = GetClassFromObj(interp, objv[2]);
	if (o2clsPtr == NULL) {







	    return TCL_ERROR;
	}

	FOREACH(mixinPtr, oPtr->mixins) {
	    if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
		return TCL_OK;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(
		TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
	return TCL_OK;
    }
}

/*
 * ----------------------------------------------------------------------
 *

	}
	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
	if (o2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (o2Ptr->classPtr == NULL) {
	    Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
	    return TCL_ERROR;
	} else {
	    Class *mixinPtr;

	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr == o2Ptr->classPtr) {
		    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));

	}
	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
	if (o2Ptr == NULL) {
	    return TCL_ERROR;
	}
	if (o2Ptr->classPtr == NULL) {
	    Tcl_AppendResult(interp, "non-classes cannot be types", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
	    return TCL_ERROR;
	}
	if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	}

    if (clsPtr->constructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
    if (procPtr == NULL) {
	Tcl_AppendResult(interp,
		"definition not available for this kind of method", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
	return TCL_ERROR;
    }

    resultObjs[0] = Tcl_NewObj();
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {

    if (clsPtr->destructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
    if (procPtr == NULL) {
	Tcl_AppendResult(interp,
		"definition not available for this kind of method", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
    return TCL_OK;
}


    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);

    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);

	 */

	for (i = 0; i < totalVars; i++) {
	    if (objs[i] == NULL) {
		continue;
	    }
	    result++;

	    /*
	     * In case of multiple errors in setting variables, just report
	     * the first one.
	     */

	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i],

		    (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) {
		code = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(objs[i]);
	}
    } else {
	/*
	 * Here no vars were specified, we want a list returned (inline scan)

	} else if (numVars) {
	    objPtr = Tcl_NewIntObj(result);
	}
	Tcl_SetObjResult(interp, objPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    memcpy(objPtr->bytes + oldLength, bytes, numBytes);
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendStringsToObjVA --
 *
 *	This function appends one or more null-terminated strings to an

Tcl_AppendFormatToObj(
    Tcl_Interp *interp,
    Tcl_Obj *appendObj,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *span = format, *msg, *errCode;
    int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
    int originalLength, limit;
    static const char *mixedXPG =
	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *const badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"

	if (ch != '%') {
	    numBytes += step;
	    continue;
	}
	if (numBytes) {
	    if (numBytes > limit) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    Tcl_AppendToObj(appendObj, span, numBytes);
	    limit -= numBytes;
	    numBytes = 0;
	}

		format = end + 1;
		step = Tcl_UtfToUniChar(format, &ch);
	    }
	}
	if (newXpg) {
	    if (gotSequential) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotXpg = 1;
	} else {
	    if (gotXpg) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotSequential = 1;
	}
	if ((objIndex < 0) || (objIndex >= objc)) {
	    msg = badIndex[gotXpg];
	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
	    goto errorMsg;
	}

	/*
	 * Step 2. Set of flags.
	 */

	if (isdigit(UCHAR(ch))) {
	    width = strtoul(format, &end, 10);
	    format = end;
	    step = Tcl_UtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
		goto error;
	    }
	    if (width < 0) {
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = Tcl_UtfToUniChar(format, &ch);
	}
	if (width > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.
	 */

	gotPrecision = precision = 0;
	if (ch == '.') {
	    gotPrecision = 1;
	    format += step;
	    step = Tcl_UtfToUniChar(format, &ch);
	}
	if (isdigit(UCHAR(ch))) {
	    precision = strtoul(format, &end, 10);
	    format = end;
	    step = Tcl_UtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &precision)
		    != TCL_OK) {
		goto error;
	    }

	numChars = -1;
	if (ch == 'i') {
	    ch = 'd';
	}
	switch (ch) {
	case '\0':
	    msg = "format string ended in middle of field specifier";
	    errCode = "INCOMPLETE";
	    goto errorMsg;
	case 's':
	    if (gotPrecision) {
		numChars = Tcl_GetCharLength(segment);
		if (precision < numChars) {
		    segment = Tcl_GetRange(segment, 0, precision - 1);
		    numChars = precision;

	    allocSegment = 1;
	    break;
	}

	case 'u':
	    if (useBig) {
		msg = "unsigned bignum format is invalid";
		errCode = "BADUNSIGNED";
		goto errorMsg;
	    }
	case 'd':
	case 'o':
	case 'x':
	case 'X':
	case 'b': {

		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		Tcl_AppendToObj(segment, bytes, toAppend);
		Tcl_DecrRefCount(pure);
		break;
	    }

			    (((Tcl_WideInt) big.used * DIGIT_BIT) / numBits);
		    while ((mask & big.dp[big.used-1]) == 0) {
			numDigits--;
			mask >>= numBits;
		    }
		    if (numDigits > INT_MAX) {
			msg = overflow;
			errCode = "OVERFLOW";
			goto errorMsg;
		    }
		} else if (!useBig) {
		    unsigned long ul = (unsigned long) l;

		    bits = (Tcl_WideUInt) ul;
		    while (ul) {

		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		Tcl_AppendObjToObj(segment, pure);
		Tcl_DecrRefCount(pure);
		break;
	    }

		} 
	    }
	    if (gotPrecision) {
		*p++ = '.';
		p += sprintf(p, "%d", precision);
		if (precision > INT_MAX - length) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		length += precision;
	    }

	    /*
	     * Don't pass length modifiers!
	     */

	    *p++ = (char) ch;
	    *p = '\0';

	    segment = Tcl_NewObj();
	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    break;
	}
	default:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
	    }
	    goto error;
	}

	switch (ch) {
	case 'E':
	case 'G':

	Tcl_GetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}
	Tcl_AppendObjToObj(appendObj, segment);
	limit -= segmentNumBytes;
	if (allocSegment) {
	    Tcl_DecrRefCount(segment);
	}

	}

	objIndex += gotSequential;
    }
    if (numBytes) {
	if (numBytes > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}
	Tcl_AppendToObj(appendObj, span, numBytes);
	limit -= numBytes;
	numBytes = 0;
    }

    return TCL_OK;

  errorMsg:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
	Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
    }
  error:
    Tcl_SetObjLength(appendObj, originalLength);
    return TCL_ERROR;
}

/*

	    } else if (ii > info.nsubs) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
	if (valuePtr == NULL) {


	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result to an integer object w/ value 1.
     */

	    || objv[1]->typePtr == &tclWideIntType
#endif
	    || objv[1]->typePtr == &tclBignumType
	    || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
		    &index) != TCL_OK)) {
	index = -1;
	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
            const char *arg = Tcl_GetString(objv[1]);

	    Tcl_AppendResult(interp, "bad argument \"", arg,

		    "\": must be cancel, idle, info, or an integer", NULL);
            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
                    arg, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * At this point, either index = -1 and ms contains the number of ms
     * to wait, or else index is the index of a subcommand.

	tsdPtr->afterId += 1;
	afterPtr->token = NULL;
	afterPtr->nextPtr = assocPtr->firstAfterPtr;
	assocPtr->firstAfterPtr = afterPtr;
	Tcl_DoWhenIdle(AfterProc, afterPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
	break;
    case AFTER_INFO:


	if (objc == 2) {
	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
		    afterPtr = afterPtr->nextPtr) {
		if (assocPtr->interp == interp) {
		    sprintf(buf, "after#%d", afterPtr->id);
		    Tcl_AppendElement(interp, buf);
		}
	    }
	    return TCL_OK;
	}
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
	    return TCL_ERROR;
	}
	afterPtr = GetAfterEvent(assocPtr, objv[2]);
	if (afterPtr == NULL) {
            const char *eventStr = TclGetString(objv[2]);

	    Tcl_AppendResult(interp, "event \"", eventStr, "\" doesn't exist",
                    NULL);
            Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
	    return TCL_ERROR;
	} else {
            Tcl_Obj *resultListPtr = Tcl_NewObj();

            Tcl_ListObjAppendElement(interp, resultListPtr,
                    afterPtr->commandPtr);
            Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (afterPtr->token == NULL) ? "idle" : "timer", -1));
            Tcl_SetObjResult(interp, resultListPtr);

        }
	break;
    default:
	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
    }
    return TCL_OK;
}

/*

#endif /* TCL_REMOVE_OBSOLETE_TRACES */
    }
    return TCL_OK;

  badVarOps:
    Tcl_AppendResult(interp, "bad operations \"", flagOps,
	    "\": should be one or more of rwua", NULL);
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionObjCmd --

	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of enter, leave, enterstep, or leavestep",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of delete or rename", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}

	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of array, read, unset, or write", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen ; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }

	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
		    Tcl_DStringLength(&cmd), 0);
	    if (rewind) {
		((Interp *)interp)->execEnvPtr->rewind = rewind;
	    }
	    if (code != TCL_OK) {		/* copy error msg to result */
		Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);

		Tcl_IncrRefCount(errMsgObj);
		result = (char *) errMsgObj;
	    }
	    Tcl_DStringFree(&cmd);
	}
    }
    if (destroy && result != NULL) {

	    break;
	}
	if (i >= size) {
	    ckfree(argv);
	    if (interp != NULL) {
		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (brace) {
	    memcpy(p, element, (size_t) elSize);
	    p += elSize;

    const char *reStr,
    int reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;

    strEnd = reStr + reStrLen;
    Tcl_DStringInit(dsPtr);

    /*
     * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
     */

     * possible. Do not alter the start of str so we can free it correctly.
     *
     * Keep track of the last char being an unescaped star to prevent multiple
     * instances.  Simpler than checking that the last star may be escaped.
     */

    msg = NULL;
    code = NULL;
    p = reStr;
    anchorRight = 0;
    lastIsStar = 0;
    numStars = 0;

    if (*p == '^') {
	anchorLeft = 1;

		/* fall through */
	    case '{': case '}': case '(': case ')': case '+':
	    case '.': case '|': case '^': case '$':
		*dsStr++ = *p;
		break;
	    default:
		msg = "invalid escape sequence";
		code = "BADESCAPE";
		goto invalidGlob;
	    }
	    break;
	case '.':
	    anchorLeft = 0; /* prevent exact match */
	    if (p+1 < strEnd) {
		if (p[1] == '*') {

		}
	    }
	    *dsStr++ = '?';
	    break;
	case '$':
	    if (p+1 != strEnd) {
		msg = "$ not anchor";
		code = "NONANCHOR";
		goto invalidGlob;
	    }
	    anchorRight = 1;
	    break;
	case '*': case '+': case '?': case '|': case '^':
	case '{': case '}': case '(': case ')': case '[': case ']':
	    msg = "unhandled RE special char";
	    code = "UNHANDLED";
	    goto invalidGlob;

	default:
	    *dsStr++ = *p;
	    break;
	}
	lastIsStar = 0;
    }
    if (numStars > 1) {
	/*
	 * Heuristic: if >1 non-anchoring *, the risk is large that glob
	 * matching is slower than the RE engine, so report invalid.
	 */

	msg = "excessive recursive glob backtrack potential";
	code = "OVERCOMPLEX";
	goto invalidGlob;
    }

    if (!anchorRight && !lastIsStar) {
	*dsStr++ = '*';
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

#if 0
    fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
	    reStrLen, reStr, msg, *p);
    fflush(stderr);
#endif
    if (interp != NULL) {
	Tcl_AppendResult(interp, msg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	    file copy -force $s [file join $dest [file tail $s]]
	}
    }
    return
}

# TIP 131
if 0 {
proc tcl::rmmadwiw {} {
    set magic {
        42 83 fe f6 ff f8 f1 e5 c6 f9 eb fd ff fb f1 e5 cc f5 ec f5 e3 fd fe
        ff f5 fa f3 e1 c7 f9 f2 fd ff f9 fe f9 ed f4 fa f6 e6 f9 f2 e6 fd f9
        ff f9 f6 e6 fa fd ff fc fb fc f9 f1 ed
    }
    foreach mystic [lassign $magic tragic] {

    set mind ""
    while {$age} {
        lappend mind [expr {$age%13}]
        set age [expr {$age/13}]
    }
    set matter [lreverse $mind]
    return [join $matter ""]
}
}

(this page also has a link to searchable archives of the list, please check them
before asking on the list, many questions have already been answered).

- For general Tcl/Tk questions, the newsgroup comp.lang.tcl is your best bet:
	http://groups.google.com/group/comp.lang.tcl/

- The Tcl'ers Wiki also has many pages dealing with Tcl & Tk on Mac OS X, see
	http://wiki.tcl.tk/_/ref?N=3753
	http://wiki.tcl.tk/_/ref?N=8361

- Please report bugs with Tcl or Tk on Mac OS X to the sourceforge bug trackers:





	http://tcl.sourceforge.net/

2. Using Tcl on Mac OS X
------------------------

- At a minimum, Mac OS X 10.3 is required to run Tcl.

- Unless weak-linking is used, Tcl built on Mac OS X 10.x will not run on 10.y

		F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
		F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
		F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
		F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
		F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
		F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
		F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };

		F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
		F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
		F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
		F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
		F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
		F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };

				F96D446308F272B9004A47F5 /* tclUnixInit.c */,
				F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
				F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
				F96D446608F272B9004A47F5 /* tclUnixPort.h */,
				F96D446708F272B9004A47F5 /* tclUnixSock.c */,
				F96D446808F272B9004A47F5 /* tclUnixTest.c */,
				F96D446908F272B9004A47F5 /* tclUnixThrd.c */,

				F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
				F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
				F96D446D08F272B9004A47F5 /* tclXtTest.c */,
			);
			path = unix;
			sourceTree = "<group>";
		};

		F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
		F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
		F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
		F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
		F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
		F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
		F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };

		F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
		F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
		F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
		F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
		F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
		F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };

				F96D446308F272B9004A47F5 /* tclUnixInit.c */,
				F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
				F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
				F96D446608F272B9004A47F5 /* tclUnixPort.h */,
				F96D446708F272B9004A47F5 /* tclUnixSock.c */,
				F96D446808F272B9004A47F5 /* tclUnixTest.c */,
				F96D446908F272B9004A47F5 /* tclUnixThrd.c */,

				F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
				F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
				F96D446D08F272B9004A47F5 /* tclXtTest.c */,
			);
			path = unix;
			sourceTree = "<group>";
		};

test error-3.2 {errors in catch command} {
    list [catch {catch a b c} msg] $msg
} {0 1}
test error-3.3 {errors in catch command} {
    catch {unset a}
    set a(0) 22
    list [catch {catch {format 44} a} msg] $msg
} {1 {can't set "a": variable is array}}
catch {unset a}

# More tests related to errorInfo and errorCode

test error-4.1 {errorInfo and errorCode variables} {
    list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 msg3}

	throw FOO bar
    } on error {res opts} {
	set r "$res,[dict get $opts -errorcode]"
    }
} {bar,FOO}
test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} {
    try { throw FOO bar } on error {res opts} { list d e f }
    set r "$res,[dict get $opts -errorcode]"
} {bar,FOO}
test error-12.6 {try result is propagated if no matching handler} {
    try { list a b c } on error {} { list d e f }
} {a b c}
test error-12.7 {handler result is propagated if handler executes} {
    try { throw FOO bar } on error {} { list d e f }
} {d e f}

    # warning: error message may change
    try list on error {em opts}
} -returnCodes error -match glob -result {wrong # args to on clause: *}
test error-13.8 {try with multiple handlers and finally (ok)} {
    try list on error {} {} trap {} {} {} finally {}
} {}
test error-13.9 {last handler body can't be a fallthrough #1} -body {
    try list on error {} {} on break {} -
} -returnCodes error -result {last non-finally clause must not have a body of "-"}
test error-13.10 {last handler body can't be a fallthrough #2} -body {
    try list on error {} {} on break {} - finally { list d e f }
} -returnCodes error -result {last non-finally clause must not have a body of "-"}

# try tests - multiple handlers (left-to-right matching, only one runs)

test error-14.1 {try with multiple handlers (only one matches) #1} {
    try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f }
} {d e f}
test error-14.2 {try with multiple handlers (only one matches) #2} {
    try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c }
} {d e f}
test error-14.3 {try with multiple handlers (only one matches) #3} {
    try {
	throw FOO bar
    } on break {} {
	list x y z
    } trap FOO {} {
	list d e f
    } on ok {} {
	list a b c
    }
} {d e f}
test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} {
    try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f }
} {a b c}
test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} {
    try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c }
} {d e f}

} {5}
test error-16.6 {try with variable assignment and propagation #1} {
    # Ensure that the handler variables preserve the exception off the
    # try-body, and are not modified by the exception off the handler
    catch {
	try { throw FOO bar } trap FOO {em} { throw BAR baz }
    }
    set em
} {bar}
test error-16.7 {try with variable assignment and propagation #2} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}
test error-16.8 {exception chaining (try=ok, handler=error)} {
    #FIXME is the intent of this test correct?
    catch {
	try { list a b c } on ok {em opts} { throw BAR baz }
    } tryem tryopts
    string equal $opts [dict get $tryopts -during]
} {1}
test error-16.9 {exception chaining (try=error, handler=error)} {
    # The exception off the handler should chain to the exception off the

    } result
    list $em $result
} {bar {d e f}}
test error-17.11 {successful finally doesn't affect variable assignment or propagation} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}

# try tests - propagation (exceptions in finally, exception chaining)

test error-18.1 {try (ok) with exception in finally (error)} -body {
    try { list a b c } finally { throw BAR foo }
} -returnCodes error -result {foo}
test error-18.2 {try (error) with exception in finally (break)} -body {
    try { throw FOO bar } finally { break }
} -returnCodes 3 -result {}
test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body {
    try { list a b c } on ok {} { list d e f } finally { throw BAR foo }
} -returnCodes error -result {foo}
test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body {
    try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing }
} -returnCodes 99 -result {zing}
test error-18.5 {exception in finally doesn't affect variable assignment} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}
test error-18.6 {exception chaining in finally (try=ok)} {
    catch {
	list a b c
    } em expopts
    catch {
	try { list a b c } finally { throw BAR foo }
    } em opts
    string equal $expopts [dict get $opts -during]
} {1}
test error-18.7 {exception chaining in finally (try=error)} {

test error-19.1 {try with fallthrough body #1} {
    set RES {}
    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
    set RES
} {1}
test error-19.2 {try with fallthrough body #2} {
    set RES {}
    try {
	throw FOO bar
    } trap BAR {} {
    } trap FOO {} - trap {} {} {
	set RES foo
    } on error {} {
	set RES err
    }
    set RES
} {foo}
test error-19.3 {try with cascade fallthrough} {
    set RES {}
    try {
	throw FOO bar
    } trap FOO {} - trap BAR {} - trap {} {} {
	set RES trap
    } on error {} { set RES err }
    set RES
} {trap}
test error-19.4 {multiple unrelated fallthroughs #1} {
    set RES {}
    try {
	throw FOO bar
    } trap FOO {} - trap BAR {} {
	set RES foo
    } trap {} {} - on error {} {
	set RES err
    }
    set RES
} {foo}
test error-19.5 {multiple unrelated fallthroughs #2} {
    set RES {}
    try {
	throw BAZ zing
    } trap FOO {} - trap BAR {} {
	set RES foo
    } trap {} {} - on error {} {
	set RES err
    }
    set RES
} {err}
proc addmsg msg {
    variable RES
    lappend RES $msg
}
test error-19.6 {compiled try executes all clauses} -setup {


}
namespace delete ::tcl::test::error

# cleanup
catch {rename p ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
    catch {unset a}
} -cleanup {unset a} -body {
    set a(0) 88
    proc t1 {a b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.10 {info default option} -setup {
    catch {unset a}
} -cleanup {unset a} -body {
    set a(0) 88
    proc t1 {{a 18} b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.11 {info default option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info default p x foo] $foo [info default q y bar] $bar
    }
} {0 {} 1 27}

test info-30.46 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(1825) YES;  set a(1824) 1824; set a(1826) 1826
    subst {$a([dict get [info frame 0] line])} ; # 1825
} YES
test info-30.47 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(\n1831) YES;  set a(\n1830) 1830; set a(\n1832) 1832
    subst {$a(
[dict get [info frame 0] line])} ; # 1831
} YES
unset -nocomplain a

test info-30.48 {Bug 2850901} testevalex {
    testevalex {return -level 0 [format %s {}

    set x {}
    set y {}
    catch {unset z}; array set z {}
    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
	    $msg $x $y]
    unset z
    set result
} {1 {can't set "z": variable is array} abc ghi}
test scan-4.61 {Tcl_ScanObjCmd, set errors} {
    set x {}
    catch {unset y}; array set y {}
    catch {unset z}; array set z {}
    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
	    $msg $x]
    unset y
    unset z
    set result
} {1 {can't set "z": variable is array} abc}

# procedure that returns the range of integers

proc int_range {} {
    for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
	set MIN_INT [expr { $MIN_INT << 1 }]
    }

    set a {}; set b {}; set c {}; set d {}
    list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
} {2 1 2 {} {}}
test scan-8.12 {error conditions} {
    catch {unset a}
    set a(0) 44
    list [catch {scan 44 %d a} msg] $msg
} {1 {can't set "a": variable is array}}
test scan-8.13 {error conditions} {
    catch {unset a}
    set a(0) 44
    list [catch {scan 44 %c a} msg] $msg
} {1 {can't set "a": variable is array}}
test scan-8.14 {error conditions} {
    catch {unset a}
    set a(0) 44
    list [catch {scan 44 %s a} msg] $msg
} {1 {can't set "a": variable is array}}
test scan-8.15 {error conditions} {
    catch {unset a}
    set a(0) 44
    list [catch {scan 44 %f a} msg] $msg
} {1 {can't set "a": variable is array}}
test scan-8.16 {error conditions} {
    catch {unset a}
    set a(0) 44
    list [catch {scan 44 %f a} msg] $msg
} {1 {can't set "a": variable is array}}
catch {unset a}
test scan-8.17 {error conditions} {
    list [catch {scan 44 %2c a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
test scan-8.18 {error conditions} {
    list [catch {scan abc {%[} x} msg] $msg
} {1 {unmatched [ in format string}}

you'll see a much more substantial printout for each error. See the README
file in the "tests" directory for more information on the test suite. Note:
don't run the tests as superuser: this will cause several of them to fail. If
a test is failing consistently, please send us a bug report with as much
detail as you can manage. Please use the online database at
	http://tcl.sourceforge.net/

Tcl 8.6 for Windows

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

This is the directory where you configure and compile the Windows
version of Tcl.  This directory also contains source files for Tcl
that are specific to Microsoft Windows.

The information in this file is maintained on the web at:

	http://www.tcl.tk/doc/howto/compile.html#win




2. Compiling Tcl
----------------

In order to compile Tcl for Windows, you need the following:

	Tcl 8.6 Source Distribution (plus any patches)