Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2384,11 +2384,11 @@ 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) Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -556,10 +556,18 @@ */ #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. */ Index: generic/tclAssembly.c ================================================================== --- generic/tclAssembly.c +++ generic/tclAssembly.c @@ -503,10 +503,11 @@ {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, + {"tryCvtToIndex", ASSEM_1BYTE, INST_TRY_CVT_TO_INDEX,1, 2}, {NULL, ASSEM_1BYTE, 0, 0, 0} }; /* * List of instructions that cannot throw an exception under any Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -2414,11 +2414,11 @@ * 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; @@ -2674,17 +2674,17 @@ 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)); @@ -2754,11 +2754,11 @@ 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; } } @@ -2976,16 +2976,16 @@ * 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) { @@ -3494,11 +3494,11 @@ /* * 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; Index: generic/tclCmdMZ.c ================================================================== --- generic/tclCmdMZ.c +++ generic/tclCmdMZ.c @@ -193,11 +193,11 @@ case REGEXP_START: { int temp; if (++i >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], 0, TCL_INDEX_ERROR, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -257,11 +257,11 @@ 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; } } @@ -548,11 +548,11 @@ case REGSUB_START: { int temp; if (++idx >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], 0, TCL_INDEX_ERROR, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -581,11 +581,11 @@ 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; } } @@ -1331,11 +1331,11 @@ } 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; @@ -1375,11 +1375,11 @@ } 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; @@ -1420,11 +1420,11 @@ /* * 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); @@ -1488,11 +1488,11 @@ 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; @@ -1545,22 +1545,22 @@ 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 { @@ -1766,10 +1766,20 @@ */ 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; } @@ -2311,12 +2321,12 @@ * '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; @@ -2419,12 +2429,12 @@ } 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 @@ -2531,11 +2541,11 @@ 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; @@ -2592,11 +2602,11 @@ 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; @@ -2945,20 +2955,20 @@ 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; @@ -3030,20 +3040,20 @@ 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; @@ -3115,20 +3125,20 @@ 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; Index: generic/tclCompCmdsSZ.c ================================================================== --- generic/tclCompCmdsSZ.c +++ generic/tclCompCmdsSZ.c @@ -504,20 +504,20 @@ 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; @@ -709,10 +709,15 @@ 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; Index: generic/tclCompile.h ================================================================== --- generic/tclCompile.h +++ generic/tclCompile.h @@ -846,10 +846,13 @@ #define INST_STR_LT 191 #define INST_STR_GT 192 #define INST_STR_LE 193 #define INST_STR_GE 194 +/* TIP ??? */ +#define INST_TRY_CVT_TO_INDEX 195 + /* The last opcode */ #define LAST_INST_OPCODE 194 /* * Table describing the Tcl bytecode instructions: their name (for displaying Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -1910,11 +1910,12 @@ 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); @@ -2599,11 +2600,11 @@ 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; Index: generic/tclExecute.c ================================================================== --- generic/tclExecute.c +++ generic/tclExecute.c @@ -4841,11 +4841,11 @@ */ 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; } @@ -5280,11 +5280,11 @@ /* * 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)) { @@ -5321,13 +5321,13 @@ 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) { @@ -5410,13 +5410,13 @@ 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); @@ -6383,10 +6383,29 @@ if (TclHasIntRep(valuePtr, &tclBooleanType)) { objResultPtr = TCONST(1); } else { int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); objResultPtr = TCONST(result); + } + TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); + NEXT_INST_F(1, 0, 1); + break; + + case INST_TRY_CVT_TO_INDEX: + valuePtr = OBJ_AT_TOS; + if (TclHasIntRep(valuePtr, &tclIntType)) { + objResultPtr = TCONST(valuePtr->internalRep.wideValue >= -1); + } else { + int idx; + if (TclGetIntForIndexM(NULL, valuePtr, INT_MAX-1, TCL_INDEX_ERROR, &idx) != TCL_OK) { + objResultPtr = TCONST(0); + } else { + TclInvalidateStringRep(valuePtr); + valuePtr->typePtr = &tclIntType; + valuePtr->internalRep.wideValue = idx; + objResultPtr = TCONST(1); + } } TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 0, 1); break; Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -2519,16 +2519,26 @@ (((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))) -#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((objPtr)->typePtr == &tclIntType \ - && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ - ? (int)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ - : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) +#ifdef TCL_NO_DEPRECATED +#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), (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: * @@ -2768,10 +2778,11 @@ 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. */ Index: generic/tclListObj.c ================================================================== --- generic/tclListObj.c +++ generic/tclListObj.c @@ -1261,11 +1261,11 @@ * shimmering; see TIP#22 and TIP#33 for the details. */ ListGetIntRep(argPtr, listRepPtr); if ((listRepPtr == NULL) - && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL , argPtr, INT_MAX-2, TCL_INDEX_ERROR, &index) == TCL_OK) { /* * argPtr designates a single index. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); @@ -1363,19 +1363,19 @@ 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], -1, &index) + if (TclGetIntForIndexM(interp, indexArray[i], -1, TCL_INDEX_ERROR, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; } } @@ -1442,11 +1442,11 @@ * shimmering; see TIP #22 and #23 for details. */ ListGetIntRep(indexArgPtr, listRepPtr); if (listRepPtr == NULL - && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX-2, TCL_INDEX_ERROR, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); @@ -1589,11 +1589,11 @@ /* * 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; Index: generic/tclNamesp.c ================================================================== --- generic/tclNamesp.c +++ generic/tclNamesp.c @@ -167,12 +167,12 @@ {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, - {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, - {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, + {"qualifiers", NamespaceQualifiersCmd, NULL/*TclCompileNamespaceQualifiersCmd*/, NULL, NULL, 0}, + {"tail", NamespaceTailCmd, NULL/*TclCompileNamespaceTailCmd*/, NULL, NULL, 0}, {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"upvar", NamespaceUpvarCmd, TclCompileNamespaceUpvarCmd, NULL, NULL, 0}, {"which", NamespaceWhichCmd, TclCompileNamespaceWhichCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -661,11 +661,10 @@ # 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 @@ -676,10 +675,20 @@ # 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. */ Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -106,15 +106,13 @@ */ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); -static int GetEndOffsetFromObj(Tcl_Obj *objPtr, +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); @@ -127,11 +125,11 @@ * 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 */ @@ -3043,11 +3041,11 @@ Tcl_DStringGetResult( Tcl_Interp *interp, /* Interpreter whose result is to be reset. */ Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { -#ifdef TCL_NO_DEPRECATED +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 Tcl_Obj *obj = Tcl_GetObjResult(interp); const char *bytes = TclGetString(obj); Tcl_DStringFree(dsPtr); Tcl_DStringAppend(dsPtr, bytes, obj->length); @@ -3646,11 +3644,11 @@ } /* *---------------------------------------------------------------------- * - * 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 @@ -3669,178 +3667,77 @@ * 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; - const char *opPtr; - int numType, length, t1 = 0, t2 = 0; 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; - return TCL_OK; - } - if (numType != TCL_NUMBER_BIG) { - /* Must be a double -> not a valid index */ - goto parseError; - } - - /* 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); - return TCL_OK; - } - - /* objPtr does not hold a number, check the end+/- format... */ - if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) { - return TCL_OK; - } - - /* 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 - * single index value. - */ - - /* - * Quick scan to see if multi-value list is even possible. - * This relies on TclGetString() returning a NUL-terminated string. - */ - if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1) - - /* If it's possible, do the full list parse. */ - && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) - && (length > 1)) { - goto parseError; - } - - /* Passed the list screen, so parse for index arithmetic expression */ - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr, - TCL_PARSE_INTEGER_ONLY)) { - Tcl_WideInt w1=0, w2=0; - - /* value starts with valid integer... */ - - if ((*opPtr == '-') || (*opPtr == '+')) { - /* ... value continues with [-+] ... */ - - /* Save first integer as wide if possible */ - TclGetNumberFromObj(NULL, objPtr, &cd, &t1); - if (t1 == TCL_NUMBER_INT) { - w1 = (*(Tcl_WideInt *)cd); - } - - if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1, - -1, NULL, TCL_PARSE_INTEGER_ONLY)) { - /* ... value concludes with second valid integer */ - - /* Save second integer as wide if possible */ - TclGetNumberFromObj(NULL, objPtr, &cd, &t2); - if (t2 == TCL_NUMBER_INT) { - w2 = (*(Tcl_WideInt *)cd); - } - } - } - /* Clear invalid intreps left by TclParseNumber */ - TclFreeIntRep(objPtr); - - if (t1 && t2) { - /* We have both integer values */ - if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) { - /* Both are wide, do wide-integer math */ - if (*opPtr == '-') { - if ((w2 == WIDE_MIN) && (interp != NULL)) { - goto extreme; - } - w2 = -w2; - } - - if ((w1 ^ w2) < 0) { - /* Different signs, sum cannot overflow */ - *widePtr = w1 + w2; - } else if (w1 >= 0) { - if (w1 < WIDE_MAX - w2) { - *widePtr = w1 + w2; - } else { - *widePtr = WIDE_MAX; - } - } else { - if (w1 > WIDE_MIN - w2) { - *widePtr = w1 + w2; - } else { - *widePtr = WIDE_MIN; - } - } - } else if (interp == NULL) { - /* - * We use an interp to do bignum index calculations. - * If we don't get one, call all indices with bignums errors, - * and rely on callers to handle it. - */ - return TCL_ERROR; - } else { - /* - * At least one is big, do bignum math. Little reason to - * value performance here. Re-use code. Parse has verified - * objPtr is an expression. Compute it. - */ - - Tcl_Obj *sum; - - extreme: - Tcl_ExprObj(interp, objPtr, &sum); - TclGetNumberFromObj(NULL, sum, &cd, &numType); - - if (numType == TCL_NUMBER_INT) { - /* sum holds an integer in the signed wide range */ - *widePtr = *(Tcl_WideInt *)cd; - } else { - /* sum holds an integer outside the signed wide range */ - /* Truncate to the signed wide range. */ - if (mp_isneg((mp_int *)cd)) { - *widePtr = WIDE_MIN; - } else { - *widePtr = WIDE_MAX; - } - } - Tcl_DecrRefCount(sum); - } - 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)); - if (!strncmp(bytes, "end-", 4)) { - bytes += 4; - } - TclCheckBadOctal(interp, bytes); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); - } + if ((*widePtr > (Tcl_WideInt)endValue) && (flags & TCL_INDEX_NOMAX)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = (Tcl_WideInt)endValue; + } + if ((*widePtr < 0) && (flags & TCL_INDEX_NOMIN)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = 0; + } + if ((*widePtr < 0) && (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 < 0) && (flags & TCL_INDEX_NOMIN)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = 0; + } + if ((*widePtr < 0) && (flags & TCL_INDEX_ERROR)) goto invalidWideIndex; + return TCL_OK; + } + } + + /* objPtr does not hold a number, check the end+/- format... */ + code = GetEndOffsetFromObj(interp, objPtr, endValue, widePtr); + if (code == TCL_OK) { + if ((*widePtr < 0) && (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; } /* *---------------------------------------------------------------------- @@ -3873,16 +3770,17 @@ * 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. */ { Tcl_WideInt wide; - if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) { + if (TclGetWideForIndex(interp, objPtr, endValue, flags, &wide) == TCL_ERROR) { return TCL_ERROR; } if (wide < 0) { *indexPtr = -1; } else if (wide > INT_MAX) { @@ -3895,12 +3793,23 @@ /* *---------------------------------------------------------------------- * * GetEndOffsetFromObj -- * - * Look for a string of the form "end[+-]offset" and convert it to an - * internal representation holding the offset. + * Look for a string of the form "end[+-]offset" or "offset[+-]offset" and + * convert it to an internal representation. + * + * The internal representation (wideValue) uses the following encoding: + * + * WIDE_MIN: Index value TCL_INDEX_NONE (or -1) + * WIDE_MIN+1: Index value n, for any n < -1 (usually same effect as -1) + * -$n: Index "end-[expr {$n-1}]" + * -2: Index "end-1" + * -1: Index "end" + * 0: Index "0" + * WIDE_MAX-1: Index "end+n", for any n > 1 + * WIDE_MAX: Index "end+1" * * Results: * Tcl return code. * * Side effects: @@ -3909,53 +3818,186 @@ *---------------------------------------------------------------------- */ static int GetEndOffsetFromObj( + Tcl_Interp *interp, Tcl_Obj *objPtr, /* Pointer to the object to parse */ size_t endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ { Tcl_ObjIntRep *irPtr; - Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */ + 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 ((length < 3) || (length == 4)) { - /* Too short to be "end" or to be "end-$integer" */ - return TCL_ERROR; - } - if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) { - /* Value doesn't start with "end" */ - return TCL_ERROR; - } - - if (length > 4) { - ClientData cd; + if (*bytes != 'e') { + int numType; + const char *opPtr; + int t1 = 0, t2 = 0; + + /* Value doesn't start with "e" */ + + if ((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 + * single index value. + */ + + /* + * Quick scan to see if multi-value list is even possible. + * This relies on TclGetString() returning a NUL-terminated string. + */ + if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1) + + /* If it's possible, do the full list parse. */ + && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length)) + && (length > 1)) { + goto parseError; + } + + /* Passed the list screen, so parse for index arithmetic expression */ + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr, + TCL_PARSE_INTEGER_ONLY)) { + Tcl_WideInt w1=0, w2=0; + + /* value starts with valid integer... */ + + if ((*opPtr == '-') || (*opPtr == '+')) { + /* ... value continues with [-+] ... */ + + /* Save first integer as wide if possible */ + TclGetNumberFromObj(NULL, objPtr, &cd, &t1); + if (t1 == TCL_NUMBER_INT) { + w1 = (*(Tcl_WideInt *)cd); + } + + if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1, + -1, NULL, TCL_PARSE_INTEGER_ONLY)) { + /* ... value concludes with second valid integer */ + + /* Save second integer as wide if possible */ + TclGetNumberFromObj(NULL, objPtr, &cd, &t2); + if (t2 == TCL_NUMBER_INT) { + w2 = (*(Tcl_WideInt *)cd); + } + } + } + /* Clear invalid intreps left by TclParseNumber */ + TclFreeIntRep(objPtr); + + if (t1 && t2) { + /* We have both integer values */ + if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) { + /* Both are wide, do wide-integer math */ + if (*opPtr == '-') { + if ((w2 == WIDE_MIN) && (interp != NULL)) { + goto extreme; + } + w2 = -w2; + } + + if ((w1 ^ w2) < 0) { + /* Different signs, sum cannot overflow */ + offset = w1 + w2; + } else if (w1 >= 0) { + if (w1 < WIDE_MAX - w2) { + offset = w1 + w2; + } else { + offset = WIDE_MAX; + } + } else { + if (w1 > WIDE_MIN - w2) { + offset = w1 + w2; + } else { + offset = WIDE_MIN; + } + } + } else if (interp == NULL) { + /* + * We use an interp to do bignum index calculations. + * If we don't get one, call all indices with bignums errors, + * and rely on callers to handle it. + */ + goto parseError; + } else { + /* + * At least one is big, do bignum math. Little reason to + * value performance here. Re-use code. Parse has verified + * objPtr is an expression. Compute it. + */ + + Tcl_Obj *sum; + + extreme: + Tcl_ExprObj(interp, objPtr, &sum); + TclGetNumberFromObj(NULL, sum, &cd, &numType); + + if (numType == TCL_NUMBER_INT) { + /* sum holds an integer in the signed wide range */ + offset = *(Tcl_WideInt *)cd; + } else { + /* sum holds an integer outside the signed wide range */ + /* Truncate to the signed wide range. */ + if (mp_isneg((mp_int *)cd)) { + offset = WIDE_MIN; + } 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; + } + + if ((length < 3) || (length == 4) || (strncmp(bytes, "end", 3) != 0)) { + /* Doesn't start with "end" */ + goto parseError; + } + if (length > 4) { int t; /* Parse for the "end-..." or "end+..." formats */ if ((bytes[3] != '-') && (bytes[3] != '+')) { /* No operator where we need one */ - return TCL_ERROR; + goto parseError; } if (TclIsSpaceProc(bytes[4])) { /* Space after + or - not permitted. */ - return TCL_ERROR; + goto parseError; } /* Parse the integer offset */ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) { /* Not a recognized integer format */ - return TCL_ERROR; + goto parseError; } /* Got an integer offset; pull it from where parser left it. */ TclGetNumberFromObj(NULL, objPtr, &cd, &t); @@ -3970,31 +4012,78 @@ /* assert (t == TCL_NUMBER_INT); */ 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 (endValue == (size_t)-1) { - *widePtr = offset - 1; + if (offset == WIDE_MAX) { + *widePtr = endValue + 1; + } else if (offset == WIDE_MIN) { + *widePtr = -1; + } else if (endValue == (size_t)-1) { + *widePtr = offset; } else if (offset < 0) { - /* Different signs, sum cannot overflow */ - *widePtr = endValue + offset; - } else if (endValue < (Tcl_WideUInt)WIDE_MAX - offset) { - *widePtr = endValue + offset; + /* Different signs, sum cannot overflow */ + *widePtr = endValue + offset + 1; + } else if (offset < WIDE_MAX) { + *widePtr = offset; } else { - *widePtr = WIDE_MAX; + *widePtr = WIDE_MAX; } 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?," + " 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 } /* *---------------------------------------------------------------------- * @@ -4056,56 +4145,36 @@ 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 */ { - ClientData cd; Tcl_WideInt wide; - int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType); - - if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) { - /* We parsed a value in the range WIDE_MIN...WIDE_MAX */ - wide = (*(Tcl_WideInt *)cd); - integerEncode: - if (wide < TCL_INDEX_START) { - /* All negative absolute indices are "before the beginning" */ - idx = before; - } else if (wide >= INT_MAX) { - /* This index value is always "after the end" */ - idx = after; - } else { - idx = (int) wide; - } - /* usual case, the absolute index value encodes itself */ - } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) { - /* - * We parsed an end+offset index value. - * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. - */ - if (wide > 0) { - /* - * All end+postive or end-negative expressions - * always indicate "after the end". - */ - idx = after; - } else if (wide < INT_MIN - TCL_INDEX_END) { - /* These indices always indicate "before the beginning */ - idx = before; - } else { - /* Encoded end-positive (or end+negative) are offset */ - idx = (int)wide + TCL_INDEX_END; - } - - /* TODO: Consider flag to suppress repeated end-offset parse. */ - } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) { - /* - * Only reach this case when the index value is a - * constant index arithmetic expression, and wide - * holds the result. Treat it the same as if it were - * parsed as an absolute integer value. - */ - goto integerEncode; + int idx; + + if (TCL_OK == TclGetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , 0, &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. + */ + if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) { + /* + * All end+postive or end-negative expressions + * always indicate "after the end". + */ + idx = after; + } else if (wide <= (irPtr ? INT_MAX : TCL_INDEX_NONE)) { + /* These indices always indicate "before the beginning */ + idx = before; + } else { + /* Encoded end-positive (or end+negative) are offset */ + idx = (int)wide; + } } else { return TCL_ERROR; } *indexPtr = idx; return TCL_OK; Index: tests/assemble.test ================================================================== --- tests/assemble.test +++ tests/assemble.test @@ -29,10 +29,11 @@ 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] @@ -1557,14 +1558,14 @@ 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 Index: tests/cmdIL.test ================================================================== --- tests/cmdIL.test +++ tests/cmdIL.test @@ -61,11 +61,11 @@ 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}} @@ -797,16 +797,16 @@ 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 + lremove {a b c} none } -result {a b c} test cmdIL-8.6 {lremove command: after end} -body { lremove {a b c} 3 } -result {a b c} test cmdIL-8.7 {lremove command} -body { Index: tests/compile.test ================================================================== --- tests/compile.test +++ tests/compile.test @@ -315,14 +315,14 @@ # 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} }} Index: tests/lindex.test ================================================================== --- tests/lindex.test +++ tests/lindex.test @@ -20,10 +20,11 @@ ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] set minus - 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 @@ -45,11 +46,11 @@ [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 @@ -80,14 +81,14 @@ 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 { 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 @@ -120,23 +121,23 @@ 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} @@ -237,11 +238,11 @@ 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 @@ -326,11 +327,11 @@ 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 @@ -337,15 +338,15 @@ 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 Index: tests/linsert.test ================================================================== --- tests/linsert.test +++ tests/linsert.test @@ -83,14 +83,14 @@ 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 Index: tests/lrange.test ================================================================== --- tests/lrange.test +++ tests/lrange.test @@ -18,10 +18,11 @@ ::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} { @@ -77,14 +78,14 @@ 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 @@ -96,52 +97,51 @@ }} {1 2 3 4 5} } {} test lrange-3.2 {compiled with static indices out of range, negative} { 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} -constraints nodep -body { 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 { +} -result [lrepeat 4 {}] +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)} -constraints nodep -body { 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}] +} -result [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]} -constraints nodep -body { 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 { +} -result [lrepeat 6 {}] +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 {}] @@ -210,11 +210,11 @@ # 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 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 { Index: tests/lreplace.test ================================================================== --- tests/lreplace.test +++ tests/lreplace.test @@ -117,17 +117,17 @@ 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 @@ -215,11 +215,11 @@ # 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 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 { Index: tests/lsearch.test ================================================================== --- tests/lsearch.test +++ tests/lsearch.test @@ -298,11 +298,11 @@ 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 {} @@ -491,11 +491,11 @@ 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} { Index: tests/lset.test ================================================================== --- tests/lset.test +++ tests/lset.test @@ -47,11 +47,11 @@ 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}} @@ -89,11 +89,11 @@ 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 @@ -131,11 +131,11 @@ 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 @@ -271,15 +271,15 @@ 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 { Index: tests/regexp.test ================================================================== --- tests/regexp.test +++ tests/regexp.test @@ -280,11 +280,11 @@ 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} { @@ -477,11 +477,11 @@ 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 @@ -542,11 +542,11 @@ 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} @@ -588,11 +588,11 @@ 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} @@ -653,11 +653,11 @@ set foo {} list [regsub -start 1 y+ "xy" & foo] $foo } -result {1 xy} test regexp-16.19 {regsub -start} -body { set foo {} - list [regsub -start -1 a+ "" & foo] $foo + list [regsub -start none a+ "" & foo] $foo } -result {0 {}} test regexp-16.20 {regsub -start, loss of ^$ behavior} -body { set foo NA list [regsub -start 1 {^$} {} & foo] $foo } -result {0 {}} Index: tests/regexpComp.test ================================================================== --- tests/regexpComp.test +++ tests/regexpComp.test @@ -356,11 +356,11 @@ } {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 } @@ -602,11 +602,11 @@ } {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 @@ -665,11 +665,11 @@ 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} @@ -693,11 +693,11 @@ 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} Index: tests/string.test ================================================================== --- tests/string.test +++ tests/string.test @@ -30,10 +30,12 @@ testConstraint testobj [expr {[info commands testobj] ne {}}] testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] testConstraint testevalex [expr {[info commands testevalex] ne {}}] testConstraint tip389 [expr {[string length \U010000] == 2}] +testConstraint nodep [info exists tcl_precision] +testConstraint deprecated [expr {![info exists tcl_precision]}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { @@ -368,11 +370,11 @@ 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} @@ -403,11 +405,11 @@ } -result -1 test string-4.13.$noComp {string first, start index} -body { run {string first \u7266 abc\u7266x end-2} } -result 3 test string-4.14.$noComp {string first, negative start index} -body { - run {string first b abc -1} + run {string first b abc none} } -result 1 test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body { # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded # strings was incorrect, leading to an index returned by [string first] # which pointed past the end of the string. @@ -423,20 +425,20 @@ } -result {{string 1} {string 0} 2} test string-4.17.$noComp {string first, corner case} -body { run {string first a aaa 4294967295} } -result {-1} test string-4.18.$noComp {string first, corner case} -body { - run {string first a aaa -1} + run {string first a aaa none} } -result {0} test string-4.19.$noComp {string first, corner case} -body { run {string first a aaa end-5} } -result {0} test string-4.20.$noComp {string last, corner case} -body { run {string last a aaa 4294967295} } -result {2} test string-4.21.$noComp {string last, corner case} -body { - run {string last a aaa -1} + run {string last a aaa none} } -result {-1} test string-4.22.$noComp {string last, corner case} { run {string last a aaa end-5} } {-1} @@ -454,15 +456,15 @@ } e test string-5.5.$noComp {string index} { run {string index abcde 5} } {} test string-5.6.$noComp {string index} { - list [catch {run {string index abcde -10}} msg] $msg + list [catch {run {string index abcde none}} 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} @@ -498,11 +500,11 @@ } -match glob -result {1 {*invalid octal number*}} test string-5.18.$noComp {string index, bad integer} -body { list [catch {run {string index "abc" end-0o0289}} msg] $msg } -match glob -result {1 {*invalid octal number*}} test string-5.19.$noComp {string index, bytearray object out of bounds} { - run {string index [binary format I* {0x50515253 0x52}] -1} + run {string index [binary format I* {0x50515253 0x52}] none} } {} test string-5.20.$noComp {string index, bytearray object out of bounds} -body { run {string index [binary format I* {0x50515253 0x52}] 20} } -result {} test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints {tip389} -body { @@ -531,14 +533,14 @@ 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 @@ -967,19 +969,74 @@ list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var } {0 87} test string-6.131.$noComp {string is entier, false on bad hex} { list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var } {0 88} +test string-6.132.$noComp {string is index, true} { + run {string is index +1234567890} +} 1 +test string-6.133.$noComp {string is index, true} { + run {string is index 1} +} 1 +test string-6.134.$noComp {string is index, true} { + run {string is index 0} +} 1 +test string-6.135.$noComp {string is index, true} { + run {string is index -1} +} 1 +test string-6.136.$noComp {string is index, false} { + run {string is index -2} +} 0 +test string-6.137.$noComp {string is index, false} { + run {string is index end+2} +} 0 +test string-6.138.$noComp {string is index, true} { + run {string is index end+1} +} 1 +test string-6.139.$noComp {string is index, true} { + run {string is index end-9999999} +} 1 +test string-6.140.$noComp {string is index, true} { + run {string is index none} +} 1 +test string-6.141.$noComp {string is none, false} { + run {string is none +1234567890} +} 0 +test string-6.142.$noComp {string is none, false} { + run {string is none 1} +} 0 +test string-6.143.$noComp {string is none, false} { + run {string is none 0} +} 0 +test string-6.144.$noComp {string is none, true} -constraints nodep -body { + run {string is none 1-2} +} -result 1 +test string-6.145.$noComp {string is none, true} { + run {string is none -1} +} 1 +test string-6.146.$noComp {string is none, false} { + run {string is none -2} +} 0 +test string-6.147.$noComp {string is none, false} { + run {string is none end+2} +} 0 +test string-6.148.$noComp {string is none, false} { + run {string is none end+1} +} 0 +test string-6.149.$noComp {string is none, true} { + run {string is none none} +} 1 + 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} @@ -1438,27 +1495,27 @@ } {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 none 2} } {abc} test string-12.9.$noComp {string range} { - run {string range abcdefghijklmnop -3 -2} + run {string range abcdefghijklmnop none none} } {} 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} @@ -1572,27 +1629,27 @@ } {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} { - run {string replace abcdefghijklmnop -3 -2} + run {string replace abcdefghijklmnop none none} } {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} @@ -1602,11 +1659,11 @@ } {abcdefghijklmnop} test string-14.18.$noComp {string replace} { run {string replace abcdefghijklmnop 10 9 XXX} } {abcdefghijklmnop} test string-14.19.$noComp {string replace} { - run {string replace {} -1 0 A} + run {string replace {} none 0 A} } A test string-14.20.$noComp {string replace} { run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\ [makeByteArray NEW]} } {abcdeNEWop} @@ -1654,11 +1711,11 @@ 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} @@ -1688,11 +1745,11 @@ 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} @@ -1722,11 +1779,11 @@ 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"} @@ -1820,13 +1877,13 @@ 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} + run {string wordend abc. none} } -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 { @@ -1866,19 +1923,19 @@ 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 { @@ -2361,11 +2418,11 @@ } 0123 test string-31.9.$noComp {string insert, empty strings} { run {tcl::string::insert {} 0 {}} } {} test string-31.10.$noComp {string insert, negative index} { - run {tcl::string::insert 0123 -1 _} + run {tcl::string::insert 0123 none _} } _0123 test string-31.11.$noComp {string insert, index beyond end} { run {tcl::string::insert 0123 5 _} } 0123_ test string-31.12.$noComp {string insert, start of string, pure byte array} { Index: tests/util.test ================================================================== --- tests/util.test +++ tests/util.test @@ -21,11 +21,11 @@ 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 @@ -730,23 +730,23 @@ 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} -constraints nodep -body { string index abcd -0x10000000000000000 -} {} +} -result {} 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} @@ -770,11 +770,11 @@ 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