diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r-- | generic/tclCmdMZ.c | 71 |
1 files changed, 71 insertions, 0 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 0f7f20a..ea5d7a4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2838,6 +2838,76 @@ StringCmpCmd( /* *---------------------------------------------------------------------- * + * StringCatCmd -- + * + * This procedure is invoked to process the "string cat" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +StringCatCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + int tot, i, length; + char *bytes, *p; + Tcl_Obj *objResultPtr; + + /* + * NOTE: this implementation aims for simplicity, not speed, because all + * speed-critical uses of [string cat] will involve the compiled variant + * anyway. Thus we avoid code duplication (from TEBC/INST_CONCAT1) without + * sacrificing perf. + */ + + if (objc < 2) { + /* + * If there are no args, the result is an empty object. + * Just leave the preset empty interp result. + */ + return TCL_OK; + } + tot = 0; + for(i = 1;i < objc;i++) { + bytes = TclGetStringFromObj(objv[i], &length); + if (bytes != NULL) { + tot += length; + } + } + if (tot < 0) { + /* TODO: convert panic to error ? */ + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + p = ckalloc(tot + 1); + TclNewObj(objResultPtr); + objResultPtr->bytes = p; + objResultPtr->length = tot; + for (i = 1;i < objc;i++) { + bytes = TclGetStringFromObj(objv[i], &length); + if (bytes != NULL) { + memcpy(p, bytes, (size_t) length); + p += length; + } + } + *p = '\0'; + Tcl_SetObjResult(interp,objResultPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * StringBytesCmd -- * * This procedure is invoked to process the "string bytelength" Tcl @@ -3330,6 +3400,7 @@ TclInitStringCmd( { static const EnsembleImplMap stringImplMap[] = { {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, {"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0}, |