Tcl Source Code

string.  \fIcharIndex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
.TP
\fBstring insert \fIstring index insertString\fR
.
Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
\fIindex\fR'th character.  \fIindex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIindex\fR is start-relative, the first character inserted in the returned
string will be at the specified index.  If \fIindex\fR is end-relative, the last
character inserted in the returned string will be at the specified index.
.PP
If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR.  If \fIindex\fR is at
or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
\fIinsertString\fR is appended to \fIstring\fR.
.RE
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringInsertCmd --
 *
 *	This procedure is invoked to process the "string insert" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringInsertCmd(
    ClientData dummy,		/* Not used */
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int length;			/* String length */
    int index;			/* Insert index */
    Tcl_Obj *outObj;		/* Output object */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index < 0) {
	index = 0;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
	    TCL_STRING_IN_PLACE);

    if (outObj != NULL) {
	Tcl_SetObjResult(interp, outObj);
	return TCL_OK;
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * StringIsCmd --
 *
 *	This procedure is invoked to process the "string is" Tcl command. See
 *	the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:

    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},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},

     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}

int
TclCompileStringInsertCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /* Compute and push the string in which to insert */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /* See what can be discovered about index at compile time */
    tokenPtr = TokenAfter(tokenPtr);
    if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
	    TCL_INDEX_END, &idx)) {

	/* Nothing useful knowable - cease compile; let it direct eval */
	return TCL_OK;
    }

    /* Compute and push the string to be inserted */
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    if (idx == TCL_INDEX_START) {
	/* Prepend the insertion string */
	OP4(	REVERSE, 2);
	OP1(	STR_CONCAT1, 2);
    } else  if (idx == TCL_INDEX_END) {
	/* Append the insertion string */
	OP1(	STR_CONCAT1, 2);
    } else {
	/* Prefix + insertion + suffix */
	if (idx < TCL_INDEX_END) {
	    /* See comments in compiler for [linsert]. */
	    idx++;
	}
	OP4(	OVER, 1);
	OP44(	STR_RANGE_IMM, 0, idx-1);
	OP4(	REVERSE, 3);
	OP44(	STR_RANGE_IMM, idx, TCL_INDEX_END);
	OP1(	STR_CONCAT1, 3);
    }

    return TCL_OK;
}

int
TclCompileStringIsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command

			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringInsertCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLastCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReplace --
 *
 *	Implements the inner engine of the [string replace] command.
 *	Implements the inner engine of the [string replace] and
 *	[string insert] commands.
 *
 *	The result is a concatenation of a prefix from objPtr, characters
 *	0 through first-1, the insertPtr string value, and a suffix from
 *	objPtr, characters from first + count to the end. The effect is as if
 *	the inner substring of characters first through first+count-1 are
 *	removed and replaced with insertPtr. If insertPtr is NULL, it is
 *	treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,

	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is like that
     * to be able to process index values.  This means it is likely that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

    interp alias {} run {} try
    set constraints {}
}


test string-1.1.$noComp {error conditions} {
    list [catch {run {string gorp a b}} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
    list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {

} \u1361ABC

test string-20.1.$noComp {string trimright errors} {
    list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} {
    list [catch {run {string trimg a}} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
    run {string trimright "    XYZ      "}
} {    XYZ}
test string-20.4.$noComp {string trimright} {
    run {string trimright "   "}
} {}
test string-20.5.$noComp {string trimright} {

} 3
test string-21.14.$noComp {string wordend, unicode} {
    run {string wordend "\uc700\uc700 abc" 8}
} 6

test string-22.1.$noComp {string wordstart} {
    list [catch {run {string word a}} msg] $msg
} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} {
    list [catch {run {string wordstart a}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} {
    list [catch {run {string wordstart a b c}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} {

test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} {
    run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]}
} hellohello
test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
    run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"}
} hellohello

# Note: string-31.* tests use [tcl::string::insert] rather than [string insert]
# to dodge ticket [3397978fff] which would cause all arguments to be shared,
# thereby preventing the optimizations from being tested.
test string-31.1.$noComp {string insert, start of string} {
    run {tcl::string::insert 0123 0 _}
} _0123
test string-31.2.$noComp {string insert, middle of string} {
    run {tcl::string::insert 0123 2 _}
} 01_23
test string-31.3.$noComp {string insert, end of string} {
    run {tcl::string::insert 0123 4 _}
} 0123_
test string-31.4.$noComp {string insert, start of string, end-relative} {
    run {tcl::string::insert 0123 end-4 _}
} _0123
test string-31.5.$noComp {string insert, middle of string, end-relative} {
    run {tcl::string::insert 0123 end-2 _}
} 01_23
test string-31.6.$noComp {string insert, end of string, end-relative} {
    run {tcl::string::insert 0123 end _}
} 0123_
test string-31.7.$noComp {string insert, empty target string} {
    run {tcl::string::insert {} 0 _}
} _
test string-31.8.$noComp {string insert, empty insert string} {
    run {tcl::string::insert 0123 0 {}}
} 0123
test string-31.9.$noComp {string insert, empty strings} {
    run {tcl::string::insert {} 0 {}}
} {}
test string-31.10.$noComp {string insert, negative index} {
    run {tcl::string::insert 0123 -1 _}
} _0123
test string-31.11.$noComp {string insert, index beyond end} {
    run {tcl::string::insert 0123 5 _}
} 0123_
test string-31.12.$noComp {string insert, start of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 0 [makeByteArray _]}
} _0123
test string-31.13.$noComp {string insert, middle of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]}
} 01_23
test string-31.14.$noComp {string insert, end of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 4 [makeByteArray _]}
} 0123_
test string-31.15.$noComp {string insert, pure byte array, neither shared} {
    run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]}
} 01_23
test string-31.16.$noComp {string insert, pure byte array, first shared} {
    run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\
            [makeByteArray _]}
} 01_23
test string-31.17.$noComp {string insert, pure byte array, second shared} {
    run {tcl::string::insert [makeByteArray 0123] 2\
            [makeShared [makeByteArray _]]}
} 01_23
test string-31.18.$noComp {string insert, pure byte array, both shared} {
    run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\
            [makeShared [makeByteArray _]]}
} 01_23
test string-31.19.$noComp {string insert, start of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 0 [makeUnicode _]}
} _0123
test string-31.20.$noComp {string insert, middle of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 2 [makeUnicode _]}
} 01_23
test string-31.21.$noComp {string insert, end of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 4 [makeUnicode _]}
} 0123_
test string-31.22.$noComp {string insert, str start, pure Uni, first shared} {
    run {tcl::string::insert [makeShared [makeUnicode 0123]] 0 [makeUnicode _]}
} _0123
test string-31.23.$noComp {string insert, string mid, pure Uni, 2nd shared} {
    run {tcl::string::insert [makeUnicode 0123] 2 [makeShared [makeUnicode _]]}
} 01_23
test string-31.24.$noComp {string insert, string end, pure Uni, both shared} {
    run {tcl::string::insert [makeShared [makeUnicode 0123]] 4\
            [makeShared [makeUnicode _]]}
} 0123_
test string-31.25.$noComp {string insert, neither byte array nor Unicode} {
    run {tcl::string::insert [makeList a b c] 1 zzzzzz}
} {azzzzzz b c}

test string-31.1.$noComp {string is dict} {
    string is dict {a b c d}
} 1
test string-31.1a.$noComp {string is dict} {
    string is dict {a b c}
} 0