Now do [string toupper], [string tolower] and [string totitle]. Only handles the no-indices case; that's the only case anyone actually commonly uses.

8 files changed, 221 insertions, 61 deletions

diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index b805c63..cd0a42d 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -453,6 +453,9 @@ static const TalInstDesc TalInstructionTable[] = {
 					 | INST_STORE_ARRAY4),	2,	1},
     {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
     {"storeStk",	ASSEM_1BYTE,	INST_STORE_STK,		2,	1},
+    {"strLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
+    {"strTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
+    {"strUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
     {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
     {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
     {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
@@ -464,9 +467,9 @@ static const TalInstDesc TalInstructionTable[] = {
     {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
     {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
     {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
-    {"strtrim",		ASSEM_1BYTE,	INST_STRTRIM,		2,	1},
-    {"strtrimLeft",	ASSEM_1BYTE,	INST_STRTRIM_LEFT,	2,	1},
-    {"strtrimRight",	ASSEM_1BYTE,	INST_STRTRIM_RIGHT,	2,	1},
+    {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
+    {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
+    {"strtrimRight",	ASSEM_1BYTE,	INST_STR_TRIM_RIGHT,	2,	1},
     {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
     {"tclooClass",	ASSEM_1BYTE,	INST_TCLOO_CLASS,	1,	1},
     {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
@@ -509,8 +512,9 @@ static const unsigned char NonThrowingByteCodes[] = {
     INST_NS_CURRENT,						/* 151 */
     INST_INFO_LEVEL_NUM,					/* 152 */
     INST_RESOLVE_COMMAND,					/* 154 */
-    INST_STRTRIM, INST_STRTRIM_LEFT, INST_STRTRIM_RIGHT,	/* 166-168 */
-    INST_CONCAT_STK						/* 169 */
+    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
+    INST_CONCAT_STK,						/* 169 */
+    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE		/* 170-172 */
 };
 
 /*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 2b5e995..da8ffe3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3341,9 +3341,9 @@ TclInitStringCmd(
 	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"replace",	StringRplcCmd,	NULL, NULL, NULL, 0},
 	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"tolower",	StringLowerCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"toupper",	StringUpperCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"totitle",	StringTitleCmd,	TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
+	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
+	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
+	{"totitle",	StringTitleCmd,	TclCompileStringToTitleCmd, NULL, NULL, 0},
 	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
 	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
 	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index a02f0a8..50fb8e9 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -33,7 +33,7 @@ static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLinsertCmd --
+ * GetIndexFromToken --
  *
  *	Parse a token and get the encoded version of the index (as understood
  *	by TEBC), assuming it is at all knowable at compile time. Only handles
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 646adf3..ca4b316 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -101,6 +101,59 @@ const AuxDataType tclJumptableInfoType = {
     if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
 #define INVOKE(name) \
     TclEmitInvoke(envPtr,INST_##name)
+
+#define INDEX_END	(-2)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromToken --
+ *
+ *	Parse a token and get the encoded version of the index (as understood
+ *	by TEBC), assuming it is at all knowable at compile time. Only handles
+ *	indices that are integers or 'end' or 'end-integer'.
+ *
+ * Returns:
+ *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
+ *
+ * Side effects:
+ *	Sets *index to the index value if successful.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+GetIndexFromToken(
+    Tcl_Token *tokenPtr,
+    int *index)
+{
+    Tcl_Obj *tmpObj = Tcl_NewObj();
+    int result, idx;
+
+    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
+	Tcl_DecrRefCount(tmpObj);
+	return TCL_ERROR;
+    }
+
+    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    if (result == TCL_OK) {
+	if (idx < 0) {
+	    result = TCL_ERROR;
+	}
+    } else {
+	result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
+	if (result == TCL_OK && idx > INDEX_END) {
+	    result = TCL_ERROR;
+	}
+    }
+    Tcl_DecrRefCount(tmpObj);
+
+    if (result == TCL_OK) {
+	*index = idx;
+    }
+
+    return result;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -565,8 +618,7 @@ TclCompileStringRangeCmd(
 {
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result;
+    int idx1, idx2;
 
     if (parsePtr->numWords != 4) {
 	return TCL_ERROR;
@@ -576,50 +628,13 @@ TclCompileStringRangeCmd(
     toTokenPtr = TokenAfter(fromTokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * Parse the two indices.
      */
 
-    tmpObj = Tcl_NewObj();
-    result = TCL_ERROR;
-    if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) {
-	if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) {
-	    if (idx1 >= 0) {
-		result = TCL_OK;
-	    }
-	} else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) {
-	    if (idx1 <= -2) {
-		result = TCL_OK;
-	    }
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+    if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
 	goto nonConstantIndices;
     }
-
-    /*
-     * Parse the second index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
-     */
-
-    tmpObj = Tcl_NewObj();
-    result = TCL_ERROR;
-    if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) {
-	if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) {
-	    if (idx2 >= 0) {
-		result = TCL_OK;
-	    }
-	} else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) {
-	    if (idx2 <= -2) {
-		result = TCL_OK;
-	    }
-	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
+    if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
 	goto nonConstantIndices;
     }
 
@@ -698,7 +713,7 @@ TclCompileStringTrimLCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM_LEFT);
+    OP(			STR_TRIM_LEFT);
     return TCL_OK;
 }
 
@@ -726,7 +741,7 @@ TclCompileStringTrimRCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM_RIGHT);
+    OP(			STR_TRIM_RIGHT);
     return TCL_OK;
 }
 
@@ -754,7 +769,73 @@ TclCompileStringTrimCmd(
     } else {
 	PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
     }
-    OP(			STRTRIM);
+    OP(			STR_TRIM);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToUpperCmd(
+    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. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_UPPER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToLowerCmd(
+    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. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_LOWER);
+    return TCL_OK;
+}
+
+int
+TclCompileStringToTitleCmd(
+    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. */
+{
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *tokenPtr;
+
+    if (parsePtr->numWords != 2) {
+	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+    }
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    CompileWord(envPtr, tokenPtr,			interp, 1);
+    OP(			STR_TITLE);
     return TCL_OK;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 280bf64..48165e6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -566,6 +566,19 @@ InstructionDesc const tclInstructionTable[] = {
 	 * is number of values to concatenate.
 	 * Operation:	push concat(stk1 stk2 ... stktop) */
 
+    {"strUpper",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string toupper] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strLower",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string tolower] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+    {"strTitle",	 1,	0,	  0,	{OPERAND_NONE}},
+	/* [string totitle] core: converts whole string to upper case using
+	 * the default (extended "C" locale) rules.
+	 * Stack: ... string => ... newString */
+
     {NULL, 0, 0, 0, {OPERAND_NONE}}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4ae754c..1d21d39 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -769,14 +769,18 @@ typedef struct ByteCode {
 #define INST_EXPAND_DROP		165
 
 /* For compilation of [string trim] and related */
-#define INST_STRTRIM			166
-#define INST_STRTRIM_LEFT		167
-#define INST_STRTRIM_RIGHT		168
+#define INST_STR_TRIM			166
+#define INST_STR_TRIM_LEFT		167
+#define INST_STR_TRIM_RIGHT		168
 
 #define INST_CONCAT_STK			169
 
+#define INST_STR_UPPER			170
+#define INST_STR_LOWER			171
+#define INST_STR_TITLE			172
+
 /* The last opcode */
-#define LAST_INST_OPCODE		169
+#define LAST_INST_OPCODE		172
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index cb6afaf..3889ce0 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5002,6 +5002,55 @@ TEBCresume(
 	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);
 
+    case INST_STR_UPPER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToUpper(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_LOWER:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToLower(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToLower(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+    case INST_STR_TITLE:
+	valuePtr = OBJ_AT_TOS;
+	TRACE(("\"%.25s\" => ", O2S(valuePtr)));
+	if (Tcl_IsShared(valuePtr)) {
+	    s1 = TclGetStringFromObj(valuePtr, &length);
+	    TclNewStringObj(objResultPtr, s1, length);
+	    length = Tcl_UtfToTitle(TclGetString(objResultPtr));
+	    Tcl_SetObjLength(objResultPtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(objResultPtr)));
+	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
+	    Tcl_SetObjLength(valuePtr, length);
+	    TRACE_APPEND(("\"%.25s\"\n", O2S(valuePtr)));
+	    NEXT_INST_F(1, 0, 0);
+	}
+
     case INST_STR_INDEX:
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
@@ -5271,7 +5320,7 @@ TEBCresume(
 	const char *string1, *string2;
 	int trim1, trim2;
 
-    case INST_STRTRIM:
+    case INST_STR_TRIM:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
@@ -5292,7 +5341,7 @@ TEBCresume(
 		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
-    case INST_STRTRIM_LEFT:
+    case INST_STR_TRIM_LEFT:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
@@ -5308,7 +5357,7 @@ TEBCresume(
 		    O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
 	    NEXT_INST_F(1, 2, 1);
 	}
-    case INST_STRTRIM_RIGHT:
+    case INST_STR_TRIM_RIGHT:
 	valuePtr = OBJ_UNDER_TOS;	/* String */
 	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
 	string2 = TclGetStringFromObj(value2Ptr, &length2);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cc8469b..6806302 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3620,6 +3620,15 @@ MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileStringRangeCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToLowerCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToTitleCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileStringToUpperCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileStringTrimCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);