Tcl Source Code

	return result;
    }

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
    if (result != TCL_OK) {
	return result;
    }
    if ((last == -1) && Tcl_GetString(objv[3])[0] == '\0') {
       /* TIP #615: empty string for 'last' means 'end' */
       last = listLen - 1;
    }

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

    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",	"index",
	"integer",	"list",		"lower",	"print",
	"punct",	"space",	"true",		"upper",
	"unicode",	"wideinteger", "wordchar",	"xdigit",	NULL
    };
    enum isClassesEnum {
	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_INDEX,
	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_UNICODE,	STR_IS_WIDE,	STR_IS_WORD,	STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptionsEnum {
	OPT_STRICT, OPT_FAILIDX
    };

		TclFreeInternalRep(objPtr);
	    }
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INDEX:
	if (TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclEndOffsetType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	    break;
	}
	if (Tcl_GetIntForIndex(NULL, objPtr, 0, &i) != TCL_OK) {
	    result = 0;
	}
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasInternalRep(objPtr, &tclIntType) ||
		TclHasInternalRep(objPtr, &tclBignumType)) {
	    break;
	}

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

    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((last == -1) && Tcl_GetString(objv[3])[0] == '\0') {
	/* TIP #615: empty string for 'last' means 'end' */
	last = length;
    }

    if (last >= 0) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}


    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) {
	return TCL_ERROR;
    }
    if ((last == -1) && Tcl_GetString(objv[3])[0] == '\0') {
	/* TIP #615: empty string for 'last' means 'end' */
	last = end;
    }

    /*
     * 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.
     */

    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",	"index",
	"integer",	"list",		"lower",	"print",
	"punct",	"space",	"true",		"upper",
	"unicode",	"wideinteger", "wordchar",	"xdigit",	NULL
    };
    enum isClassesEnum {
	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_INDEX,
	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_UNICODE,	STR_IS_WIDE,	STR_IS_WORD,	STR_IS_XDIGIT
    };
    int t, range, allowEmpty = 0, end;
    InstStringClassType strClassType;
    Tcl_Obj *isClass;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
	return TCL_ERROR;

	    TclAdjustStackDepth(-1, envPtr);
	    FIXJUMP1(	satisfied);
	}
	PUSH(		"1");
	FIXJUMP1(	end);
	return TCL_OK;
    }
    case STR_IS_INDEX:
	return TCL_ERROR;

    case STR_IS_INT:
    case STR_IS_WIDE:
    case STR_IS_ENTIER:
	if (allowEmpty) {
	    int testNumType;

 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
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;

    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. Don't allow "" as single
     * index here, since it cannot be distinguished from an empty list.
     */

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

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

			    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 internalrep, keeping the result of a parse


 * around. The type is unregistered, so has no need of a setFromAnyProc.
 */

static void
UpdateStringOfIndex(
    Tcl_Obj *objPtr)	/* Index object whose string rep to update. */
{
    /* The only situation that the string rep can be missing is when it
     * represents TCL_INDEX_NONE. In all other situations, the string
     * rep is never thrown away. See TclNewIndexObj() */
    if ((objPtr)->internalRep.wideValue != WIDE_MIN) {
	Tcl_Panic("String rep of index %" TCL_LL_MODIFIER "d cannot be generated",
		(long long)(objPtr)->internalRep.wideValue);
    }
    TclInitStringRep(objPtr, NULL, 0);
}

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

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
 * describe them in one place.

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

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

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

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

	    if (length == 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

		}
	    }
	}

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

    offset = irPtr->wideValue;

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

    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_ObjInternalRep *irPtr = TclFetchInternalRep(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.

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 {}
} -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}

    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, index, integer, list, lower, print, punct, space, true, upper, unicode, 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, index, integer, list, lower, print, punct, space, true, upper, unicode, 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} {

        [run {string is ascii $s}] \
        [run {string is control $s}] \
        [run {string is boolean $s}] \
        [run {string is digit $s}] \
        [run {string is double $s}] \
        [run {string is false $s}] \
        [run {string is graph $s}] \
        [run {string is index $s}] \
        [run {string is integer $s}] \
        [run {string is lower $s}] \
        [run {string is print $s}] \
        [run {string is punct $s}] \
        [run {string is space $s}] \
        [run {string is true $s}] \
        [run {string is upper $s}] \
        [run {string is wordchar $s}] \
        [run {string is xdigit $s}] \

} {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
test string-23.2.$noComp {string is command with empty string} {
    set s ""
    list \
        [run {string is alnum -strict $s}] \
        [run {string is alpha -strict $s}] \
        [run {string is ascii -strict $s}] \
        [run {string is control -strict $s}] \

    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 {}
} -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 *
test util-9.22 {Tcl_GetIntForIndex} -body {