summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c41
-rw-r--r--generic/tclCmdMZ.c17
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclStringObj.c40
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;
+}
+
/*
*---------------------------------------------------------------------------
*