Index: doc/IntObj.3 ================================================================== --- doc/IntObj.3 +++ doc/IntObj.3 @@ -30,11 +30,11 @@ .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int -\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR) +\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, flags, intPtr\fR) .sp int \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) .sp int @@ -58,10 +58,13 @@ \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out .AP int endValue in \fBTcl_GetIntForIndex\fR will return this when the input value is "end". +.AP int flags in +\fBTcl_GetIntForIndex\fR will behave more strict when flags is not 0. Any +combination of TCL_INDEX_ERROR, TCL_INDEX_NOMIN or TCL_INDEX_NOMAX is accepted. .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in 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/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], INT_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, TCL_INDEX_ERROR, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -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], INT_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, TCL_INDEX_ERROR, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -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; } } @@ -1316,11 +1316,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; @@ -1360,11 +1360,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; @@ -1405,11 +1405,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); @@ -1473,11 +1473,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; @@ -1529,22 +1529,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 { @@ -1750,10 +1750,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; } @@ -2289,12 +2299,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; @@ -2397,12 +2407,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 @@ -2507,11 +2517,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; @@ -2577,11 +2587,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; @@ -2930,20 +2940,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; @@ -3015,20 +3025,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; @@ -3100,20 +3110,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/tclCompCmdsGR.c ================================================================== --- generic/tclCompCmdsGR.c +++ generic/tclCompCmdsGR.c @@ -1870,10 +1870,12 @@ PushStringLiteral(envPtr, "0"); PushStringLiteral(envPtr, "::"); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitOpcode( INST_STR_FIND_LAST, envPtr); off = CurrentOffset(envPtr); + /* TODO: If INST_STR_FIND_LAST results in -1, we shouldn't substract + * "1" since that leads to the deprecated index "-2". See TIP #577 */ PushStringLiteral(envPtr, "1"); TclEmitOpcode( INST_SUB, envPtr); TclEmitInstInt4( INST_OVER, 2, envPtr); TclEmitInstInt4( INST_OVER, 1, envPtr); TclEmitOpcode( INST_STR_INDEX, envPtr); 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/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); Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -2519,15 +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) \ +#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), (idxPtr))) + : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (flags) & ~(TCL_INDEX_ERROR|TCL_INDEX_NOMIN|TCL_INDEX_NOMAX), (idxPtr))) +#endif + +MODULE_SCOPE int TclGetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, + size_t endValue, int flags, Tcl_WideInt *widePtr); /* * Macro used to save a function call for common uses of * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is: * @@ -2769,10 +2780,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, INT_MAX - 1, &index) == TCL_OK) { + && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, TCL_INDEX_ERROR, &index) == TCL_OK) { /* * argPtr designates a single index. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); @@ -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], INT_MAX - 1, &index) + if (TclGetIntForIndexM(interp, indexArray[i], INT_MAX - 1, TCL_INDEX_ERROR, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; } } @@ -1437,16 +1437,17 @@ List *listRepPtr; /* * Determine whether the index arg designates a list or a single index. * We have to be careful about the order of the checks to avoid repeated - * shimmering; see TIP #22 and #23 for details. + * shimmering; see TIP #22 and #23 for details. Don't allow "" as single + * index here, since it cannot be distinguished from an empty list. */ ListGetIntRep(indexArgPtr, listRepPtr); - if (listRepPtr == NULL - && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) { + if (listRepPtr == NULL && Tcl_GetString(indexArgPtr)[0] + && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, TCL_INDEX_ERROR, &index) == TCL_OK) { /* * indexArgPtr designates a single index. */ return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr); @@ -1589,11 +1590,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 @@ -151,10 +151,16 @@ /* * Array of values describing how to implement each standard subcommand of the * "namespace" command. */ + +#if defined(TCL_NO_DEPRECATED) || (TCL_MAJOR_VERSION > 8) + /* TODO: Fix TclCompileNamespaceQualifiersCmd, so it doesn't use index "-2", + * which arises from substracting "1" from "-1" */ +# define TclCompileNamespaceQualifiersCmd NULL +#endif static const EnsembleImplMap defaultNamespaceMap[] = { {"children", NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, {"code", NamespaceCodeCmd, TclCompileNamespaceCodeCmd, NULL, NULL, 0}, {"current", NamespaceCurrentCmd, TclCompileNamespaceCurrentCmd, NULL, NULL, 0}, Index: generic/tclRegexp.c ================================================================== --- generic/tclRegexp.c +++ generic/tclRegexp.c @@ -676,11 +676,11 @@ * well and Tcl has other limits that constrain things as well... */ resultObj = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub)); + Tcl_NewWideIntObj(regexpPtr->re.re_nsub)); /* * Now append a list of all the bit-flags set for the RE. */ 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/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -6896,16 +6896,13 @@ } bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc == 3) { - if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) { + if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, TCL_INDEX_ERROR|TCL_INDEX_NOMIN, &offset)) { return TCL_ERROR; } - if (offset < 0) { - offset = 0; - } if (offset > numBytes) { offset = numBytes; } } else { offset = numBytes; @@ -6929,11 +6926,12 @@ if (objc > 1) { int numBytes, len, limit = -1; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); if (objc > 2) { - if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[2], numBytes, + TCL_INDEX_ERROR|TCL_INDEX_NOMIN, &limit) != TCL_OK) { return TCL_ERROR; } if (limit > numBytes + 1) { limit = numBytes + 1; } Index: generic/tclUtil.c ================================================================== --- generic/tclUtil.c +++ generic/tclUtil.c @@ -109,12 +109,10 @@ static void FreeProcessGlobalValue(ClientData clientData); static void FreeThreadHash(ClientData clientData); static int GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, Tcl_WideInt *indexPtr); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); -static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, int stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, const char **nextPtr, int *sizePtr, int *literalPtr); @@ -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 */ @@ -3595,11 +3593,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 @@ -3618,19 +3616,20 @@ * 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; @@ -3638,22 +3637,57 @@ if (code == TCL_OK) { if (numType == TCL_NUMBER_INT) { /* objPtr holds an integer in the signed wide range */ *widePtr = *(Tcl_WideInt *)cd; + if ((*widePtr > (Tcl_WideInt)endValue) && (flags & TCL_INDEX_NOMAX)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = (Tcl_WideInt)endValue; + } + if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = 0; + } + if ((*widePtr < -1) && (flags & TCL_INDEX_ERROR)) goto invalidWideIndex; return TCL_OK; } if (numType == TCL_NUMBER_BIG) { /* objPtr holds an integer outside the signed wide range */ /* Truncate to the signed wide range. */ *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX); + if ((*widePtr > (Tcl_WideInt)endValue) && (flags & TCL_INDEX_NOMAX)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = (Tcl_WideInt)endValue; + } + if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = 0; + } + if ((*widePtr < -1) && (flags & TCL_INDEX_ERROR)) goto invalidWideIndex; return TCL_OK; } } /* objPtr does not hold a number, check the end+/- format... */ - return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr); + code = GetEndOffsetFromObj(interp, objPtr, endValue, widePtr); + if (code == TCL_OK) { + if ((*widePtr < -1) && (flags & TCL_INDEX_NOMIN)) { + if (flags & TCL_INDEX_ERROR) goto invalidWideIndex; + *widePtr = 0; + } + } + return code; + + invalidWideIndex: + if (interp != NULL) { + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", bytes)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", NULL); + } + + return TCL_ERROR; } /* *---------------------------------------------------------------------- * @@ -3685,25 +3719,24 @@ * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ int endValue, /* The value to be stored at "indexPtr" if * "objPtr" holds "end". */ + int flags, int *indexPtr) /* Location filled in with an integer * representing an index. May be NULL.*/ { Tcl_WideInt wide; - if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) { + if (TclGetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, flags, &wide) == TCL_ERROR) { return TCL_ERROR; } if (indexPtr != NULL) { if ((wide < 0) && (endValue > TCL_INDEX_END)) { *indexPtr = -1; - } else if (wide > INT_MAX) { + } else if ((wide > (endValue + 1)) && (endValue > TCL_INDEX_END)) { *indexPtr = INT_MAX; - } else if (wide < INT_MIN) { - *indexPtr = INT_MIN; } else { *indexPtr = (int) wide; } } return TCL_OK; @@ -3747,21 +3780,26 @@ { Tcl_ObjIntRep *irPtr; Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */ ClientData cd; - while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) { + while ((irPtr = TclFetchIntRep(objPtr, &tclEndOffsetType)) == NULL) { Tcl_ObjIntRep ir; int length; const char *bytes = TclGetStringFromObj(objPtr, &length); if (*bytes != 'e') { int numType; const char *opPtr; - int length, t1 = 0, t2 = 0; + int t1 = 0, t2 = 0; /* Value doesn't start with "e" */ + + if ((length == 0) || ((length == 4) && (strncmp(bytes, "none", 4) == 0))) { + offset = WIDE_MIN; + goto parseOK; + } /* If we reach here, the string rep of objPtr exists. */ /* * The valid index syntax does not include any value that is @@ -3872,11 +3910,15 @@ } } 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; @@ -3924,21 +3966,25 @@ offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset; } if (offset == 1) { offset = WIDE_MAX; /* "end+1" */ } else if (offset > 1) { +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 + goto parseError2; +#else offset = WIDE_MAX - 1; /* "end+n", out of range */ +#endif } else if (offset != WIDE_MIN) { offset--; } } } parseOK: /* Success. Store the new internal rep. */ ir.wideValue = offset; - Tcl_StoreIntRep(objPtr, &endOffsetType, &ir); + Tcl_StoreIntRep(objPtr, &tclEndOffsetType, &ir); } offset = irPtr->wideValue; if (offset == WIDE_MAX) { @@ -3960,20 +4006,35 @@ /* Report a parse error. */ parseError: if (interp != NULL) { char * bytes = TclGetString(objPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad index \"%s\": must be integer?[+-]integer? or" - " end?[+-]integer?", bytes)); + "bad index \"%s\": must be integer?[+-]integer?," + " end?[+-]integer? or none", bytes)); if (!strncmp(bytes, "end-", 4)) { bytes += 4; } TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } return TCL_ERROR; + +#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 + parseError2: + if (interp != NULL) { + char * bytes = TclGetString(objPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", bytes)); + if (!strncmp(bytes, "end-", 4)) { + bytes += 4; + } + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", NULL); + } + + return TCL_ERROR; +#endif } /* *---------------------------------------------------------------------- * @@ -4027,10 +4088,15 @@ * to *indexPtr. * *---------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +#undef TCL_INDEX_ERROR +#define TCL_INDEX_ERROR 0 +#endif + int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ int before, /* Value to return for index before beginning */ @@ -4038,12 +4104,12 @@ int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; - if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) { - const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &endOffsetType); + if (TCL_OK == TclGetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END, TCL_INDEX_ERROR, &wide)) { + const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclEndOffsetType); if (irPtr && irPtr->wideValue >= 0) { /* "int[+-]int" syntax, works the same here as "int" */ irPtr = NULL; } /* Index: library/clock.tcl ================================================================== --- library/clock.tcl +++ library/clock.tcl @@ -3504,17 +3504,19 @@ # nIsStd standard/DST indicators and nIsGMT UTC/local indicators. if {$version eq {2}} { set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}] set last [string first \n $d $seek] - set posix [string range $d $seek [expr {$last-1}]] - if {[llength $posix] > 0} { - set posixFields [ParsePosixTimeZone $posix] - foreach tuple [ProcessPosixTimeZone $posixFields] { - lassign $tuple t gmtoff isDst abbrev - if {$t > $lastTime} { - lappend r $tuple + if {![string is none $last] && $last > 0} { + set posix [string range $d $seek [expr {$last-1}]] + if {[llength $posix] > 0} { + set posixFields [ParsePosixTimeZone $posix] + foreach tuple [ProcessPosixTimeZone $posixFields] { + lassign $tuple t gmtoff isDst abbrev + if {$t > $lastTime} { + lappend r $tuple + } } } } } Index: library/init.tcl ================================================================== --- library/init.tcl +++ library/init.tcl @@ -236,33 +236,55 @@ # # Stack trace is nested, trim off just the contribution # from the extra "eval" of $args due to the "catch" above. # set last [string last $tail $errInfo] - if {$last + [string length $tail] != [string length $errInfo]} { - # Very likely cannot happen - return -options $opts $msg + if {![string is none $last]} { + if {$last + [string length $tail] != [string length $errInfo]} { + # Very likely cannot happen + return -options $opts $msg + } + if {$last > 0} { + set errInfo [string range $errInfo 0 $last-1] + } else { + set errInfo {} + } } - set errInfo [string range $errInfo 0 $last-1] set tail "\"$cinfo\"" set last [string last $tail $errInfo] - if {$last + [string length $tail] != [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo $errInfo $msg + if {![string is none $last]} { + if {$last + [string length $tail] != [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo $errInfo $msg + } + if {$last > 0} { + set errInfo [string range $errInfo 0 $last-1] + } else { + set errInfo {} + } } - set errInfo [string range $errInfo 0 $last-1] set tail "\n invoked from within\n" set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { + if {![string is none $last] && $last + [string length $tail] == [string length $errInfo]} { + if {$last > 0} { + set errInfo [string range $errInfo 0 $last-1] + } else { + set errInfo {} + } return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg + -errorinfo $errInfo $msg } set tail "\n while executing\n" set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { + if {![string is none $last] && $last + [string length $tail] == [string length $errInfo]} { + if {$last > 0} { + set errInfo [string range $errInfo 0 $last-1] + } else { + set errInfo {} + } return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg + -errorinfo $errInfo $msg } return -options $opts $msg } else { dict incr opts -level return -options $opts $msg @@ -740,11 +762,11 @@ \"$dest\": file already exists" } } } } else { - if {[string first $nsrc $ndest] != -1} { + if {![string is none [string first $nsrc $ndest]]} { set srclen [expr {[llength [file split $nsrc]] - 1}] set ndest [lindex [file split $ndest] $srclen] if {$ndest eq [file tail $nsrc]} { return -code error "error $action \"$src\" to\ \"$dest\": trying to rename a volume or move a directory\ Index: library/word.tcl ================================================================== --- library/word.tcl +++ library/word.tcl @@ -134,11 +134,11 @@ # start - Index into string specifying starting point. proc tcl_startOfPreviousWord {str start} { variable ::tcl::WordBreakRE set word {-1 -1} - if {$start > 0} { + if {![string is none $start] && $start > 0} { regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \ result word } return [lindex $word 0] } Index: tests/aaa_exit.test ================================================================== --- tests/aaa_exit.test +++ tests/aaa_exit.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } test exit-1.1 {normal, quick exit} { Index: tests/append.test ================================================================== --- tests/append.test +++ tests/append.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } unset -nocomplain x Index: tests/appendComp.test ================================================================== --- tests/appendComp.test +++ tests/appendComp.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } catch {unset x} Index: tests/apply.test ================================================================== --- tests/apply.test +++ tests/apply.test @@ -10,11 +10,11 @@ # Copyright (c) 2005-2006 Miguel Sofer # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.2 namespace import -force ::tcltest::* } if {[info commands ::apply] eq {}} { 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/async.test ================================================================== --- tests/async.test +++ tests/async.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/binary.test ================================================================== --- tests/binary.test +++ tests/binary.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] Index: tests/case.test ================================================================== --- tests/case.test +++ tests/case.test @@ -14,11 +14,11 @@ if {![llength [info commands case]]} { # No "case" command? So no need to test return } -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test case-1.1 {simple pattern} { Index: tests/chan.test ================================================================== --- tests/chan.test +++ tests/chan.test @@ -5,11 +5,11 @@ # Copyright (c) 2005 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # Index: tests/chanio.test ================================================================== --- tests/chanio.test +++ tests/chanio.test @@ -12,11 +12,11 @@ # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # TODO: This test is likely worthless. Confirm and remove -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 } namespace eval ::tcl::test::io { namespace import ::tcltest::* Index: tests/clock.test ================================================================== --- tests/clock.test +++ tests/clock.test @@ -9,11 +9,11 @@ # Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } if {[testConstraint win]} { Index: tests/cmdIL.test ================================================================== --- tests/cmdIL.test +++ tests/cmdIL.test @@ -6,11 +6,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands @@ -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,11 +797,11 @@ 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 Index: tests/compExpr-old.test ================================================================== --- tests/compExpr-old.test +++ tests/compExpr-old.test @@ -10,11 +10,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands 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/config.test ================================================================== --- tests/config.test +++ tests/config.test @@ -10,11 +10,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test pkgconfig-1.1 {query keys} { Index: tests/coroutine.test ================================================================== --- tests/coroutine.test +++ tests/coroutine.test @@ -7,11 +7,11 @@ # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/dict.test ================================================================== --- tests/dict.test +++ tests/dict.test @@ -7,11 +7,11 @@ # # Copyright (c) 2003-2009 Donal K. Fellows # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.5 namespace import -force ::tcltest::* } # Used for constraining memory leak tests Index: tests/env.test ================================================================== --- tests/env.test +++ tests/env.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } loadTestedCommands Index: tests/error.test ================================================================== --- tests/error.test +++ tests/error.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } testConstraint memory [llength [info commands memory]] Index: tests/expr.test ================================================================== --- tests/expr.test +++ tests/expr.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/for-old.test ================================================================== --- tests/for-old.test +++ tests/for-old.test @@ -10,11 +10,11 @@ # Copyright (c) 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } # Check "for" and its use of continue and break. Index: tests/for.test ================================================================== --- tests/for.test +++ tests/for.test @@ -7,11 +7,11 @@ # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # Used for constraining memory leak tests Index: tests/foreach.test ================================================================== --- tests/foreach.test +++ tests/foreach.test @@ -8,11 +8,11 @@ # Copyright (c) 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } catch {unset a} Index: tests/format.test ================================================================== --- tests/format.test +++ tests/format.test @@ -8,11 +8,11 @@ # Copyright (c) 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # %u output depends on word length, so this test is not portable. Index: tests/get.test ================================================================== --- tests/get.test +++ tests/get.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/if-old.test ================================================================== --- tests/if-old.test +++ tests/if-old.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test if-old-1.1 {taking proper branch} { Index: tests/if.test ================================================================== --- tests/if.test +++ tests/if.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # Basic "if" operation. Index: tests/incr-old.test ================================================================== --- tests/incr-old.test +++ tests/incr-old.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } catch {unset x} Index: tests/indexObj.test ================================================================== --- tests/indexObj.test +++ tests/indexObj.test @@ -6,11 +6,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/io.test ================================================================== --- tests/io.test +++ tests/io.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 } namespace eval ::tcl::test::io { namespace import ::tcltest::* Index: tests/ioCmd.test ================================================================== --- tests/ioCmd.test +++ tests/ioCmd.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.5 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/ioTrans.test ================================================================== --- tests/ioTrans.test +++ tests/ioTrans.test @@ -9,11 +9,11 @@ # # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands @@ -34,11 +34,11 @@ # Helper commands to record the arguments to handler methods. Stored in a # script so that the tests needing this code do not need their own copy but # can access this variable. set helperscript { - if {[lsearch [namespace children] ::tcltest] == -1} { + if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # This forces the return options to be in the order that the test expects! Index: tests/join.test ================================================================== --- tests/join.test +++ tests/join.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test join-1.1 {basic join commands} { Index: tests/lindex.test ================================================================== --- tests/lindex.test +++ tests/lindex.test @@ -10,20 +10,21 @@ # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] -set minus - +set non non testConstraint testevalex [llength [info commands testevalex]] +testConstraint nodep [info exists tcl_precision] # Tests of Tcl_LindexObjCmd, NOT COMPILED test lindex-1.1 {wrong # args} testevalex { list [catch {testevalex lindex} result] $result @@ -45,16 +46,16 @@ [testevalex {lindex {{a b c} {d e f}} $x}] } {f f} test lindex-2.4 {malformed index list} testevalex { set x \{ list [catch { testevalex {lindex {a b c} $x} } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?,\ end?\[+-\]integer?\ or\ none} # Indices that are integers or convertible to integers test lindex-3.1 {integer -1} -constraints testevalex -body { - set x ${minus}1 + set x ${non}e list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] } -result {{} {}} test lindex-3.2 {integer 0} -constraints testevalex -body { set x [string range 00 0 0] list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}] @@ -77,17 +78,17 @@ } -match glob -result {1 {*invalid octal number*}} test lindex-3.7 {indexes don't shimmer wide ints} -body { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] } -result {2147483646 {} 2147483647 2147483648} -test lindex-3.8 {compiled with static indices out of range, negative} -body { +test lindex-3.8 {compiled with static indices out of range, negative} -constraints nodep -body { list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3] } -result [lrepeat 3 {}] -test lindex-3.9 {compiled with calculated indices out of range, negative constant} -body { +test lindex-3.9 {compiled with calculated indices out of range, negative constant} -constraints nodep -body { list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1] } -result [lrepeat 3 {}] -test lindex-3.10 {compiled with calculated indices out of range, after end} -body { +test lindex-3.10 {compiled with calculated indices out of range, after end} -constraints nodep -body { list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3] } -result [lrepeat 3 {}] # Indices relative to end @@ -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,16 +238,16 @@ set result } {f f} test lindex-10.4 {malformed index list} { set x \{ list [catch { lindex {a b c} $x } result] $result -} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?} +} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?,\ end?\[+-\]integer?\ or\ none} # Indices that are integers or convertible to integers test lindex-11.1 {integer -1} { - set x ${minus}1 + set x ${non}e catch { list [lindex {a b c} $x] [lindex {a b c} $x] } result set result } {{} {}} @@ -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 @@ -447,14 +448,14 @@ } -match glob -result {bad index "foo"*} -returnCodes 1 test lindex-17.1 {Bug 1718580} -body { lindex a end foo } -match glob -result {bad index "foo"*} -returnCodes 1 -catch { unset minus } +catch { unset non } # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: Index: tests/linsert.test ================================================================== --- tests/linsert.test +++ tests/linsert.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } catch {unset lis} @@ -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/list.test ================================================================== --- tests/list.test +++ tests/list.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } # First, a bunch of individual tests Index: tests/listObj.test ================================================================== --- tests/listObj.test +++ tests/listObj.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/llength.test ================================================================== --- tests/llength.test +++ tests/llength.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test llength-1.1 {length of list} { Index: tests/load.test ================================================================== --- tests/load.test +++ tests/load.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/lpop.test ================================================================== --- tests/lpop.test +++ tests/lpop.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } unset -nocomplain no; # following tests expecting var "no" does not exists @@ -44,11 +44,11 @@ lpop l end+1 } -result {index "end+1" out of range} test lpop-1.7 {error conditions} -returnCodes error -body { set l "x y" lpop l {} -} -match glob -result {bad index *} +} -match glob -result {index "" out of range} test lpop-1.8 {error conditions} -returnCodes error -body { set l "x y" lpop l 0 0 0 0 1 } -result {index "1" out of range} test lpop-1.9 {error conditions} -returnCodes error -body { Index: tests/lrange.test ================================================================== --- tests/lrange.test +++ tests/lrange.test @@ -9,19 +9,20 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] testConstraint testpurebytesobj [llength [info commands testpurebytesobj]] +testConstraint nodep [info exists tcl_precision] test lrange-1.1 {range of list elements} { lrange {a b c d} 1 2 } {b c} test lrange-1.2 {range of list elements} { @@ -40,14 +41,14 @@ lrange {a {bcd e {f g {}}} l14 l15 d} 10 11 } {} test lrange-1.7 {range of list elements} { lrange {a b c d e} -1 2 } {a b c} -test lrange-1.8 {range of list elements} { +test lrange-1.8 {range of list elements} nodep { lrange {a b c d e} -2 -1 } {} -test lrange-1.9 {range of list elements} { +test lrange-1.9 {range of list elements} nodep { lrange {a b c d e} -2 end } {a b c d e} test lrange-1.10 {range of list elements} { lrange "a b\{c d" 1 2 } "b\\{c d" @@ -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 @@ -93,55 +94,61 @@ test lrange-3.1 {Bug 3588366: end-offsets before start} { apply {l { lrange $l 0 end-5 }} {1 2 3 4 5} } {} -test lrange-3.2 {compiled with static indices out of range, negative} { +test lrange-3.2 {compiled with static indices out of range, negative} nodep { list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3] } [lrepeat 4 {}] -test lrange-3.3 {compiled with calculated indices out of range, negative constant} { +test lrange-3.3 {compiled with calculated indices out of range, negative constant} nodep { list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1] } [lrepeat 4 {}] -test lrange-3.4 {compiled with calculated indices out of range, after end} -body { +test lrange-3.4 {compiled with calculated indices out of range, after end} -constraints nodep -body { list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2] } -result [lrepeat 4 {}] -test lrange-3.5 {compiled with calculated indices, start out of range (negative)} { +test lrange-3.5 {compiled with calculated indices, start out of range (negative)} nodep { list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1] } [lrepeat 4 {a b}] test lrange-3.6 {compiled with calculated indices, end out of range (after end)} { list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1] } [lrepeat 4 {b c}] -test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} { +test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} nodep { list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \ [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1] } [lrepeat 6 {}] -test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -body { +test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -constraints { + nodep +} -body { set cmd lrange list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \ [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1] } -result [lrepeat 6 {}] # following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep # (as before the fix [58c46e74b931d3a1]): -test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} { +test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -constraints { + nodep +} -body { list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \ [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1] -} [lrepeat 6 {}] -test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -body { +} -result [lrepeat 6 {}] +test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -constraints { + nodep +} -body { set cmd lrange list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1] } -result [lrepeat 6 {}] test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { - testpurebytesobj + testpurebytesobj nodep } -body { list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1] } -result [lrepeat 6 {}] test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints { - testpurebytesobj + testpurebytesobj nodep } -body { set cmd lrange list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1] } -result [lrepeat 6 {}] @@ -210,11 +217,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 -1 0 1 2 3 end-3 end-2 end-1 end end+1} set lrange lrange foreach ls $lss { foreach a $idxs { foreach b $idxs { Index: tests/lrepeat.test ================================================================== --- tests/lrepeat.test +++ tests/lrepeat.test @@ -7,11 +7,11 @@ # Copyright (c) 2003 by Simon Geard. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ## Arg errors Index: tests/lreplace.test ================================================================== --- tests/lreplace.test +++ tests/lreplace.test @@ -9,14 +9,15 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } +testConstraint nodep [info exists tcl_precision] test lreplace-1.1 {lreplace command} { lreplace {1 2 3 4 5} 0 0 a } {a 2 3 4 5} test lreplace-1.2 {lreplace command} { @@ -117,17 +118,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 +216,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 -1 0 1 2 3 end-3 end-2 end-1 end end+1} set lreplace lreplace foreach ls $lss { foreach a $idxs { foreach b $idxs { 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 @@ -9,11 +9,11 @@ # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands @@ -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/lsetComp.test ================================================================== --- tests/lsetComp.test +++ tests/lsetComp.test @@ -9,11 +9,11 @@ # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } # Procedure to evaluate a script within a proc, to test compilation Index: tests/macOSXFCmd.test ================================================================== --- tests/macOSXFCmd.test +++ tests/macOSXFCmd.test @@ -7,11 +7,11 @@ # Copyright (c) 2003 Tcl Core Team. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } # These tests really need to be run from a writable directory, which Index: tests/macOSXLoad.test ================================================================== --- tests/macOSXLoad.test +++ tests/macOSXLoad.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } set oldTSF $::tcltest::testSingleFile set ::tcltest::testSingleFile false Index: tests/mathop.test ================================================================== --- tests/mathop.test +++ tests/mathop.test @@ -8,11 +8,11 @@ # Copyright (c) 2006 Peter Spjuth # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.1 namespace import -force ::tcltest::* } # A namespace to test that operators are exported and that they Index: tests/misc.test ================================================================== --- tests/misc.test +++ tests/misc.test @@ -10,11 +10,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/notify.test ================================================================== --- tests/notify.test +++ tests/notify.test @@ -11,11 +11,11 @@ # Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/nre.test ================================================================== --- tests/nre.test +++ tests/nre.test @@ -7,11 +7,11 @@ # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/obj.test ================================================================== --- tests/obj.test +++ tests/obj.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/opt.test ================================================================== --- tests/opt.test +++ tests/opt.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } # the package we are going to test Index: tests/pid.test ================================================================== --- tests/pid.test +++ tests/pid.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } testConstraint pidDefined [llength [info commands pid]] Index: tests/proc-old.test ================================================================== --- tests/proc-old.test +++ tests/proc-old.test @@ -12,11 +12,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } catch {rename t1 ""} Index: tests/process.test ================================================================== --- tests/process.test +++ tests/process.test @@ -6,11 +6,11 @@ # # Copyright (c) 2017 Frederic Bonnet # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # Utilities Index: tests/pwd.test ================================================================== --- tests/pwd.test +++ tests/pwd.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } test pwd-1.1 {simple pwd} { Index: tests/reg.test ================================================================== --- tests/reg.test +++ tests/reg.test @@ -7,11 +7,11 @@ # and aren't using Tcl -- reg's own regression tester also knows how # to read this file, ignoring the Tcl-isms.) # # Copyright (c) 1998, 1999 Henry Spencer. All rights reserved. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] 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} Index: tests/regexpComp.test ================================================================== --- tests/regexpComp.test +++ tests/regexpComp.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # Procedure to evaluate a script within a proc, to test compilation @@ -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/registry.test ================================================================== --- tests/registry.test +++ tests/registry.test @@ -8,11 +8,11 @@ # auto_path or the registry package must have been loaded already. # # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } testConstraint reg 0 Index: tests/rename.test ================================================================== --- tests/rename.test +++ tests/rename.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/safe.test ================================================================== --- tests/safe.test +++ tests/safe.test @@ -10,11 +10,11 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. package require Tcl 8.5- -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } foreach i [interp slaves] { Index: tests/set-old.test ================================================================== --- tests/set-old.test +++ tests/set-old.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } proc ignore args {} Index: tests/set.test ================================================================== --- tests/set.test +++ tests/set.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/socket.test ================================================================== --- tests/socket.test +++ tests/socket.test @@ -58,11 +58,11 @@ # server will be performed; otherwise, it will attempt to start the remote # server (via exec) on platforms that support this, on the local host, # listening at port 2048. If all fails, a message is printed and the tests # using the remote server are not performed. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/split.test ================================================================== --- tests/split.test +++ tests/split.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test split-1.1 {basic split commands} { Index: tests/string.test ================================================================== --- tests/string.test +++ tests/string.test @@ -10,11 +10,11 @@ # Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands @@ -31,10 +31,11 @@ testConstraint testobj [expr {[info commands testobj] ne {}}] testConstraint testindexobj [expr {[info commands testindexobj] ne {}}] testConstraint testevalex [expr {[info commands testevalex] ne {}}] testConstraint utf16 [expr {[string length \U010000] == 2}] testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint nodep [info exists tcl_precision] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { proc getbytes {} { @@ -369,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} @@ -454,16 +455,16 @@ run {string ind abcde 4} } e test string-5.5.$noComp {string index} { run {string index abcde 5} } {} -test string-5.6.$noComp {string index} { +test string-5.6.$noComp {string index} nodep { list [catch {run {string index abcde -10}} msg] $msg } {0 {}} test string-5.7.$noComp {string index} { list [catch {run {string index a xyz}} msg] $msg -} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "xyz": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-5.8.$noComp {string index} { run {string index abc end} } c test string-5.9.$noComp {string index} { run {string index abc end-1} @@ -532,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 @@ -976,11 +977,11 @@ 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} @@ -1439,27 +1440,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 -1 2} } {abc} -test string-12.9.$noComp {string range} { +test string-12.9.$noComp {string range} nodep { run {string range abcdefghijklmnop -3 -2} } {} test string-12.10.$noComp {string range} { run {string range abcdefghijklmnop 1000 1010} } {} test string-12.11.$noComp {string range} { - run {string range abcdefghijklmnop -100 end} + run {string range abcdefghijklmnop none end} } {abcdefghijklmnop} test string-12.12.$noComp {string range} { list [catch {run {string range abc abc 1}} msg] $msg -} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "abc": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-12.13.$noComp {string range} { list [catch {run {string range abc 1 eof}} msg] $msg -} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "eof": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-12.14.$noComp {string range} { run {string range abcdefghijklmnop end-1 end} } {op} test string-12.15.$noComp {string range} { run {string range abcdefghijklmnop end 1000} @@ -1573,27 +1574,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} { +test string-14.10.$noComp {string replace} nodep { run {string replace abcdefghijklmnop -3 -2} } {abcdefghijklmnop} test string-14.11.$noComp {string replace} -body { run {string replace abcdefghijklmnop 1000 1010} } -result {abcdefghijklmnop} test string-14.12.$noComp {string replace} { - run {string replace abcdefghijklmnop -100 end} + run {string replace abcdefghijklmnop none end} } {} test string-14.13.$noComp {string replace} { list [catch {run {string replace abc abc 1}} msg] $msg -} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "abc": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-14.14.$noComp {string replace} { list [catch {run {string replace abc 1 eof}} msg] $msg -} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}} +} {1 {bad index "eof": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-14.15.$noComp {string replace} { run {string replace abcdefghijklmnop end-10 end-2 NEW} } {abcdeNEWop} test string-14.16.$noComp {string replace} { run {string replace abcdefghijklmnop 0 end foo} @@ -1655,11 +1656,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} @@ -1689,11 +1690,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} @@ -1723,11 +1724,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"} @@ -1849,11 +1850,11 @@ test string-21.2.$noComp {string wordend} -body { list [catch {run {string wordend a b c}} msg] $msg } -result {1 {wrong # args: should be "string wordend string index"}} test string-21.3.$noComp {string wordend} -body { list [catch {run {string wordend a gorp}} msg] $msg -} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}} +} -result {1 {bad index "gorp": must be integer?[+-]integer?, end?[+-]integer? or none}} test string-21.4.$noComp {string wordend} -body { run {string wordend abc. -1} } -result 3 test string-21.5.$noComp {string wordend} -body { run {string wordend abc. 100} @@ -1901,19 +1902,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 { Index: tests/stringObj.test ================================================================== --- tests/stringObj.test +++ tests/stringObj.test @@ -10,11 +10,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/subst.test ================================================================== --- tests/subst.test +++ tests/subst.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2.1 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands catch [list package require -exact Tcltest [info patchlevel]] Index: tests/tailcall.test ================================================================== --- tests/tailcall.test +++ tests/tailcall.test @@ -7,11 +7,11 @@ # Copyright (c) 2008 by Miguel Sofer. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/timer.test ================================================================== --- tests/timer.test +++ tests/timer.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup { Index: tests/unixFCmd.test ================================================================== --- tests/unixFCmd.test +++ tests/unixFCmd.test @@ -7,11 +7,11 @@ # Copyright (c) 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/unixFile.test ================================================================== --- tests/unixFile.test +++ tests/unixFile.test @@ -7,11 +7,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/unixNotfy.test ================================================================== --- tests/unixNotfy.test +++ tests/unixNotfy.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } # When run in a Tk shell, these tests hang. Index: tests/unload.test ================================================================== --- tests/unload.test +++ tests/unload.test @@ -9,11 +9,11 @@ # Copyright (c) 2003-2004 by Georgios Petasis # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/uplevel.test ================================================================== --- tests/uplevel.test +++ tests/uplevel.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } proc a {x y} { Index: tests/upvar.test ================================================================== --- tests/upvar.test +++ tests/upvar.test @@ -9,11 +9,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/utf.test ================================================================== --- tests/utf.test +++ tests/utf.test @@ -6,11 +6,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest 2 namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/util.test ================================================================== --- tests/util.test +++ tests/util.test @@ -5,11 +5,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands @@ -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 @@ -690,11 +690,11 @@ } b test util-9.18 {Tcl_GetIntForIndex} { string index abcd { -1--2 } } b test util-9.19 {Tcl_GetIntForIndex} -body { - string index a {} + string index a _ } -returnCodes error -match glob -result * test util-9.20 {Tcl_GetIntForIndex} -body { string index a { } } -returnCodes error -match glob -result * test util-9.21 {Tcl_GetIntForIndex} -body { @@ -773,21 +773,21 @@ string index a 0+1.5e1 } -returnCodes error -match glob -result * test util-9.44 {Tcl_GetIntForIndex} -body { string index a 0+1000000000000 } -result {} -test util-9.45 {Tcl_GetIntForIndex} -body { +test util-9.45 {Tcl_GetIntForIndex} -constraints nodep -body { string index abcd end+2305843009213693950 } -result {} -test util-9.46 {Tcl_GetIntForIndex} -body { +test util-9.46 {Tcl_GetIntForIndex} -constraints nodep -body { string index abcd end+4294967294 } -result {} # TIP 502 test util-9.47 {Tcl_GetIntForIndex} -body { string index abcd 0x10000000000000000 } -result {} -test util-9.48 {Tcl_GetIntForIndex} { +test util-9.48 {Tcl_GetIntForIndex} nodep { string index abcd -0x10000000000000000 } {} test util-9.49 {Tcl_GetIntForIndex} -body { string index abcd end*1 } -returnCodes error -match glob -result * @@ -813,11 +813,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 Index: tests/while-old.test ================================================================== --- tests/while-old.test +++ tests/while-old.test @@ -11,11 +11,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } test while-old-1.1 {basic while loops} { Index: tests/winConsole.test ================================================================== --- tests/winConsole.test +++ tests/winConsole.test @@ -7,11 +7,11 @@ # Copyright (c) 1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } Index: tests/winFCmd.test ================================================================== --- tests/winFCmd.test +++ tests/winFCmd.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/winNotify.test ================================================================== --- tests/winNotify.test +++ tests/winNotify.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands Index: tests/winTime.test ================================================================== --- tests/winTime.test +++ tests/winTime.test @@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {[lsearch [namespace children] ::tcltest] == -1} { +if {[string is none [lsearch [namespace children] ::tcltest]]} { package require tcltest namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands