diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r-- | generic/tclCmdMZ.c | 266 |
1 files changed, 202 insertions, 64 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ba1fc41..3f79ca4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -323,7 +323,7 @@ Tcl_RegexpObjCmd( if (match == 0) { /* - * We want to set the value of the interpreter result only when + * We want to set the value of the intepreter result only when * this is the first time through the loop. */ @@ -989,11 +989,8 @@ TclNRSourceObjCmd( { const char *encodingName = NULL; Tcl_Obj *fileName; - int result; - void **pkgFiles = NULL; - void *names = NULL; - if (objc < 2 || objc > 4) { + if (objc != 2 && objc !=4) { Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName"); return TCL_ERROR; } @@ -1011,30 +1008,9 @@ TclNRSourceObjCmd( return TCL_ERROR; } encodingName = TclGetString(objv[2]); - } else if (objc == 3) { - /* Handle undocumented -nopkg option. This should only be - * used by the internal ::tcl::Pkg::source utility function. */ - static const char *const nopkgoptions[] = { - "-nopkg", NULL - }; - int index; - - if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions, - "option", TCL_EXACT, &index)) { - return TCL_ERROR; - } - pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - /* Make sure that during the following TclNREvalFile no filenames - * are recorded for inclusion in the "package files" command */ - names = *pkgFiles; - *pkgFiles = NULL; - } - result = TclNREvalFile(interp, fileName, encodingName); - if (pkgFiles) { - /* restore "tclPkgFiles" assocdata to how it was. */ - *pkgFiles = names; } - return result; + + return TclNREvalFile(interp, fileName, encodingName); } /* @@ -1200,7 +1176,8 @@ StringFirstCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int start = 0; + Tcl_UniChar *needleStr, *haystackStr; + int match, start, needleLen, haystackLen; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1208,23 +1185,82 @@ StringFirstCmd( return TCL_ERROR; } + /* + * We are searching haystackStr for the sequence needleStr. + */ + + match = -1; + start = 0; + haystackLen = -1; + + needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); + haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); + if (objc == 4) { - int size = Tcl_GetCharLength(objv[2]); + /* + * If a startIndex is specified, we will need to fast forward to that + * point in the string before we think about a match. + */ - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) { + if (TclGetIntForIndexM(interp, objv[3], haystackLen-1, + &start) != TCL_OK){ return TCL_ERROR; } - if (start < 0) { + /* + * Reread to prevent shimmering problems. + */ + + needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); + haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); + + if (start >= haystackLen) { + goto str_first_done; + } else if (start > 0) { + haystackStr += start; + haystackLen -= start; + } else if (start < 0) { + /* + * Invalid start index mapped to string start; Bug #423581 + */ + start = 0; } - if (start >= size) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); - return TCL_OK; + } + + /* + * If the length of the needle is more than the length of the haystack, it + * cannot be contained in there so we can avoid searching. [Bug 2960021] + */ + + if (needleLen > 0 && needleLen <= haystackLen) { + register Tcl_UniChar *p, *end; + + end = haystackStr + haystackLen - needleLen + 1; + for (p = haystackStr; p < end; p++) { + /* + * Scan forward to find the first character. + */ + + if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p, + (unsigned long) needleLen) == 0)) { + match = p - haystackStr; + break; + } } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1], - objv[2], start))); + + /* + * Compute the character index of the matching string by counting the + * number of characters before the match. + */ + + if ((match != -1) && (objc == 4)) { + match += start; + } + + str_first_done: + Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } @@ -1253,31 +1289,76 @@ StringLastCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int last = INT_MAX - 1; + Tcl_UniChar *needleStr, *haystackStr, *p; + int match, start, needleLen, haystackLen; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, - "needleString haystackString ?lastIndex?"); + "needleString haystackString ?startIndex?"); return TCL_ERROR; } + /* + * We are searching haystackString for the sequence needleString. + */ + + match = -1; + start = 0; + haystackLen = -1; + + needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); + haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); + if (objc == 4) { - int size = Tcl_GetCharLength(objv[2]); + /* + * If a startIndex is specified, we will need to restrict the string + * range to that char index in the string + */ - if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) { + if (TclGetIntForIndexM(interp, objv[3], haystackLen-1, + &start) != TCL_OK){ return TCL_ERROR; } - if (last < 0) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); - return TCL_OK; + /* + * Reread to prevent shimmering problems. + */ + + needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen); + haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen); + + if (start < 0) { + goto str_last_done; + } else if (start < haystackLen) { + p = haystackStr + start + 1 - needleLen; + } else { + p = haystackStr + haystackLen - needleLen; } - if (last >= size) { - last = size - 1; + } else { + p = haystackStr + haystackLen - needleLen; + } + + /* + * If the length of the needle is more than the length of the haystack, it + * cannot be contained in there so we can avoid searching. [Bug 2960021] + */ + + if (needleLen > 0 && needleLen <= haystackLen) { + for (; p >= haystackStr; p--) { + /* + * Scan backwards to find the first character. + */ + + if ((*p == *needleStr) && !memcmp(needleStr, p, + sizeof(Tcl_UniChar) * (size_t)needleLen)) { + match = p - haystackStr; + break; + } } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1], - objv[2], last))); + + str_last_done: + Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } @@ -1565,7 +1646,7 @@ StringIsCmd( } break; case STR_IS_WIDE: - if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) { + if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) { break; } @@ -1792,7 +1873,7 @@ StringMapCmd( /* * This test is tricky, but has to be that way or you get other strange - * inconsistencies (see test string-10.20.1 for illustration why!) + * inconsistencies (see test string-10.20 for illustration why!) */ if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){ @@ -2142,7 +2223,9 @@ StringReptCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int count; + const char *string1; + char *string2; + int count, index, length1, length2; Tcl_Obj *resultPtr; if (objc != 3) { @@ -2160,15 +2243,70 @@ StringReptCmd( if (count == 1) { Tcl_SetObjResult(interp, objv[1]); - return TCL_OK; + goto done; } else if (count < 1) { - return TCL_OK; + goto done; + } + string1 = TclGetStringFromObj(objv[1], &length1); + if (length1 <= 0) { + goto done; + } + + /* + * Only build up a string that has data. Instead of building it up with + * repeated appends, we just allocate the necessary space once and copy + * the string value in. + * + * We have to worry about overflow [Bugs 714106, 2561746]. + * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX. + * We need to keep 2 <= length2 <= INT_MAX. + */ + + if (count > INT_MAX/length1) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "result exceeds max size for a Tcl value (%d bytes)", + INT_MAX)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + return TCL_ERROR; } + length2 = length1 * count; - if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) { + /* + * Include space for the NUL. + */ + + string2 = attemptckalloc((unsigned) length2 + 1); + if (string2 == NULL) { + /* + * Alloc failed. Note that in this case we try to do an error message + * since this is a case that's most likely when the alloc is large and + * that's easy to do with this API. Note that if we fail allocating a + * short string, this will likely keel over too (and fatally). + */ + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "string size overflow, out of memory allocating %u bytes", + length2 + 1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } + for (index = 0; index < count; index++) { + memcpy(string2 + (length1 * index), string1, (size_t) length1); + } + string2[length2] = '\0'; + + /* + * We have to directly assign this instead of using Tcl_SetStringObj (and + * indirectly TclInitStringRep) because that makes another copy of the + * data. + */ + + TclNewObj(resultPtr); + resultPtr->bytes = string2; + resultPtr->length = length2; Tcl_SetObjResult(interp, resultPtr); + + done: return TCL_OK; } @@ -2717,7 +2855,7 @@ StringCatCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int code; + int i; Tcl_Obj *objResultPtr; if (objc < 2) { @@ -2734,16 +2872,16 @@ StringCatCmd( Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - - code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1, - &objResultPtr); - - if (code == TCL_OK) { - Tcl_SetObjResult(interp, objResultPtr); - return TCL_OK; + objResultPtr = objv[1]; + if (Tcl_IsShared(objResultPtr)) { + objResultPtr = Tcl_DuplicateObj(objResultPtr); } + for(i = 2;i < objc;i++) { + Tcl_AppendObjToObj(objResultPtr, objv[i]); + } + Tcl_SetObjResult(interp, objResultPtr); - return code; + return TCL_OK; } /* @@ -4181,7 +4319,7 @@ TclNRTryObjCmd( } info[0] = objv[i]; /* type */ - TclNewLongObj(info[1], code); /* returnCode */ + TclNewIntObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } |