summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-10-28 20:33:55 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-10-28 20:33:55 (GMT)
commiteb3b46a34f42059728dc5d5c220c4757dd0b1b2b (patch)
tree16c01949747920bbaedbd89f9a55f0e63b67d017
parent29038829dceb276e2d15cae2097f302f46eb272f (diff)
downloadtcl-eb3b46a34f42059728dc5d5c220c4757dd0b1b2b.zip
tcl-eb3b46a34f42059728dc5d5c220c4757dd0b1b2b.tar.gz
tcl-eb3b46a34f42059728dc5d5c220c4757dd0b1b2b.tar.bz2
WIP
-rw-r--r--generic/tclCmdIL.c5
-rw-r--r--generic/tclCmdMZ.c3
-rw-r--r--generic/tclDictObj.c4
-rw-r--r--generic/tclExecute.c4
-rw-r--r--generic/tclInt.h5
-rw-r--r--generic/tclStringObj.c58
6 files changed, 68 insertions, 11 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 09adc8d..73bd36f 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2187,9 +2187,8 @@ Tcl_JoinObjCmd(
Tcl_IncrRefCount(joinObjPtr);
if (Tcl_GetCharLength(joinObjPtr) == 0) {
- Tcl_IncrRefCount(elemPtrs[0]);
- TclStringCatObjv(interp, listLen, elemPtrs, &resObjPtr);
- Tcl_DecrRefCount(elemPtrs[0]);
+ TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
+ &resObjPtr);
} else {
int i;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1a08674..10c2ef3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2873,7 +2873,8 @@ StringCatCmd(
return TCL_OK;
}
- code = TclStringCatObjv(interp, objc-1, objv+1, &objResultPtr);
+ code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
+ &objResultPtr);
if (code == TCL_OK) {
Tcl_SetObjResult(interp, objResultPtr);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 3be968a..9686c6f 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2314,8 +2314,8 @@ DictAppendCmd(
if (objc == 4) {
appendObjPtr = objv[3];
- } else if (TCL_OK != TclStringCatObjv(interp, objc-3, objv+3,
- &appendObjPtr)) {
+ } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
+ objc-3, objv+3, &appendObjPtr)) {
return TCL_ERROR;
}
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fcf5ba9..1cf8548 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2693,8 +2693,8 @@ TEBCresume(
opnd = TclGetUInt1AtPtr(pc+1);
#if 1
- if (TCL_OK != TclStringCatObjv(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
- &objResultPtr)) {
+ if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
+ opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
TRACE_ERROR(interp);
goto gotError;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 36c1a81..8a647f0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3135,8 +3135,9 @@ 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 TclStringCatObjv(Tcl_Interp *interp, int inPlace,
+ 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 cc30602..c248749 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2630,18 +2630,74 @@ TclGetStringStorage(
int
TclStringCatObjv(
Tcl_Interp *interp,
+ int inPlace,
int objc,
Tcl_Obj * const objv[],
Tcl_Obj **objPtrPtr)
{
Tcl_Obj *objResultPtr;
+ int i, length = 0, binary = 1, first = 0;
/* assert (objc >= 2) */
+ /*
+ * GOALS: Avoid shimmering & string rep generation.
+ * Produce pure bytearray when possible.
+ * Error on overflow.
+ */
+
+ for (i = 0; i < objc && binary; i++) {
+ Tcl_Obj *objPtr = objv[i];
+
+ if (objPtr->bytes) {
+ if (objPtr->length == 0) {
+ continue;
+ }
+ binary = 0;
+ } else if (!TclIsPureByteArray(objPtr)) {
+ binary = 0;
+ }
+ }
+
+ if (binary) {
+ for (i = 0; i < objc && length >= 0; i++) {
+ if (objv[i]->bytes == NULL) {
+ int numBytes;
+
+ Tcl_GetByteArrayFromObj(objv[i], &numBytes);
+ if (length == 0) {
+ first = i;
+ }
+ length += numBytes;
+ }
+ }
+ if (length < 0) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max size for a Tcl value (%d bytes) exceeded",
+ INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (length == 0) {
+ /* Total length of zero means every value has length zero */
+ *objPtrPtr = objv[0];
+ return TCL_OK;
+ }
+ }
+
+ objv += first; objc -= first;
objResultPtr = *objv++; objc--;
- if (Tcl_IsShared(objResultPtr)) {
+ if (!inPlace || Tcl_IsShared(objResultPtr)) {
objResultPtr = Tcl_DuplicateObj(objResultPtr);
}
+
+ if (binary) {
+ Tcl_SetByteArrayLength(objResultPtr, length);
+ }
+
+
while (objc--) {
Tcl_AppendObjToObj(objResultPtr, *objv++);
}