summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclCmdMZ.c15
-rw-r--r--generic/tclDictObj.c9
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclInt.h5
-rw-r--r--generic/tclStringObj.c35
6 files changed, 31 insertions, 42 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 77b8434..fa32340 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2193,8 +2193,7 @@ Tcl_JoinObjCmd(
(void) Tcl_GetStringFromObj(joinObjPtr, &length);
if (length == 0) {
- TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
- &resObjPtr);
+ resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
} else {
int i;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index e0344ef..f9e404b 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2847,7 +2847,6 @@ StringCatCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int code;
Tcl_Obj *objResultPtr;
if (objc < 2) {
@@ -2857,23 +2856,15 @@ StringCatCmd(
*/
return TCL_OK;
}
- if (objc == 2) {
- /*
- * Other trivial case, single arg, just return it.
- */
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
- }
- code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
- &objResultPtr);
+ objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);
- if (code == TCL_OK) {
+ if (objResultPtr) {
Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
}
- return code;
+ return TCL_ERROR;
}
/*
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 3b983e3..a0f6491 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2309,9 +2309,12 @@ DictAppendCmd(
if (objc == 4) {
appendObjPtr = objv[3];
- } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
- objc-3, objv+3, &appendObjPtr)) {
- return TCL_ERROR;
+ } else {
+ appendObjPtr = TclStringCat(interp, objc-3, objv+3,
+ TCL_STRING_IN_PLACE);
+ if (appendObjPtr == NULL) {
+ return TCL_ERROR;
+ }
}
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f2cda0c..a30ec89 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2682,9 +2682,9 @@ TEBCresume(
case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
-
- if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
- opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
+ objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
+ TCL_STRING_IN_PLACE);
+ if (objResultPtr == NULL) {
TRACE_ERROR(interp);
goto gotError;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cee1d3a..6cb9955 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3189,9 +3189,6 @@ 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 inPlace,
- int objc, Tcl_Obj *const objv[],
- Tcl_Obj **objPtrPtr);
MODULE_SCOPE int TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
int start);
MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
@@ -4010,6 +4007,8 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
* candidates for public interface.
*/
+MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags);
MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
int count, int flags);
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8bb76c1..46162ff 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -2843,40 +2843,39 @@ TclStringRepeat(
/*
*---------------------------------------------------------------------------
*
- * TclStringCatObjv --
+ * TclStringCat --
*
* Performs the [string cat] function.
*
* Results:
- * A standard Tcl result.
+ * A (Tcl_Obj *) pointing to the result value, or NULL in case of an
+ * error.
*
* Side effects:
- * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
- * of all objc values in objv.
+ * On error, when interp is not NULL, error information is left in it.
*
*---------------------------------------------------------------------------
*/
-int
-TclStringCatObjv(
+Tcl_Obj *
+TclStringCat(
Tcl_Interp *interp,
- int inPlace,
int objc,
Tcl_Obj * const objv[],
- Tcl_Obj **objPtrPtr)
+ int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, length = 0, binary = 1;
int allowUniChar = 1, requestUniChar = 0;
int first = objc - 1; /* Index of first value possibly not empty */
int last = 0; /* Index of last value possibly not empty */
+ int inPlace = flags & TCL_STRING_IN_PLACE;
/* assert ( objc >= 0 ) */
if (objc <= 1) {
/* Only one or no objects; return first or empty */
- *objPtrPtr = objc ? objv[0] : Tcl_NewObj();
- return TCL_OK;
+ return objc ? objv[0] : Tcl_NewObj();
}
/* assert ( objc >= 2 ) */
@@ -3053,8 +3052,7 @@ TclStringCatObjv(
if (last <= first /*|| length == 0 */) {
/* Only one non-empty value or zero length; return first */
/* NOTE: (length == 0) implies (last <= first) */
- *objPtrPtr = objv[first];
- return TCL_OK;
+ return objv[first];
}
objv += first; objc = (last - first + 1);
@@ -3108,7 +3106,7 @@ TclStringCatObjv(
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetUnicode(objResultPtr) + start;
} else {
@@ -3125,7 +3123,7 @@ TclStringCatObjv(
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetUnicode(objResultPtr);
}
@@ -3156,7 +3154,7 @@ TclStringCatObjv(
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetString(objResultPtr) + start;
@@ -3172,7 +3170,7 @@ TclStringCatObjv(
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetString(objResultPtr);
}
@@ -3187,8 +3185,7 @@ TclStringCatObjv(
}
}
}
- *objPtrPtr = objResultPtr;
- return TCL_OK;
+ return objResultPtr;
overflow:
if (interp) {
@@ -3196,7 +3193,7 @@ TclStringCatObjv(
"max size for a Tcl value (%d bytes) exceeded", INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
/*
generated by cgit v0.12 at 2024-10-23 05:30:56 (GMT)