.sp
\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR)
.sp
int
\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
.sp
int
\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR)
\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, flags, intPtr\fR)
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp

.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP int endValue in
\fBTcl_GetIntForIndex\fR will return this when the input value is "end".
.AP int flags in
\fBTcl_GetIntForIndex\fR will behave more strict when flags is not 0. Any
combination of TCL_INDEX_ERROR, TCL_INDEX_NOMIN or TCL_INDEX_NOMAX is accepted.
.AP int intValue in
Integer value used to initialize or set a Tcl value.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.
.AP Tcl_Obj *objPtr in/out

declare 644 {
    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
	    int type, int size)
}

declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int endValue, int *indexPtr)
	    int endValue, int flags, int *indexPtr)
}

# TIP #548
declare 646 {
    int Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {

/*
 * Flags values passed to Tcl_RegExpExecObj.
 */

#define	TCL_REG_NOTBOL	0001	/* Beginning of string does not match ^.  */
#define	TCL_REG_NOTEOL	0002	/* End of string does not match $. */

/*
 * Flags values passed to Tcl_GetIntForIndex().
 */

#define	TCL_INDEX_ERROR	0x100	/* Generate "out of range" errors when index < 0 */
#define	TCL_INDEX_NOMIN	0x200	/* Convert values < 0 to 0 (or generate error for this) */
#define	TCL_INDEX_NOMAX	0x400	/* Convert values > end to end (or generate error for this) */

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {

    /*
     * Get the index. "end" is interpreted to be the index after the last
     * element, such that using it will cause any inserted elements to be
     * appended to the list.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, TCL_INDEX_NOMIN|TCL_INDEX_NOMAX|TCL_INDEX_ERROR, &index);
    if (result != TCL_OK) {
	return result;
    }
    if (index > len) {
	index = len;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
	    &first);
	    TCL_INDEX_ERROR, &first);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
	    TCL_INDEX_ERROR, &last);
    if (result != TCL_OK) {
	return result;
    }

    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    return TCL_OK;
}

    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = (int *)ckalloc((objc - 2) * sizeof(int));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
		TCL_INDEX_ERROR, &idxv[i - 2]) != TCL_OK) {
	    ckfree(idxv);
	    return TCL_ERROR;
	}
    }

    /*
     * Sort the indices, large to small so that when we remove an index we

    /*
     * Get the first and last indexes. "end" is interpreted to be the index
     * for the last element, such that using it will cause that element to be
     * included for deletion.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first);
    result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, TCL_INDEX_ERROR, &first);
    if (result != TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, TCL_INDEX_ERROR, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    }

    }

    /*
     * Get the user-specified start offset.
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	result = TclGetIntForIndexM(interp, startPtr, listc-1, TCL_INDEX_ERROR, &start);
	if (result != TCL_OK) {
	    goto done;
	}
	if (start == TCL_INDEX_NONE) {
	    start = TCL_INDEX_START;
	}

	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    int temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, &temp) != TCL_OK) {
	    if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, TCL_INDEX_ERROR, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);

     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	TclGetIntForIndexM(interp, startIndex, stringLength, TCL_INDEX_ERROR, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);

	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    int temp;
	    if (++idx >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, &temp) != TCL_OK) {
	    if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, TCL_INDEX_ERROR, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[idx];
	    Tcl_IncrRefCount(startIndex);

    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	TclGetIntForIndexM(interp, startIndex, stringLength, TCL_INDEX_ERROR, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 0)

		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, TCL_INDEX_ERROR, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;
}


		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, TCL_INDEX_ERROR, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;
}


    }

    /*
     * Get the char length to calculate what 'end' means.
     */

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], length-1, TCL_INDEX_ERROR, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index >= 0) && (index < length)) {
	int ch = Tcl_GetUniChar(objv[1], index);

	if (ch == -1) {

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], length, TCL_INDEX_ERROR, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index < 0) {
	index = 0;
    }
    if (index > length) {

    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",
	"list",		"lower",	"print",	"punct",
	"space",	"true",		"upper",	"wideinteger",
	"wordchar",	"xdigit",	NULL
	"entier",	"false",	"graph",	"index",
	"integer",	"list",		"lower",	"none",
	"print",	"punct",	"space",	"true",
	"upper",	"wideinteger", "wordchar",	"xdigit",	NULL
    };
    enum isClasses {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT,	STR_IS_DIGIT,	STR_IS_DOUBLE,
	STR_IS_ENTIER,	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,
	STR_IS_LIST,	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,
	STR_IS_SPACE,	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,
	STR_IS_WORD,	STR_IS_XDIGIT
	STR_IS_ENTIER,	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INDEX,
	STR_IS_INT,	STR_IS_LIST,	STR_IS_LOWER,	STR_IS_NONE,
	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,	STR_IS_TRUE,
	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,	STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };

	    /*
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    result = 0;
	    failat = 0;
	}
	break;
    case STR_IS_INDEX:
    case STR_IS_NONE:
	if (TCL_OK == TclGetWideForIndex(NULL, objPtr, (unsigned)-2, 0, &w)) {
		if ((w < -1) || (w > (unsigned)-1) || ((STR_IS_NONE == (enum isClasses) index) && (w != -1))) {
		    result = 0;
		}
	} else {
	    result = 0;
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

	string1 = TclGetStringFromObj(objPtr, &length1);

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    length = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], length, TCL_INDEX_ERROR, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, TCL_INDEX_ERROR, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (first < 0) {
	first = 0;
    }
    if (last >= length) {

	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], end, TCL_INDEX_ERROR, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, TCL_INDEX_ERROR, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, TCL_INDEX_ERROR, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index >= numChars) {
	index = numChars - 1;
    }
    cur = 0;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, TCL_INDEX_ERROR, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index < 0) {
	index = 0;
    }
    if (index < numChars) {

	Tcl_SetObjResult(interp, resultPtr);
    } else {
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp, objv[2], length1, TCL_INDEX_NOMIN|TCL_INDEX_ERROR, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
		TCL_INDEX_ERROR, &last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {

	Tcl_SetObjResult(interp, resultPtr);
    } else {
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp, objv[2], length1, TCL_INDEX_NOMIN|TCL_INDEX_ERROR, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
		TCL_INDEX_ERROR, &last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {

	Tcl_SetObjResult(interp, resultPtr);
    } else {
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	if (TclGetIntForIndexM(interp,objv[2],length1, TCL_INDEX_NOMIN|TCL_INDEX_ERROR, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
		TCL_INDEX_ERROR, &last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	if (last < first) {

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushStringLiteral(envPtr, "0");
    PushStringLiteral(envPtr, "::");
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
    off = CurrentOffset(envPtr);
    /* TODO: If INST_STR_FIND_LAST results in -1, we shouldn't substract
     * "1" since that leads to the deprecated index "-2". See TIP #577 */
    PushStringLiteral(envPtr, "1");
    TclEmitOpcode(	INST_SUB,			envPtr);
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    TclEmitOpcode(	INST_STR_INDEX,			envPtr);
    PushStringLiteral(envPtr, ":");
    TclEmitOpcode(	INST_STR_EQ,			envPtr);

    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict", "digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"false",	"graph",	"index",	"integer",	"list",
	"lower",	"none",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",
	"xdigit",	NULL
    };
    enum isClasses {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT, STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LIST,
	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INDEX,	STR_IS_INT,	STR_IS_LIST,
	STR_IS_LOWER,	STR_IS_NONE,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
	STR_IS_XDIGIT
    };
    int t, range, allowEmpty = 0, end;
    InstStringClassType strClassType;
    Tcl_Obj *isClass;

	    FIXJUMP1(	satisfied);
	}
	PUSH(		"1");
	FIXJUMP1(	end);
	return TCL_OK;
    }

    case STR_IS_INDEX:
    case STR_IS_NONE:
	/* Not implemented yet */
	return TCL_ERROR;
	break;
    case STR_IS_INT:
    case STR_IS_WIDE:
    case STR_IS_ENTIER:
	if (allowEmpty) {
	    int testNumType;

	    OP(		DUP);

EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				int size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int endValue, int *indexPtr);
				Tcl_Obj *objPtr, int endValue, int flags,
				int *indexPtr);
/* 646 */
EXTERN int		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src, int length,

    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int flags, int *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& !TclHasIntRep(value2Ptr, &tclListType)
		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
			&index) == TCL_OK)) {
			TCL_INDEX_ERROR, &index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}

	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);

	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calulate what 'end' means.
	 */

	length = Tcl_GetCharLength(valuePtr);
	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
	if (TclGetIntForIndexM(interp, value2Ptr, length-1, TCL_INDEX_ERROR, &index)!=TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {

	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
	length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
		    &fromIdx) != TCL_OK
		    TCL_INDEX_ERROR, &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
		    &toIdx) != TCL_OK) {
		    TCL_INDEX_ERROR, &toIdx) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}

	if (fromIdx < 0) {
	    fromIdx = 0;
	}

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	endIdx = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
		    &fromIdx) != TCL_OK
		    TCL_INDEX_ERROR, &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
		    &toIdx) != TCL_OK) {
		    TCL_INDEX_ERROR, &toIdx) != TCL_OK) {
	    TclDecrRefCount(value3Ptr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);

#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#ifdef TCL_NO_DEPRECATED
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
#define TclGetIntForIndexM(interp, objPtr, endValue, flags, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (flags), (idxPtr)))
#else
#define TclGetIntForIndexM(interp, objPtr, endValue, flags, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (flags) & ~(TCL_INDEX_ERROR|TCL_INDEX_NOMIN|TCL_INDEX_NOMAX), (idxPtr)))
#endif

MODULE_SCOPE int TclGetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, int flags, Tcl_WideInt *widePtr);

/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);

MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;

/*
 * Variables denoting the hash key types defined in the core.
 */

MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;

     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP#22 and TIP#33 for the details.
     */

    ListGetIntRep(argPtr, listRepPtr);
    if ((listRepPtr == NULL)
	    && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) {
	    && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, TCL_INDEX_ERROR, &index) == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

	     */

	    break;
	}
	TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
		TCL_INDEX_ERROR, &index) == TCL_OK) {
	    if (index<0 || index>=listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, &index)
		    if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, TCL_INDEX_ERROR, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		listPtr = Tcl_NewObj();
	    } else {

    int index;			/* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;
    List *listRepPtr;

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     * shimmering; see TIP #22 and #23 for details. Don't allow "" as single
     * index here, since it cannot be distinguished from an empty list.
     */

    ListGetIntRep(indexArgPtr, listRepPtr);
    if (listRepPtr == NULL
	    && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
    if (listRepPtr == NULL && Tcl_GetString(indexArgPtr)[0]
	    && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, TCL_INDEX_ERROR, &index) == TCL_OK) {
	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

    }

	}

	/*
	 * WARNING: the macro TclGetIntForIndexM is not safe for
	 * post-increments, avoid '*indexArray++' here.
	 */

	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, TCL_INDEX_ERROR, &index)
		!= TCL_OK)  {
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++;
	    break;
	}
	indexArray++;

	(nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 */

#if defined(TCL_NO_DEPRECATED) || (TCL_MAJOR_VERSION > 8)
    /* TODO: Fix TclCompileNamespaceQualifiersCmd, so it doesn't use index "-2",
     * which arises from substracting "1" from "-1" */
#   define TclCompileNamespaceQualifiersCmd NULL
#endif

static const EnsembleImplMap defaultNamespaceMap[] = {
    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},

     * Assume that there will never be more than INT_MAX subexpressions. This
     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
     * well and Tcl has other limits that constrain things as well...
     */

    resultObj = Tcl_NewObj();
    Tcl_ListObjAppendElement(NULL, resultObj,
	    Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub));
	    Tcl_NewWideIntObj(regexpPtr->re.re_nsub));

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
    for (inf=infonames ; inf->bit != 0 ; inf++) {

#   define TclBN_s_mp_sub 0
#else /* TCL_NO_DEPRECATED */
#   define Tcl_SeekOld seekOld
#   define Tcl_TellOld tellOld
#   define TclBackgroundException Tcl_BackgroundException
#   define TclSetStartupScript Tcl_SetStartupScript
#   define TclGetStartupScript Tcl_GetStartupScript
#   define TclGetIntForIndex Tcl_GetIntForIndex
#   define TclCreateNamespace Tcl_CreateNamespace
#   define TclDeleteNamespace Tcl_DeleteNamespace
#   define TclAppendExportList Tcl_AppendExportList
#   define TclExport Tcl_Export
#   define TclImport Tcl_Import
#   define TclForgetImport Tcl_ForgetImport
#   define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
#   define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
#   define TclFindNamespace Tcl_FindNamespace
#   define TclFindCommand Tcl_FindCommand
#   define TclGetCommandFromObj Tcl_GetCommandFromObj
#   define TclGetCommandFullName Tcl_GetCommandFullName
#   define TclpLocaltime_unix TclpLocaltime
#   define TclpGmtime_unix TclpGmtime

#   define TclGetIntForIndex GetIntForIndex
static int TclGetIntForIndex(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int endValue,
	int *indexPtr)
{
    return Tcl_GetIntForIndex(interp, objPtr, endValue, 0, indexPtr);
}

static int
seekOld(
    Tcl_Channel chan,		/* The channel on which to seek. */
    int offset,			/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{

	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }

    bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, TCL_INDEX_ERROR|TCL_INDEX_NOMIN, &offset)) {
	    return TCL_ERROR;
	}
	if (offset < 0) {
	    offset = 0;
	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, bytes);

    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int numBytes, len, limit = -1;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes,
		    TCL_INDEX_ERROR|TCL_INDEX_NOMIN, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {
		limit = numBytes + 1;
	    }
	}
	len = Tcl_NumUtfChars(bytes, limit);

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(ClientData clientData);
static void		FreeThreadHash(ClientData clientData);
static int		GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *widePtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    int stringLength, const char *typeStr,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, int *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * for it. This is a caching intrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
const Tcl_ObjType tclEndOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};


    }
    return numFormatted;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWideForIndex --
 * TclGetWideForIndex --
 *
 *	This function produces a wide integer value corresponding to the
 *	index value held in *objPtr. The parsing supports all values
 *	recognized as any size of integer, and the syntaxes end[-+]$integer
 *	and $integer[-+]$integer. The argument endValue is used to give
 *	the meaning of the literal index value "end". Index arithmetic
 *	on arguments outside the wide integer range are only accepted

 *
 * Side effects:
 *	The type of *objPtr may change.
 *
 *----------------------------------------------------------------------
 */

static int
GetWideForIndex(
int
TclGetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
                                 * NULL, then no error message is left after
                                 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    size_t endValue,            /* The value to be stored at *widePtr if
                                 * objPtr holds "end".
                                 * NOTE: this value may be TCL_INDEX_NONE. */
	int flags,
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    int numType;
    ClientData cd;
    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    if ((*widePtr > (Tcl_WideInt)endValue) && (flags & TCL_INDEX_NOMAX)) {
		if (flags & TCL_INDEX_ERROR) goto invalidWideIndex;
		*widePtr = (Tcl_WideInt)endValue;
	    }
	    if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) {
		if (flags & TCL_INDEX_ERROR) goto invalidWideIndex;
		*widePtr = 0;
	    }
	    if ((*widePtr < -1) && (flags & TCL_INDEX_ERROR)) goto invalidWideIndex;
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    if ((*widePtr > (Tcl_WideInt)endValue) && (flags & TCL_INDEX_NOMAX)) {
		if (flags & TCL_INDEX_ERROR) goto invalidWideIndex;
		*widePtr = (Tcl_WideInt)endValue;
	    }
	    if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) {
		if (flags & TCL_INDEX_ERROR) goto invalidWideIndex;
		*widePtr = 0;
	    }
	    if ((*widePtr < -1) && (flags & TCL_INDEX_ERROR)) goto invalidWideIndex;
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
    code = GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
    if (code == TCL_OK) {
	if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) {
	    if (flags & TCL_INDEX_ERROR) goto invalidWideIndex;
	    *widePtr = 0;
	}
    }
    return code;

  invalidWideIndex:
    if (interp != NULL) {
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "index \"%s\" out of range", bytes));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", NULL);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *

    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    int flags,
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. May be NULL.*/
{
    Tcl_WideInt wide;

    if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
    if (TclGetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, flags, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	if ((wide < 0) && (endValue > TCL_INDEX_END)) {
	    *indexPtr = -1;
	} else if (wide > INT_MAX) {
	} else if ((wide > (endValue + 1)) && (endValue > TCL_INDEX_END)) {
	    *indexPtr = INT_MAX;
	} else if (wide < INT_MIN) {
	    *indexPtr = INT_MIN;
	} else {
	    *indexPtr = (int) wide;
	}
    }
    return TCL_OK;
}
/*

    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{
    Tcl_ObjIntRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    ClientData cd;

    while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) {
    while ((irPtr = TclFetchIntRep(objPtr, &tclEndOffsetType)) == NULL) {
	Tcl_ObjIntRep ir;
	int length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int length, t1 = 0, t2 = 0;
	    int t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

	    if ((length == 0) || ((length == 4) && (strncmp(bytes, "none", 4) == 0))) {
		offset = WIDE_MIN;
		goto parseOK;
	    }

	    /* If we reach here, the string rep of objPtr exists. */

	    /*
	     * The valid index syntax does not include any value that is
	     * a list of more than one element. This is necessary so that
	     * lists of index values can be reliably distinguished from any

			    } else {
				offset = WIDE_MAX;
			    }
			}
			Tcl_DecrRefCount(sum);
		    }
		    if (offset < 0) {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
			goto parseError2;
#else
			offset = (offset == -1) ? WIDE_MIN : WIDE_MIN+1;
#endif
		    }
		    goto parseOK;
		}
	    }
	    goto parseError;
	}

		offset = (*(Tcl_WideInt *)cd);
		if (bytes[3] == '-') {
		    offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset;
		}
		if (offset == 1) {
		    offset = WIDE_MAX; /* "end+1" */
		} else if (offset > 1) {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
		    goto parseError2;
#else
		    offset = WIDE_MAX - 1; /* "end+n", out of range */
#endif
		} else if (offset != WIDE_MIN) {
		    offset--;
		}
	    }
	}

    parseOK:
	/* Success. Store the new internal rep. */
	ir.wideValue = offset;
	Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
	Tcl_StoreIntRep(objPtr, &tclEndOffsetType, &ir);
    }

    offset = irPtr->wideValue;

    if (offset == WIDE_MAX) {
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {

    return TCL_OK;

    /* Report a parse error. */
  parseError:
    if (interp != NULL) {
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad index \"%s\": must be integer?[+-]integer? or"
                " end?[+-]integer?", bytes));
                "bad index \"%s\": must be integer?[+-]integer?,"
                " end?[+-]integer? or none", bytes));
        if (!strncmp(bytes, "end-", 4)) {
            bytes += 4;
        }
        TclCheckBadOctal(interp, bytes);
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }

    return TCL_ERROR;

#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
    parseError2:
      if (interp != NULL) {
          char * bytes = TclGetString(objPtr);
          Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                  "index \"%s\" out of range", bytes));
          if (!strncmp(bytes, "end-", 4)) {
              bytes += 4;
          }
          Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", NULL);
      }

      return TCL_ERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 *

 * Side effects:
 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#undef TCL_INDEX_ERROR
#define TCL_INDEX_ERROR 0
#endif

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;

    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &endOffsetType);
    if (TCL_OK == TclGetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END, TCL_INDEX_ERROR, &wide)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclEndOffsetType);
	if (irPtr && irPtr->wideValue >= 0) {
	    /* "int[+-]int" syntax, works the same here as "int" */
	    irPtr = NULL;
	}
	/*
	 * We parsed an end+offset index value.
	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.

    # at the very end of the file.  To get to it, skip over nLeap leap second
    # values (8 bytes each),
    # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.

    if {$version eq {2}} {
	set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
	set last [string first \n $d $seek]
	if {![string is none $last] && $last > 0} {
	set posix [string range $d $seek [expr {$last-1}]]
	if {[llength $posix] > 0} {
	    set posixFields [ParsePosixTimeZone $posix]
	    foreach tuple [ProcessPosixTimeZone $posixFields] {
		lassign $tuple t gmtoff isDst abbrev
		if {$t > $lastTime} {
		    lappend r $tuple
	    set posix [string range $d $seek [expr {$last-1}]]
	    if {[llength $posix] > 0} {
		set posixFields [ParsePosixTimeZone $posix]
		foreach tuple [ProcessPosixTimeZone $posixFields] {
		    lassign $tuple t gmtoff isDst abbrev
		    if {$t > $lastTime} {
			lappend r $tuple
		    }
		}
	    }
	}
    }

    set TZData(:$fileName) $r

		    return -options $opts $msg
		}
		#
		# Stack trace is nested, trim off just the contribution
		# from the extra "eval" of $args due to the "catch" above.
		#
		set last [string last $tail $errInfo]
		if {![string is none $last]} {
		if {$last + [string length $tail] != [string length $errInfo]} {
		    # Very likely cannot happen
		    return -options $opts $msg
		}
		set errInfo [string range $errInfo 0 $last-1]
		    if {$last + [string length $tail] != [string length $errInfo]} {
			# Very likely cannot happen
			return -options $opts $msg
		    }
		    if {$last > 0} {
			set errInfo [string range $errInfo 0 $last-1]
		    } else {
			set errInfo {}
		    }
		}
		set tail "\"$cinfo\""
		set last [string last $tail $errInfo]
		if {![string is none $last]} {
		if {$last + [string length $tail] != [string length $errInfo]} {
		    return -code error -errorcode $errCode \
			    -errorinfo $errInfo $msg
		}
		set errInfo [string range $errInfo 0 $last-1]
		    if {$last + [string length $tail] != [string length $errInfo]} {
			return -code error -errorcode $errCode \
				-errorinfo $errInfo $msg
		    }
		    if {$last > 0} {
			set errInfo [string range $errInfo 0 $last-1]
		    } else {
			set errInfo {}
		    }
		}
		set tail "\n    invoked from within\n"
		set last [string last $tail $errInfo]
		if {$last + [string length $tail] == [string length $errInfo]} {
		if {![string is none $last] && $last + [string length $tail] == [string length $errInfo]} {
		    if {$last > 0} {
			set errInfo [string range $errInfo 0 $last-1]
		    } else {
			set errInfo {}
		    }
		    return -code error -errorcode $errCode \
			    -errorinfo [string range $errInfo 0 $last-1] $msg
			    -errorinfo $errInfo $msg
		}
		set tail "\n    while executing\n"
		set last [string last $tail $errInfo]
		if {$last + [string length $tail] == [string length $errInfo]} {
		if {![string is none $last] && $last + [string length $tail] == [string length $errInfo]} {
		    if {$last > 0} {
			set errInfo [string range $errInfo 0 $last-1]
		    } else {
			set errInfo {}
		    }
		    return -code error -errorcode $errCode \
			    -errorinfo [string range $errInfo 0 $last-1] $msg
			    -errorinfo $errInfo $msg
		}
		return -options $opts $msg
	    } else {
		dict incr opts -level
		return -options $opts $msg
	    }
	}

		if {[file tail $s] ni {. ..}} {
		    return -code error "error $action \"$src\" to\
		      \"$dest\": file already exists"
		}
	    }
	}
    } else {
	if {[string first $nsrc $ndest] != -1} {
	if {![string is none [string first $nsrc $ndest]]} {
	    set srclen [expr {[llength [file split $nsrc]] - 1}]
	    set ndest [lindex [file split $ndest] $srclen]
	    if {$ndest eq [file tail $nsrc]} {
		return -code error "error $action \"$src\" to\
		  \"$dest\": trying to rename a volume or move a directory\
		  into itself"
	    }

# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_startOfPreviousWord {str start} {
    variable ::tcl::WordBreakRE
    set word {-1 -1}
    if {$start > 0} {
    if {![string is none $start] && $start > 0} {
	regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
		result word
    }
    return [lindex $word 0]
}

# Commands covered:  exit, emphasis on finalization hangs
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test exit-1.1 {normal, quick exit} {
     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
     set aft [after 1000 {set done "Quick exit hangs !!!"}]

# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
unset -nocomplain x

test append-1.1 {append command} {
    unset -nocomplain x

# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
catch {unset x}

test appendComp-1.1 {append command} -setup {
    unset -nocomplain x

# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2005-2006 Miguel Sofer
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

if {[info commands ::apply] eq {}} {
    return
}

    for {set i 0} {$i < 256} {incr i} {
	append s $sep [list set v$i literal$i]
	set sep \n
    }
    return $s
}

testConstraint nodep [info exists tcl_precision]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {

} -result c
test assemble-15.6 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end-1}
} -result b
test assemble-15.7 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end}
} -result c
test assemble-15.8 {listIndexImm} -body {
test assemble-15.8 {listIndexImm} -constraints nodep -body {
    assemble {push {a b c}; listIndexImm end+2}
} -result {}
test assemble-15.9 {listIndexImm} -body {
test assemble-15.9 {listIndexImm} -constraints nodep -body {
    assemble {push {a b c}; listIndexImm -1-1}
} -result {}

# assemble-16 - invokeStk

test assemble-16.1 {invokeStk - wrong # args} {
    -body {

# Commands covered:  none
#
# This file contains a collection of tests for Tcl_AsyncCreate and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file tests the tclBinary.c file and the "binary" Tcl command.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
testConstraint testbytestring [llength [info commands testbytestring]]

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {![llength [info commands case]]} {
    # No "case" command? So no need to test
    return
}

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

test case-1.1 {simple pattern} {
    case a in a {format 1} b {format 2} c {format 3} default {format 4}
} 1

# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 2005 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

#
# Note: The tests for the chan methods "create" and "postevent"
# currently reside in the file "ioCmd.test".

# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# TODO: This test is likely worthless. Confirm and remove
if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
}

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*

    variable umaskValue

# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {
    if {[catch {
	    ::tcltest::loadTestedCommands

# This file contains a collection of tests for the procedures in the file
# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

    lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index {1 3 2 5}
} -returnCodes error -result {"-index" option must be followed by list index}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index foo {1 3 2 5}
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer?, end?[+-]integer? or none}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}}
} {{3 16 42} {10 20 50} {1 25 100}}
test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {

    lremove
} -result {wrong # args: should be "lremove list ?index ...?"}
test cmdIL-8.2 {lremove command: error path} -returnCodes error -body {
    lremove {{}{}}
} -result {list element in braces followed by "{}" instead of space}
test cmdIL-8.3 {lremove command: error path} -returnCodes error -body {
    lremove {a b c} gorp
} -result {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}
} -result {bad index "gorp": must be integer?[+-]integer?, end?[+-]integer? or none}
test cmdIL-8.4 {lremove command: no indices} -body {
    lremove {a b c}
} -result {a b c}
test cmdIL-8.5 {lremove command: before start} -body {
    lremove {a b c} -1
} -result {a b c}
test cmdIL-8.6 {lremove command: after end} -body {

#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} {
	# shared object - Interp result && Var 'r'
	set r [list foobar]
	# command that will add error to result
	lindex a bogus
    }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a 0o9 }}
} -returnCodes error -match glob -result {*invalid octal number*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}

# Commands covered:  coroutine, yield, yieldto, [info coroutine]
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This test file covers the dictionary object type and the dict command used
# to work with values of that type.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 2003-2009 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

# Commands covered:  none (tests environment variable implementation)
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# Commands covered:  error, catch, throw, try
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
customMatch pairwise {apply {{a b} {
    string equal [lindex $b 0] [lindex $b 1]

# Commands covered: expr
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# Check "for" and its use of continue and break.

catch {unset a i}

# Commands covered:  for, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

# Commands covered:  foreach, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

catch {unset a}
catch {unset x}

# Commands covered:  format
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %u output depends on word length, so this test is not portable.
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

# Commands covered:  none
#
# This file contains a collection of tests for the procedures in the
# file tclGet.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

test if-old-1.1 {taking proper branch} {
    set a {}
    if 0 {set a 1} else {set a 2}

# Commands covered:  if
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Basic "if" operation.

catch {unset a}

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

catch {unset x}

test incr-old-1.1 {basic incr operation} {

# This file is a Tcl script to test out the the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
}

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*

    variable umaskValue

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# -*- tcl -*-
# Functionality covered: operation of the reflected transformation
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2007 Andreas Kupries <andreask@activestate.com>
#                                    <akupries@shaw.ca>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

## Testing the reflected transformation.

# Helper commands to record the arguments to handler methods.  Stored in a
# script so that the tests needing this code do not need their own copy but
# can access this variable.

set helperscript {
    if {[lsearch [namespace children] ::tcltest] == -1} {
    if {[string is none [lsearch [namespace children] ::tcltest]]} {
	package require tcltest 2
	namespace import -force ::tcltest::*
    }

    # This forces the return options to be in the order that the test expects!
    variable optorder {
	-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!

# Commands covered:  join
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test join-1.1 {basic join commands} {
    join {a b c} xyz
} axyzbxyzc

# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

set minus -
set non non
testConstraint testevalex [llength [info commands testevalex]]
testConstraint nodep [info exists tcl_precision]

# Tests of Tcl_LindexObjCmd, NOT COMPILED

test lindex-1.1 {wrong # args} testevalex {
    list [catch {testevalex lindex} result] $result
} "1 {wrong # args: should be \"lindex list ?index ...?\"}"

    set x {1 2}
    list [testevalex {lindex {{a b c} {d e f}} $x}] \
	[testevalex {lindex {{a b c} {d e f}} $x}]
} {f f}
test lindex-2.4 {malformed index list} testevalex {
    set x \{
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?,\ end?\[+-\]integer?\ or\ none}

# Indices that are integers or convertible to integers

test lindex-3.1 {integer -1} -constraints testevalex -body {
    set x ${minus}1
    set x ${non}e
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {{} {}}
test lindex-3.2 {integer 0} -constraints testevalex -body {
    set x [string range 00 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {a a}
test lindex-3.3 {integer 2} -constraints testevalex -body {

    set x -0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} -body {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {2147483646 {} 2147483647 2147483648}
test lindex-3.8 {compiled with static indices out of range, negative} -body {
test lindex-3.8 {compiled with static indices out of range, negative} -constraints nodep -body {
    list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
} -result [lrepeat 3 {}]
test lindex-3.9 {compiled with calculated indices out of range, negative constant} -body {
test lindex-3.9 {compiled with calculated indices out of range, negative constant} -constraints nodep -body {
    list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1]
} -result [lrepeat 3 {}]
test lindex-3.10 {compiled with calculated indices out of range, after end} -body {
test lindex-3.10 {compiled with calculated indices out of range, after end} -constraints nodep -body {
    list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3]
} -result [lrepeat 3 {}]

# Indices relative to end

test lindex-4.1 {index = end} testevalex {
    set x end

test lindex-4.7 {bad octal} -constraints testevalex -body {
    set x end--0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
    set x end-0a2
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "end-0a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lindex-4.9 {obsolete test} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
test lindex-4.10 {incomplete end-} testevalex {
    set x end-
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "end-": must be integer?[+-]integer?, end?[+-]integer? or none}}

test lindex-5.1 {bad second index} testevalex {
    list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result
} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "0a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lindex-5.2 {good second index} testevalex {
    testevalex {lindex {{a b c} {d e f} {g h i}} 1 2}
} f
test lindex-5.3 {three indices} testevalex {
    testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1}
} f

	list [lindex {{a b c} {d e f}} $x] [lindex {{a b c} {d e f}} $x]
    } result
    set result
} {f f}
test lindex-10.4 {malformed index list} {
    set x \{
    list [catch { lindex {a b c} $x } result] $result
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?,\ end?\[+-\]integer?\ or\ none}

# Indices that are integers or convertible to integers

test lindex-11.1 {integer -1} {
    set x ${minus}1
    set x ${non}e
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-11.2 {integer 0} {
    set x [string range 00 0 0]

test lindex-12.7 {bad octal} -body {
    set x end--0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
    set x end-0a2
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "end-0a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lindex-12.9 {obsolete test} {
    set x end
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {c c}
test lindex-12.10 {incomplete end-} {
    set x end-
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "end-": must be integer?[+-]integer?, end?[+-]integer? or none}}

test lindex-13.1 {bad second index} {
    list [catch { lindex {a b c} 0 0a2 } result] $result
} {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "0a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lindex-13.2 {good second index} {
    catch {
	lindex {{a b c} {d e f} {g h i}} 1 2
    } result
    set result
} f
test lindex-13.3 {three indices} {

test lindex-17.0 {Bug 1718580} -body {
    lindex {} end foo
} -match glob -result {bad index "foo"*} -returnCodes 1
test lindex-17.1 {Bug 1718580} -body {
    lindex a end foo
} -match glob -result {bad index "foo"*} -returnCodes 1

catch { unset minus }
catch { unset non }

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

# Commands covered:  linsert
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

catch {unset lis}
catch {rename p ""}

} {a b e f c d}

test linsert-2.1 {linsert errors} {
    list [catch linsert msg] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
test linsert-2.2 {linsert errors} {
    list [catch {linsert a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "b": must be integer?[+-]integer?, end?[+-]integer? or none}}
test linsert-2.3 {linsert errors} {
    list [catch {linsert a 12x 2} msg] $msg
} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "12x": must be integer?[+-]integer?, end?[+-]integer? or none}}
test linsert-2.4 {linsert errors} {
    list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
test linsert-2.5 {syntax (TIP 323)} {
    linsert {a b c} 0
} [list a b c]
test linsert-2.6 {syntax (TIP 323)} {

# Commands covered:  list
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# First, a bunch of individual tests

test list-1.1 {basic tests} {list a b c} {a b c}

# Functionality covered: operation of the procedures in tclListObj.c that
# implement the Tcl type manager for the list object type.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Commands covered:  llength
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

test llength-1.1 {length of list} {
    llength {a b c d}
} 4

# Commands covered:  load
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Commands covered:  lpop
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest
    namespace import -force ::tcltest::*
}

unset -nocomplain no; # following tests expecting var "no" does not exists
test lpop-1.1 {error conditions} -returnCodes error -body {
    lpop no

test lpop-1.6 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l end+1
} -result {index "end+1" out of range}
test lpop-1.7 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {}
} -match glob -result {bad index *}
} -match glob -result {index "" out of range}
test lpop-1.8 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l 0 0 0 0 1
} -result {index "1" out of range}
test lpop-1.9 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {1 0}

# Commands covered:  lrange
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]
testConstraint nodep [info exists tcl_precision]

test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}

} {}
test lrange-1.6 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 10 11
} {}
test lrange-1.7 {range of list elements} {
    lrange {a b c d e} -1 2
} {a b c}
test lrange-1.8 {range of list elements} {
test lrange-1.8 {range of list elements} nodep {
    lrange {a b c d e} -2 -1
} {}
test lrange-1.9 {range of list elements} {
test lrange-1.9 {range of list elements} nodep {
    lrange {a b c d e} -2 end
} {a b c d e}
test lrange-1.10 {range of list elements} {
    lrange "a b\{c d" 1 2
} "b\\{c d"
test lrange-1.11 {range of list elements} {
    lrange "a b c d" end end

    list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
    list [catch {lrange a b 6 7} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.3 {error conditions} {
    list [catch {lrange a b 6} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "b": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lrange-2.4 {error conditions} {
    list [catch {lrange a 0 enigma} msg] $msg
} {1 {bad index "enigma": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "enigma": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lrange-2.5 {error conditions} {
    list [catch {lrange "a \{b c" 3 4} msg] $msg
} {1 {unmatched open brace in list}}
test lrange-2.6 {error conditions} {
    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}

test lrange-3.1 {Bug 3588366: end-offsets before start} {
    apply {l {
	lrange $l 0 end-5
    }} {1 2 3 4 5}
} {}
test lrange-3.2 {compiled with static indices out of range, negative} {
test lrange-3.2 {compiled with static indices out of range, negative} nodep {
    list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3]
} [lrepeat 4 {}]
test lrange-3.3 {compiled with calculated indices out of range, negative constant} {
test lrange-3.3 {compiled with calculated indices out of range, negative constant} nodep {
    list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1]
} [lrepeat 4 {}]
test lrange-3.4 {compiled with calculated indices out of range, after end} -body {
test lrange-3.4 {compiled with calculated indices out of range, after end} -constraints nodep -body {
    list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2]
} -result [lrepeat 4 {}]

test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
test lrange-3.5 {compiled with calculated indices, start out of range (negative)} nodep {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]

test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} nodep {
    list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -body {
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -constraints {
    nodep
} -body {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
# (as before the fix [58c46e74b931d3a1]):
test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -constraints {
    nodep
} -body {
    list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
	 [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -body {
} -result [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -constraints {
    nodep
} -body {
    set cmd lrange
    list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
	 [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
    testpurebytesobj
    testpurebytesobj nodep
} -body {
    list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
	 [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
} -result [lrepeat 6 {}]
test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
    testpurebytesobj
    testpurebytesobj nodep
} -body {
    set cmd lrange
    list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
	 [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]

test lrange-4.1 {lrange pure promise} -body {

# Testing for compiled vs non-compiled behaviour, and shared vs non-shared.
# Far too many variations to check with spelt-out tests.
# Note that this *just* checks whether the different versions are the same
# not whether any of them is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set idxs    {none -1 0 1 2 3 end-3 end-2 end-1 end end+1}
    set lrange  lrange

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
                # Shared, uncompiled
                set ls2 $ls

# Commands covered:  lrepeat
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 by Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

## Arg errors
test lrepeat-1.1 {error cases} {
    -body {

# Commands covered:  lreplace
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint nodep [info exists tcl_precision]

test lreplace-1.1 {lreplace command} {
    lreplace {1 2 3 4 5} 0 0 a
} {a 2 3 4 5}
test lreplace-1.2 {lreplace command} {
    lreplace {1 2 3 4 5} 1 1 a
} {1 a 3 4 5}

    list [catch lreplace msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} -body {
    list [catch {lreplace a b} msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} -body {
    list [catch {lreplace x a 10} msg] $msg
} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
} -result {1 {bad index "a": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lreplace-2.4 {lreplace errors} -body {
    list [catch {lreplace x 10 x} msg] $msg
} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
} -result {1 {bad index "x": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lreplace-2.5 {lreplace errors} -body {
    list [catch {lreplace x 10 1x} msg] $msg
} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
} -result {1 {bad index "1x": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lreplace-2.6 {lreplace errors} -body {
    list [catch {lreplace x 3 2} msg] $msg
} -result {0 x}
test lreplace-2.7 {lreplace errors} -body {
    list [catch {lreplace x 2 2} msg] $msg
} -result {0 x}

# Testing for compiled behaviour. Far too many variations to check with
# spelt-out tests. Note that this *just* checks whether the compiled version
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set ins     {{} A {A B}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set idxs    {none -1 0 1 2 3 end-3 end-2 end-1 end end+1}
    set lreplace lreplace

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
		foreach i $ins {
		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]

    lsearch -start 2 {a b c d e f} a
} -1
test lsearch-10.3 {offset searching} {
    lsearch -start end-4 {a b c a b c} a
} 3
test lsearch-10.4 {offset searching} -returnCodes error -body {
    lsearch -start foobar {a b c a b c} a
} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}
} -result {bad index "foobar": must be integer?[+-]integer?, end?[+-]integer? or none}
test lsearch-10.5 {offset searching} -returnCodes error -body {
    lsearch -start 1 2
} -result {missing starting index}
test lsearch-10.6 {binary search with offset} {
    set res {}
    for {set i 0} {$i < 100} {incr i} {
	lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i]

} {{0 1}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}
test lsearch-20.2 {lsearch -index option, malformed index} -body {
    lsearch -index foo {{a c} {a b} {a a}} a
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer?, end?[+-]integer? or none}
test lsearch-20.3 {lsearch -index option, malformed index} -body {
    lsearch -index \{ {{a c} {a b} {a a}} a
} -returnCodes error -result {unmatched open brace in list}

test lsearch-21.1 {lsearch shimmering crash} {
    set x 0
    lsearch -exact -integer $x $x

# This file is a -*- tcl -*- test script

# Commands covered: lset
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

    list [testevalex {lset x 0 3}] $x
} {{3 1 2} {3 1 2}}
test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
    set x {0 1 2}
    list [catch {
	testevalex {lset x {{bad}1} 3}
    } msg] $msg
} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "{bad}1": must be integer?[+-]integer?, end?[+-]integer? or none}}

test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1 2}
    list [testevalex {lset x 0 $x}] $x
} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
    set x {0 1}

    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list 2a2] w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "2a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list -1] w}
    } msg] $msg
} {1 {index "-1" out of range}}
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {

    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 2a2 w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "2a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a -1 w}
    } msg] $msg
} {1 {index "-1" out of range}}
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {

test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
    set a [list "a \{" b]
    list [catch {testevalex {lset a {0 1} c}} msg] $msg
} {1 {unmatched open brace in list}}
test lset-8.3 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "2a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lset-8.4 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "2a2": must be integer?[+-]integer?, end?[+-]integer? or none}}
test lset-8.5 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 -1 h}} msg] $msg
} {1 {index "-1" out of range}}
test lset-8.6 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 -1} h}} msg] $msg

# This file is a -*- tcl -*- test script

# Commands covered: lset
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# Procedure to evaluate a script within a proc, to test compilation
# functionality

# This file tests the tclMacOSXFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 Tcl Core Team.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]

# Commands covered:  load unload
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
set oldTSF $::tcltest::testSingleFile
set ::tcltest::testSingleFile false

if {[testConstraint unix] && $tcl_platform(os) eq "Darwin" &&

# Commands covered: ::tcl::mathop::...
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 2006 Donal K. Fellows
# Copyright (c) 2006 Peter Spjuth
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

# A namespace to test that operators are exported and that they
# work when imported
namespace eval ::testmathop2 {

# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Commands covered:  proc, apply, [interp alias], [namespce import]
#
# This file contains a collection of tests for the non-recursive executor that
# avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the
# actual command functionality is tested in the specific test file.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Functionality covered: this file contains a collection of tests for the
# procedures in tclObj.c that implement Tcl's basic type support and the
# type managers for the types boolean, double, and integer.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Package covered:  opt1.0/optparse.tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

# the package we are going to test
package require opt 0.4.7

# Commands covered:  pid
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint pidDefined [llength [info commands pid]]

test pid-1.1 {pid command} pidDefined {

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

catch {rename t1 ""}
catch {rename foo ""}

# process.test --
#
# This file contains a collection of tests for the tcl::process ensemble.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Utilities
file delete [set path(test-signalfile)  [makeFile {} test-signalfile]]
set path(test-signalfile2) [makeFile {} test-signalfile2]

# Commands covered:  pwd
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0

# reg.test --
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
# (Don't panic if you are seeing this as part of the reg distribution
# and aren't using Tcl -- reg's own regression tester also knows how
# to read this file, ignoring the Tcl-isms.)
#
# Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# All tests require the testregexp command, return if this

    unset -nocomplain f1
} -body {
    set f1 44
    regexp abc abc f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-6.9 {regexp errors, -start bad int check} {
    list [catch {regexp -start bogus {^$} {}} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}}
test regexp-6.10 {regexp errors} {
    list [catch {regexp {a[} b} msg] $msg
} {1 {couldn't compile regular expression pattern: brackets [] not balanced}}

test regexp-7.1 {basic regsub operation} {
    list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
} {1 xax111aaa222xaa}

    unset -nocomplain f1
} -body {
    set f1 44
    regsub -nocase aaa aaa xxx f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-11.8 {regsub errors, -start bad int check} {
    list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}}
test regexp-11.9 {regsub without final variable name returns value} {
    regsub b abaca X
} {aXaca}
test regexp-11.10 {regsub without final variable name returns value} {
    regsub -all a abaca X
} {XbXcX}
test regexp-11.11 {regsub without final variable name returns value} {

    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexp-15.1 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
    list [regexp -start none {\d} 1abc2de3 x] $x
} -result {1 1}
test regexp-15.2 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexp-15.3 {regexp -start} -body {
    unset -nocomplain x

test regexp-16.1 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
    list [regsub -all -start none {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.3 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.4 {regsub -start, \A behavior} -body {
    set out {}

# Commands covered:  regexp, regsub
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Procedure to evaluate a script within a proc, to test compilation
# functionality

	list [catch {regexp abc abc f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
    evalInProc {
	list [catch {regexp -start bogus {^$} {}} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}}

test regexpComp-7.1 {basic regsub operation} {
    evalInProc {
	list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
    }
} {1 xax111aaa222xaa}
test regexpComp-7.2 {basic regsub operation} {

	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "bogus": must be integer?[+-]integer?, end?[+-]integer? or none}}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    evalInProc {

    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexpComp-15.1 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
    list [regexp -start none {\d} 1abc2de3 x] $x
} -result {1 1}
test regexpComp-15.2 {regexp -start} -body {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexpComp-15.3 {regexp -start} -body {
    unset -nocomplain x

test regexpComp-16.1 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
    list [regsub -all -start none {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.3 {regsub -start} -body {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} -body {
    set out {}

# registry.test --
#
# This file contains a collection of tests for the registry command.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {

# Commands covered:  rename
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5-

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

foreach i [interp slaves] {
    interp delete $i
}

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

proc ignore args {}

# Simple variable operations.

# Commands covered:  set
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands

# Commands covered:  split
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test split-1.1 {basic split commands} {
    split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}

# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint utf16 [expr {[string length \U010000] == 2}]
testConstraint testbytestring   [llength [info commands testbytestring]]
testConstraint nodep [info exists tcl_precision]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        set lines [split [memory info] \n]
        return [lindex $lines 3 3]

test string-4.1.$noComp {string first, too few args} {
    list [catch {run {string first a}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2.$noComp {string first, bad args} {
    list [catch {run {string first a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "c": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-4.3.$noComp {string first, too many args} {
    list [catch {run {string first a b 5 d}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.4.$noComp {string first} {
    run {string first bq abcdefgbcefgbqrs}
} 12
test string-4.5.$noComp {string first} {

} a
test string-5.4.$noComp {string index} {
    run {string ind abcde 4}
} e
test string-5.5.$noComp {string index} {
    run {string index abcde 5}
} {}
test string-5.6.$noComp {string index} {
test string-5.6.$noComp {string index} nodep {
    list [catch {run {string index abcde -10}} msg] $msg
} {0 {}}
test string-5.7.$noComp {string index} {
    list [catch {run {string index a xyz}} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "xyz": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-5.8.$noComp {string index} {
    run {string index abc end}
} c
test string-5.9.$noComp {string index} {
    run {string index abc end-1}
} b
test string-5.10.$noComp {string index, unicode} {

    list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4.$noComp {string is, too many args} {
    list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5.$noComp {string is, class check} {
    list [catch {run {string is bogus str}} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, index, integer, list, lower, none, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6.$noComp {string is, ambiguous class} {
    list [catch {run {string is al str}} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, index, integer, list, lower, none, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7.$noComp {string is alpha, all ok} {
    run {string is alpha -strict -failindex var abc}
} 1
test string-6.8.$noComp {string is, error in var} {
    list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
test string-6.9.$noComp {string is, var shouldn't get set} {

catch {rename largest_int {}}

test string-7.1.$noComp {string last, too few args} {
    list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
    list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "c": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-7.3.$noComp {string last, too many args} {
    list [catch {run {string last a b c d}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4.$noComp {string last} {
    run {string la xxx xxxx123xx345x678}
} 1
test string-7.5.$noComp {string last} {

test string-12.6.$noComp {string range} {
    run {string range abcdefghijklmnop 10 end}
} {klmnop}
test string-12.7.$noComp {string range, last < first} {
    run {string range abcdefghijklmnop 10 9}
} {}
test string-12.8.$noComp {string range, first < 0} {
    run {string range abcdefghijklmnop -3 2}
    run {string range abcdefghijklmnop -1 2}
} {abc}
test string-12.9.$noComp {string range} {
test string-12.9.$noComp {string range} nodep {
    run {string range abcdefghijklmnop -3 -2}
} {}
test string-12.10.$noComp {string range} {
    run {string range abcdefghijklmnop 1000 1010}
} {}
test string-12.11.$noComp {string range} {
    run {string range abcdefghijklmnop -100 end}
    run {string range abcdefghijklmnop none end}
} {abcdefghijklmnop}
test string-12.12.$noComp {string range} {
    list [catch {run {string range abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "abc": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-12.13.$noComp {string range} {
    list [catch {run {string range abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "eof": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-12.14.$noComp {string range} {
    run {string range abcdefghijklmnop end-1 end}
} {op}
test string-12.15.$noComp {string range} {
    run {string range abcdefghijklmnop end 1000}
} {p}
test string-12.16.$noComp {string range} {

test string-14.7.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
test string-14.8.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9}
} {abcdefghijklmnop}
test string-14.9.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 2}
    run {string replace abcdefghijklmnop none 2}
} {defghijklmnop}
test string-14.10.$noComp {string replace} {
test string-14.10.$noComp {string replace} nodep {
    run {string replace abcdefghijklmnop -3 -2}
} {abcdefghijklmnop}
test string-14.11.$noComp {string replace} -body {
    run {string replace abcdefghijklmnop 1000 1010}
} -result {abcdefghijklmnop}
test string-14.12.$noComp {string replace} {
    run {string replace abcdefghijklmnop -100 end}
    run {string replace abcdefghijklmnop none end}
} {}
test string-14.13.$noComp {string replace} {
    list [catch {run {string replace abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "abc": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-14.14.$noComp {string replace} {
    list [catch {run {string replace abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "eof": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-14.15.$noComp {string replace} {
    run {string replace abcdefghijklmnop end-10 end-2 NEW}
} {abcdeNEWop}
test string-14.16.$noComp {string replace} {
    run {string replace abcdefghijklmnop 0 end foo}
} {foo}
test string-14.17.$noComp {string replace} {

} 3

test string-15.1.$noComp {string tolower too few args} {
    list [catch {run {string tolower}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2.$noComp {string tolower bad args} {
    list [catch {run {string tolower a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "b": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-15.3.$noComp {string tolower too many args} {
    list [catch {run {string tolower ABC 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.4.$noComp {string tolower} {
    run {string tolower ABCDeF}
} {abcdef}
test string-15.5.$noComp {string tolower} {

} b

test string-16.1.$noComp {string toupper} {
    list [catch {run {string toupper}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.2.$noComp {string toupper} {
    list [catch {run {string toupper a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "b": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-16.3.$noComp {string toupper} {
    list [catch {run {string toupper a 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.4.$noComp {string toupper} {
    run {string toupper abCDEf}
} {ABCDEF}
test string-16.5.$noComp {string toupper} {

} B

test string-17.1.$noComp {string totitle} {
    list [catch {run {string totitle}} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
test string-17.2.$noComp {string totitle} {
    list [catch {run {string totitle a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {bad index "b": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-17.3.$noComp {string totitle} {
    run {string totitle abCDEf}
} {Abcdef}
test string-17.4.$noComp {string totitle} {
    run {string totitle "abc xYz"}
} {Abc xyz}
test string-17.5.$noComp {string totitle} {

    list [catch {run {string wordend a}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.2.$noComp {string wordend} -body {
    list [catch {run {string wordend a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.3.$noComp {string wordend} -body {
    list [catch {run {string wordend a gorp}} msg] $msg
} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
} -result {1 {bad index "gorp": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-21.4.$noComp {string wordend} -body {
    run {string wordend abc. -1}
} -result 3
test string-21.5.$noComp {string wordend} -body {
    run {string wordend abc. 100}
} -result 4
test string-21.6.$noComp {string wordend} -body {

    list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a gorp}} msg] $msg
} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
} -result {1 {bad index "gorp": must be integer?[+-]integer?, end?[+-]integer? or none}}
test string-22.5.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 400}
} -result 8
test string-22.6.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 2}
} -result 0
test string-22.7.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" -2}
    run {string wordstart "one two three_words" none}
} -result 0
test string-22.8.$noComp {string wordstart} -body {
    run {string wordstart "one .*&^ three" 6}
} -result 6
test string-22.9.$noComp {string wordstart} -body {
    run {string wordstart "one two three" 4}
} -result 4

#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Commands covered:  subst
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

# Commands covered:  tailcall
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
    foreach i [after info] {
	after cancel $i

# This file tests the tclUnixFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file contains tests for the routines in the file tclUnixFile.c
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file contains tests for tclUnixNotfy.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

# Commands covered:  unload
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2003-2004 by Georgios Petasis
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Commands covered:  uplevel
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

proc a {x y} {
    newset z [expr $x+$y]
    return $z

# Commands covered:  'upvar', 'namespace upvar'
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file contains a collection of tests for tclUtf.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
if {[string is none [lsearch [namespace children] ::tcltest]]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file is a Tcl script to test the code in the file tclUtil.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint controversialNaN 1
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
testConstraint testprint [llength [info commands testprint]]

testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}]

testConstraint nodep [info exists tcl_precision]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {

test util-9.17 {Tcl_GetIntForIndex} {
    string index abcd { -1+2 }
} b
test util-9.18 {Tcl_GetIntForIndex} {
    string index abcd { -1--2 }
} b
test util-9.19 {Tcl_GetIntForIndex} -body {
    string index a {}
    string index a _
} -returnCodes error -match glob -result *
test util-9.20 {Tcl_GetIntForIndex} -body {
    string index a { }
} -returnCodes error -match glob -result *
test util-9.21 {Tcl_GetIntForIndex} -body {
    string index a " \r\t\n"
} -returnCodes error -match glob -result *

} -returnCodes error -match glob -result *
test util-9.43 {Tcl_GetIntForIndex} -body {
    string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {Tcl_GetIntForIndex} -body {
    string index a 0+1000000000000
} -result {}
test util-9.45 {Tcl_GetIntForIndex} -body {
test util-9.45 {Tcl_GetIntForIndex} -constraints nodep -body {
    string index abcd end+2305843009213693950
} -result {}
test util-9.46 {Tcl_GetIntForIndex} -body {
test util-9.46 {Tcl_GetIntForIndex} -constraints nodep -body {
    string index abcd end+4294967294
} -result {}
# TIP 502
test util-9.47 {Tcl_GetIntForIndex} -body {
    string index abcd 0x10000000000000000
} -result {}
test util-9.48 {Tcl_GetIntForIndex} {
test util-9.48 {Tcl_GetIntForIndex} nodep {
    string index abcd -0x10000000000000000
} {}
test util-9.49 {Tcl_GetIntForIndex} -body {
    string index abcd end*1
} -returnCodes error -match glob -result *
test util-9.50 {Tcl_GetIntForIndex} -body {
    string index abcd {end- 1}

} -result {}
test util-9.56 {Tcl_GetIntForIndex} -body {
    string index abcd end--0x10000000000000000
} -result {}
test util-9.57 {Tcl_GetIntForIndex} {
    string index abcd end+-0x10000000000000000
} {}
test util-9.58 {Tcl_GetIntForIndex} -body {
test util-9.58 {Tcl_GetIntForIndex} -constraints nodep -body {
    string index abcd end--0x8000000000000000
} -result {}

test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x0000000000000000
} {0.0}
test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {

# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

test while-old-1.1 {basic while loops} {
    set count 0
    while {$count < 10} {set count [expr $count+1]}

# This file tests the tclWinConsole.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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


test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} {
    set oldmode [fconfigure stdin]

# This file tests the tclWinFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file tests the tclWinNotify.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# This file tests the tclWinTime.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

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

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]