diff options
| -rw-r--r-- | generic/tclCmdIL.c | 41 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 17 | ||||
| -rw-r--r-- | generic/tclExecute.c | 8 | ||||
| -rw-r--r-- | generic/tclInt.h | 2 | ||||
| -rw-r--r-- | generic/tclStringObj.c | 40 |
5 files changed, 84 insertions, 24 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 7f4ca1d..09adc8d 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2155,8 +2155,8 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int listLen, i; - Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs; + int listLen; + Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?"); @@ -2186,24 +2186,35 @@ Tcl_JoinObjCmd( joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); - resObjPtr = Tcl_NewObj(); - for (i = 0; i < listLen; i++) { - if (i > 0) { + if (Tcl_GetCharLength(joinObjPtr) == 0) { + Tcl_IncrRefCount(elemPtrs[0]); + TclStringCatObjv(interp, listLen, elemPtrs, &resObjPtr); + Tcl_DecrRefCount(elemPtrs[0]); + } else { + int i; - /* - * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** - * to shimmer joinObjPtr. If it did, then the case where - * objv[1] and objv[2] are the same value would not be safe. - * Accessing elemPtrs would crash. - */ + resObjPtr = Tcl_NewObj(); + for (i = 0; i < listLen; i++) { + if (i > 0) { + + /* + * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** + * to shimmer joinObjPtr. If it did, then the case where + * objv[1] and objv[2] are the same value would not be safe. + * Accessing elemPtrs would crash. + */ - Tcl_AppendObjToObj(resObjPtr, joinObjPtr); + Tcl_AppendObjToObj(resObjPtr, joinObjPtr); + } + Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } - Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } Tcl_DecrRefCount(joinObjPtr); - Tcl_SetObjResult(interp, resObjPtr); - return TCL_OK; + if (resObjPtr) { + Tcl_SetObjResult(interp, resObjPtr); + return TCL_OK; + } + return TCL_ERROR; } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 591e31c..1a08674 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2855,7 +2855,7 @@ StringCatCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i; + int code; Tcl_Obj *objResultPtr; if (objc < 2) { @@ -2872,16 +2872,15 @@ StringCatCmd( Tcl_SetObjResult(interp, objv[1]); 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]); + + code = TclStringCatObjv(interp, objc-1, objv+1, &objResultPtr); + + if (code == TCL_OK) { + Tcl_SetObjResult(interp, objResultPtr); + return TCL_OK; } - Tcl_SetObjResult(interp, objResultPtr); - return TCL_OK; + return code; } /* diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b19754e..fcf5ba9 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2692,6 +2692,13 @@ TEBCresume( opnd = TclGetUInt1AtPtr(pc+1); +#if 1 + if (TCL_OK != TclStringCatObjv(interp, opnd, &OBJ_AT_DEPTH(opnd-1), + &objResultPtr)) { + TRACE_ERROR(interp); + goto gotError; + } +#else /* * Detect only-bytearray-or-null case. */ @@ -2828,6 +2835,7 @@ TEBCresume( } } } +#endif TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(2, opnd, 1); diff --git a/generic/tclInt.h b/generic/tclInt.h index da1b5c5..36c1a81 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3135,6 +3135,8 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); +MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], Tcl_Obj **objPtrPtr); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index fefb014..cc30602 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2609,6 +2609,46 @@ TclGetStringStorage( *sizePtr = stringPtr->allocated; return objPtr->bytes; } + +/* + *--------------------------------------------------------------------------- + * + * TclStringCatObjv -- + * + * Performs the [string cat] function. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation + * of all objc values in objv. + * + *--------------------------------------------------------------------------- + */ + +int +TclStringCatObjv( + Tcl_Interp *interp, + int objc, + Tcl_Obj * const objv[], + Tcl_Obj **objPtrPtr) +{ + Tcl_Obj *objResultPtr; + + /* assert (objc >= 2) */ + + objResultPtr = *objv++; objc--; + if (Tcl_IsShared(objResultPtr)) { + objResultPtr = Tcl_DuplicateObj(objResultPtr); + } + while (objc--) { + Tcl_AppendObjToObj(objResultPtr, *objv++); + } + *objPtrPtr = objResultPtr; + return TCL_OK; +} + /* *--------------------------------------------------------------------------- * |