Attachment "defer.patch" to
ticket [1033689fff]
added by
dgp
2004-09-24 04:49:09.
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.57
diff -u -r1.57 tclCompCmds.c
--- generic/tclCompCmds.c 22 Sep 2004 03:19:52 -0000 1.57
+++ generic/tclCompCmds.c 23 Sep 2004 21:41:33 -0000
@@ -23,12 +23,12 @@
static ClientData DupForeachInfo _ANSI_ARGS_((ClientData clientData));
static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
-static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
+static int PushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
/*
- * Flags bits used by TclPushVarName.
+ * Flags bits used by PushVarName.
*/
#define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */
@@ -52,13 +52,8 @@
* Procedure called to compile the "append" command.
*
* Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
- * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_AppendObjCmd) at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "append" command
@@ -76,7 +71,6 @@
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int simpleVarName, isScalar, localIndex, numWords;
- int code = TCL_OK;
numWords = parsePtr->numWords;
if (numWords == 1) {
@@ -104,11 +98,8 @@
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
- if (code != TCL_OK) {
- goto done;
- }
/*
* We are doing an assignment, otherwise TclCompileSetCmd was called,
@@ -122,11 +113,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, valueTokenPtr+1,
+ TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
}
}
@@ -160,8 +148,7 @@
TclEmitOpcode(INST_APPEND_STK, envPtr);
}
- done:
- return code;
+ return TCL_OK;
}
/*
@@ -172,9 +159,8 @@
* Procedure called to compile the "break" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error during compilation. If an error occurs then
- * the interpreter's result contains a standard error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "break" command
@@ -191,10 +177,7 @@
CompileEnv *envPtr; /* Holds resulting instructions. */
{
if (parsePtr->numWords != 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"break\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
/*
@@ -213,13 +196,8 @@
* Procedure called to compile the "catch" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If the command is too complex for TclCompileCatchCmd,
- * TCL_OUT_LINE_COMPILE is returned indicating that the catch command
- * should be compiled "out of line" by emitting code to invoke its
- * command procedure at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "catch" command
@@ -239,7 +217,6 @@
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
CONST char *name;
int localIndex, nameChars, range, startOffset;
- int code;
int savedStackDepth = envPtr->currStackDepth;
/*
@@ -307,19 +284,14 @@
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
startOffset = (envPtr->codeNext - envPtr->codeStart);
- code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
+ TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
} else {
- code = TclCompileTokens(interp, cmdTokenPtr+1,
+ TclCompileTokens(interp, cmdTokenPtr+1,
cmdTokenPtr->numComponents, envPtr);
startOffset = (envPtr->codeNext - envPtr->codeStart);
TclEmitOpcode(INST_EVAL_STK, envPtr);
}
envPtr->exceptArrayPtr[range].codeOffset = startOffset;
-
- if (code != TCL_OK) {
- code = TCL_OUT_LINE_COMPILE;
- goto done;
- }
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - startOffset;
@@ -372,10 +344,9 @@
}
TclEmitOpcode(INST_END_CATCH, envPtr);
- done:
envPtr->currStackDepth = savedStackDepth + 1;
envPtr->exceptDepth--;
- return code;
+ return TCL_OK;
}
/*
@@ -386,9 +357,8 @@
* Procedure called to compile the "continue" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "continue" command
@@ -409,10 +379,7 @@
*/
if (parsePtr->numWords != 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"continue\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
/*
@@ -431,9 +398,8 @@
* Procedure called to compile the "expr" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "expr" command
@@ -452,16 +418,13 @@
Tcl_Token *firstWordPtr;
if (parsePtr->numWords == 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"expr arg ?arg ...?\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
firstWordPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
- envPtr);
+ TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1), envPtr);
+ return TCL_OK;
}
/*
@@ -472,9 +435,8 @@
* Procedure called to compile the "for" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK unless
- * there was an error while parsing string. If an error occurs then
- * the interpreter's result contains a standard error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "for" command
@@ -492,15 +454,11 @@
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
- int bodyRange, nextRange, code;
- char buffer[32 + TCL_INTEGER_SPACE];
+ int bodyRange, nextRange;
int savedStackDepth = envPtr->currStackDepth;
if (parsePtr->numWords != 5) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"for start test next command\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
/*
@@ -544,15 +502,8 @@
* Inline compile the initial command.
*/
- code = TclCompileCmdWord(interp, startTokenPtr+1,
+ TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"for\" initial command)", -1);
- }
- goto done;
- }
TclEmitOpcode(INST_POP, envPtr);
/*
@@ -575,17 +526,9 @@
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"for\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
- }
envPtr->exceptArrayPtr[bodyRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
@@ -598,16 +541,9 @@
nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
envPtr->currStackDepth = savedStackDepth;
- code = TclCompileCmdWord(interp, nextTokenPtr+1,
+ TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"for\" loop-end command)", -1);
- }
- goto done;
- }
envPtr->exceptArrayPtr[nextRange].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- nextCodeOffset;
@@ -629,14 +565,7 @@
}
envPtr->currStackDepth = savedStackDepth;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"for\" test expression)", -1);
- }
- goto done;
- }
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
@@ -665,11 +594,9 @@
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
- code = TCL_OK;
- done:
envPtr->exceptDepth--;
- return code;
+ return TCL_OK;
}
/*
@@ -680,13 +607,8 @@
* Procedure called to compile the "foreach" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If the command is too complex for TclCompileForeachCmd,
- * TCL_OUT_LINE_COMPILE is returned indicating that the foreach command
- * should be compiled "out of line" by emitting code to invoke its
- * command procedure at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "foreach" command
@@ -715,7 +637,6 @@
JumpFixup jumpFalseFixup;
int jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
- char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
/*
@@ -741,10 +662,7 @@
numWords = parsePtr->numWords;
if ((numWords < 4) || (numWords%2 != 0)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
/*
@@ -809,6 +727,7 @@
&varcList[loopIndex], &varvList[loopIndex]);
Tcl_DStringFree(&varList);
if (code != TCL_OK) {
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
numVars = varcList[loopIndex];
@@ -833,6 +752,7 @@
* nonoverlapping foreach loops, they don't share any temps.
*/
+ code = TCL_OK;
firstValueTemp = -1;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
@@ -882,11 +802,8 @@
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
if ((i%2 == 0) && (i > 0)) {
- code = TclCompileTokens(interp, tokenPtr+1,
+ TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
@@ -921,17 +838,9 @@
envPtr->exceptArrayPtr[range].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
- code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"foreach\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
- }
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart)
- envPtr->exceptArrayPtr[range].codeOffset;
@@ -1104,13 +1013,8 @@
* Procedure called to compile the "if" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If the command is too complex for TclCompileIfCmd,
- * TCL_OUT_LINE_COMPILE is returned indicating that the if command
- * should be compiled "out of line" by emitting code to invoke its
- * command procedure at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "if" command
@@ -1137,7 +1041,6 @@
int jumpIndex = 0; /* avoid compiler warning. */
int numWords, wordIdx, numBytes, j, code;
CONST char *word;
- char buffer[100];
int savedStackDepth = envPtr->currStackDepth;
/* Saved stack depth at the start of the first
* test; the envPtr current depth is restored
@@ -1189,12 +1092,7 @@
break;
}
if (wordIdx >= numWords) {
- sprintf(buffer,
- "wrong # args: no expression after \"%.*s\" argument",
- (numBytes > 50 ? 50 : numBytes), word);
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
- code = TCL_ERROR;
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
@@ -1227,14 +1125,7 @@
}
} else {
Tcl_ResetResult(interp);
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"if\" test expression)", -1);
- }
- goto done;
- }
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
TclExpandJumpFixupArray(&jumpFalseFixupArray);
}
@@ -1243,6 +1134,7 @@
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
&(jumpFalseFixupArray.fixup[jumpIndex]));
}
+ code = TCL_OK;
}
@@ -1253,13 +1145,7 @@
tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
- sprintf(buffer,
- "wrong # args: no script following \"%.*s\" argument",
- (testTokenPtr->size > 50 ? 50 : testTokenPtr->size),
- testTokenPtr->start);
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), buffer, -1);
- code = TCL_ERROR;
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
@@ -1269,10 +1155,7 @@
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no script following \"then\" argument", -1);
- code = TCL_ERROR;
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
}
@@ -1284,16 +1167,8 @@
if (compileScripts) {
envPtr->currStackDepth = savedStackDepth;
- code = TclCompileCmdWord(interp, tokenPtr+1,
+ TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" then script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
- }
}
if (realCond) {
@@ -1371,10 +1246,7 @@
tokenPtr += (tokenPtr->numComponents + 1);
wordIdx++;
if (wordIdx >= numWords) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: no script following \"else\" argument", -1);
- code = TCL_ERROR;
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
}
@@ -1384,16 +1256,8 @@
* Compile the else command body.
*/
- code = TclCompileCmdWord(interp, tokenPtr+1,
+ TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"if\" else script line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto done;
- }
}
/*
@@ -1402,10 +1266,7 @@
wordIdx++;
if (wordIdx < numWords) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: extra words after \"else\" clause in \"if\" command", -1);
- code = TCL_ERROR;
+ code = TCL_OUT_LINE_COMPILE;
goto done;
}
} else {
@@ -1467,13 +1328,8 @@
* Procedure called to compile the "incr" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If the command is too complex for TclCompileIncrCmd,
- * TCL_OUT_LINE_COMPILE is returned indicating that the incr command
- * should be compiled "out of line" by emitting code to invoke its
- * command procedure at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "incr" command
@@ -1491,24 +1347,17 @@
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
- int code = TCL_OK;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"incr varName ?increment?\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr,
+ PushVarName(interp, varTokenPtr, envPtr,
(TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
&localIndex, &simpleVarName, &isScalar);
- if (code != TCL_OK) {
- goto done;
- }
/*
* If an increment is given, push it, but see first if it's a small
@@ -1548,11 +1397,8 @@
TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
- code = TclCompileTokens(interp, incrTokenPtr+1,
+ TclCompileTokens(interp, incrTokenPtr+1,
incrTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
}
} else { /* no incr amount given so use 1 */
haveImmValue = 1;
@@ -1603,8 +1449,7 @@
}
}
- done:
- return code;
+ return TCL_OK;
}
/*
@@ -1615,13 +1460,8 @@
* Procedure called to compile the "lappend" command.
*
* Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
- * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_LappendObjCmd) at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "lappend" command
@@ -1639,7 +1479,6 @@
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int simpleVarName, isScalar, localIndex, numWords;
- int code = TCL_OK;
/*
* If we're not in a procedure, don't compile.
@@ -1650,10 +1489,7 @@
numWords = parsePtr->numWords;
if (numWords == 1) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"lappend varName ?value value ...?\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
if (numWords != 3) {
/*
@@ -1673,11 +1509,8 @@
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
- if (code != TCL_OK) {
- goto done;
- }
/*
* If we are doing an assignment, push the new value.
@@ -1690,11 +1523,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, valueTokenPtr+1,
+ TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
}
}
@@ -1732,8 +1562,7 @@
TclEmitOpcode(INST_LAPPEND_STK, envPtr);
}
- done:
- return code;
+ return TCL_OK;
}
/*
@@ -1744,12 +1573,8 @@
* Procedure called to compile the "lassign" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if the
- * compilation was successful. If the command cannot be byte-compiled,
- * TCL_OUT_LINE_COMPILE is returned, indicating that the command should
- * be compiled "out of line" by emitting code to invoke its command
- * procedure (Tcl_LassignObjCmd) at runtime, which enforces in correct
- * error handling.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "lassign" command
@@ -1766,7 +1591,7 @@
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int simpleVarName, isScalar, localIndex, numWords, code, idx;
+ int simpleVarName, isScalar, localIndex, numWords, idx;
numWords = parsePtr->numWords;
/*
@@ -1784,11 +1609,7 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
+ TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, envPtr);
}
/*
@@ -1800,11 +1621,8 @@
/*
* Generate the next variable name
*/
- code = TclPushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
- if (code != TCL_OK) {
- return code;
- }
/*
* Emit instructions to get the idx'th item out of the list
@@ -1865,11 +1683,8 @@
* Procedure called to compile the "lindex" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if the
- * compilation was successful. If the command cannot be byte-compiled,
- * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
- * interpreter's result contains an error message, and TCL_ERROR is
- * returned.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "lindex" command
@@ -1886,9 +1701,7 @@
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int code, i;
-
- int numWords;
+ int i, numWords;
numWords = parsePtr->numWords;
/*
@@ -1912,11 +1725,8 @@
TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -1943,13 +1753,8 @@
* Procedure called to compile the "list" command.
*
* Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
- * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_ListObjCmd) at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "list" command
@@ -1983,7 +1788,7 @@
* Push the all values onto the stack.
*/
Tcl_Token *valueTokenPtr;
- int i, code, numWords;
+ int i, numWords;
numWords = parsePtr->numWords;
@@ -1994,11 +1799,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, valueTokenPtr+1,
+ TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
valueTokenPtr = valueTokenPtr + (valueTokenPtr->numComponents + 1);
}
@@ -2016,11 +1818,8 @@
* Procedure called to compile the "llength" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if the
- * compilation was successful. If the command cannot be byte-compiled,
- * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
- * interpreter's result contains an error message, and TCL_ERROR is
- * returned.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "llength" command
@@ -2037,12 +1836,9 @@
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
- int code;
if (parsePtr->numWords != 2) {
- Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
- TCL_STATIC);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
@@ -2055,11 +1851,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
TclEmitOpcode(INST_LIST_LENGTH, envPtr);
return TCL_OK;
@@ -2073,12 +1866,8 @@
* Procedure called to compile the "lset" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * the compilation was successful. If the "lset" command is too
- * complex for this function, then TCL_OUT_LINE_COMPILE is returned,
- * indicating that the command should be compiled "out of line"
- * (that is, not byte-compiled). If an error occurs, TCL_ERROR is
- * returned, and the interpreter result contains an error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "lset" command
@@ -2120,7 +1909,6 @@
* of the code burst. */
Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing
* the parse of the variable name */
- int result; /* Status return from library calls */
int localIndex; /* Index of var in local var table */
int simpleVarName; /* Flag == 1 if var name is simple */
int isScalar; /* Flag == 1 if scalar, 0 if array */
@@ -2143,11 +1931,8 @@
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- result = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
- if (result != TCL_OK) {
- return result;
- }
/* Push the "index" args and the new element value. */
@@ -2162,11 +1947,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
- result = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (result != TCL_OK) {
- return result;
- }
}
}
@@ -2265,12 +2047,8 @@
* Procedure called to compile the "regexp" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * the compilation was successful. If the "regexp" command is too
- * complex for this function, then TCL_OUT_LINE_COMPILE is returned,
- * indicating that the command should be compiled "out of line"
- * (that is, not byte-compiled). If an error occurs, TCL_ERROR is
- * returned, and the interpreter result contains an error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "regexp" command
@@ -2288,7 +2066,7 @@
{
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing
* the parse of the RE or string */
- int i, len, code, nocase, anchorLeft, anchorRight, start;
+ int i, len, nocase, anchorLeft, anchorRight, start;
char *str;
/*
@@ -2438,11 +2216,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
if (anchorLeft && anchorRight && !nocase) {
@@ -2462,10 +2237,8 @@
* Procedure called to compile the "return" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if the
- * compilation was successful. If analysis concludes that the
- * command cannot be bytecompiled effectively, a return code of
- * TCL__OUT_LINE_COMPILE is returned.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "return" command
@@ -2541,11 +2314,8 @@
wordTokenPtr[1].size), envPtr);
} else {
/* More complex tokens get compiled */
- status = TclCompileTokens(interp, wordTokenPtr+1,
+ TclCompileTokens(interp, wordTokenPtr+1,
wordTokenPtr->numComponents, envPtr);
- if (TCL_OK != status) {
- return status;
- }
}
} else {
/* No explict result argument, so default result is empty string */
@@ -2600,13 +2370,8 @@
* Procedure called to compile the "set" command.
*
* Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message. If
- * complation fails because the set command requires a second level of
- * substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
- * set command should be compiled "out of line" by emitting code to
- * invoke its command procedure (Tcl_SetCmd) at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "set" command
@@ -2624,14 +2389,10 @@
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
- int code = TCL_OK;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"set varName ?newValue?\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
isAssignment = (numWords == 3);
@@ -2646,11 +2407,8 @@
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
&localIndex, &simpleVarName, &isScalar);
- if (code != TCL_OK) {
- goto done;
- }
/*
* If we are doing an assignment, push the new value.
@@ -2662,11 +2420,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, valueTokenPtr+1,
+ TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
}
}
@@ -2710,8 +2465,7 @@
TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
}
- done:
- return code;
+ return TCL_OK;
}
/*
@@ -2722,11 +2476,8 @@
* Procedure called to compile the "string" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if the
- * compilation was successful. If the command cannot be byte-compiled,
- * TCL_OUT_LINE_COMPILE is returned. If an error occurs then the
- * interpreter's result contains an error message, and TCL_ERROR is
- * returned.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "string" command
@@ -2745,7 +2496,6 @@
Tcl_Token *opTokenPtr, *varTokenPtr;
Tcl_Obj *opObj;
int index;
- int code;
static CONST char *options[] = {
"bytelength", "compare", "equal", "first",
@@ -2825,11 +2575,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -2855,11 +2602,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -2885,11 +2629,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
return TCL_OK;
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
TclEmitOpcode(INST_STR_LEN, envPtr);
return TCL_OK;
@@ -2942,11 +2683,8 @@
TclEmitPush(
TclRegisterNewLiteral(envPtr, str, length), envPtr);
} else {
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
}
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
}
@@ -2971,15 +2709,8 @@
* Procedure called to compile the "switch" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If compilation failed because the command is too
- * complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
- * indicating that the while command should be compiled "out of line"
- * by emitting code to invoke its command procedure at runtime. Note
- * that most errors actually return TCL_OUT_LINE_COMPILE because that
- * allows the real error to be raised at run-time.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "switch" command
@@ -3181,13 +2912,8 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size), envPtr);
} else {
- int code = TclCompileTokens(interp, valueTokenPtr+1,
+ TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- ckfree((char *)argv);
- ckfree((char *)bodyTokenArray);
- return code;
- }
}
/*
@@ -3201,7 +2927,6 @@
fixupCount = 0;
foundDefault = 0;
for (i=0 ; i<argc ; i+=2) {
- int code; /* Return codes from sub-compiles. */
int nextArmFixupIndex = -1;
/*
@@ -3276,25 +3001,7 @@
TclEmitOpcode(INST_POP, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
- code = TclCompileScript(interp, bodyTokenArray[i+1].start,
- bodyTokenArray[i+1].size, envPtr);
- if (code != TCL_OK) {
- ckfree((char *)bodyTokenArray);
- ckfree((char *)fixupArray);
- ckfree((char *)fixupTargetArray);
-
- if (code == TCL_ERROR) {
- char *errInfBuf =
- ckalloc(strlen(argv[i])+40+TCL_INTEGER_SPACE);
-
- sprintf(errInfBuf, "\n (\"%s\" arm line %d)",
- argv[i], interp->errorLine);
- Tcl_AddObjErrorInfo(interp, errInfBuf, -1);
- ckfree(errInfBuf);
- }
- ckfree((char *)argv);
- return code;
- }
+ TclCompileCmdWord(interp, bodyTokenArray+i+1, 1, envPtr);
if (!foundDefault) {
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
@@ -3415,13 +3122,8 @@
* Procedure called to compile the "while" command.
*
* Results:
- * The return value is a standard Tcl result, which is TCL_OK if
- * compilation was successful. If an error occurs then the
- * interpreter's result contains a standard error message and TCL_ERROR
- * is returned. If compilation failed because the command is too
- * complex for TclCompileWhileCmd, TCL_OUT_LINE_COMPILE is returned
- * indicating that the while command should be compiled "out of line"
- * by emitting code to invoke its command procedure at runtime.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "while" command
@@ -3441,7 +3143,6 @@
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist;
int range, code;
- char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as
* an infinite loop. */
@@ -3449,10 +3150,7 @@
int boolVal;
if (parsePtr->numWords != 3) {
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "wrong # args: should be \"while test command\"", -1);
- return TCL_ERROR;
+ return TCL_OUT_LINE_COMPILE;
}
/*
@@ -3533,17 +3231,9 @@
*/
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
- code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+ TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- sprintf(buffer, "\n (\"while\" body line %d)",
- interp->errorLine);
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- }
- goto error;
- }
envPtr->exceptArrayPtr[range].numCodeBytes =
(envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
TclEmitOpcode(INST_POP, envPtr);
@@ -3561,14 +3251,7 @@
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
- code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- if (code == TCL_ERROR) {
- Tcl_AddObjErrorInfo(interp,
- "\n (\"while\" test expression)", -1);
- }
- goto error;
- }
+ TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
@@ -3605,24 +3288,19 @@
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->exceptDepth--;
return TCL_OK;
-
- error:
- envPtr->exceptDepth--;
- return code;
}
/*
*----------------------------------------------------------------------
*
- * TclPushVarName --
+ * PushVarName --
*
* Procedure used in the compiling where pushing a variable name
* is necessary (append, lappend, set).
*
* Results:
- * The return value is a standard Tcl result, which is normally TCL_OK
- * unless there was an error while parsing string. If an error occurs
- * then the interpreter's result contains a standard error message.
+ * Returns TCL_OK for a successful compile.
+ * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime.
*
* Side effects:
* Instructions are added to envPtr to execute the "set" command
@@ -3632,7 +3310,7 @@
*/
static int
-TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
+PushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
simpleVarNamePtr, isScalarPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Token *varTokenPtr; /* Points to a variable token. */
@@ -3647,7 +3325,6 @@
CONST char *name, *elName;
register int i, n;
int nameChars, elNameChars, simpleVarName, localIndex;
- int code = TCL_OK;
Tcl_Token *elemTokenPtr = NULL;
int elemTokenCount = 0;
@@ -3823,11 +3500,7 @@
if (elName != NULL) {
if (elNameChars) {
- code = TclCompileTokens(interp, elemTokenPtr,
- elemTokenCount, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
+ TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
} else {
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
@@ -3837,14 +3510,10 @@
* The var name isn't simple: compile and push it.
*/
- code = TclCompileTokens(interp, varTokenPtr+1,
+ TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
}
- done:
if (removedParen) {
++varTokenPtr[removedParen].size;
}
@@ -3854,5 +3523,5 @@
*localIndexPtr = localIndex;
*simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
- return code;
+ return TCL_OK;
}
Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.22
diff -u -r1.22 tclCompExpr.c
--- generic/tclCompExpr.c 6 Apr 2004 22:25:50 -0000 1.22
+++ generic/tclCompExpr.c 23 Sep 2004 21:41:33 -0000
@@ -365,11 +365,8 @@
tokenPtr->start, tokenPtr->size);
switch (tokenPtr->type) {
case TCL_TOKEN_WORD:
- code = TclCompileTokens(interp, tokenPtr+1,
+ TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
tokenPtr += (tokenPtr->numComponents + 1);
break;
@@ -397,19 +394,13 @@
break;
case TCL_TOKEN_COMMAND:
- code = TclCompileScript(interp, tokenPtr->start+1,
+ TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
tokenPtr += 1;
break;
case TCL_TOKEN_VARIABLE:
- code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
- if (code != TCL_OK) {
- goto done;
- }
+ TclCompileTokens(interp, tokenPtr, 1, envPtr);
tokenPtr += (tokenPtr->numComponents + 1);
break;
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.74
diff -u -r1.74 tclCompile.c
--- generic/tclCompile.c 23 Sep 2004 00:34:31 -0000 1.74
+++ generic/tclCompile.c 23 Sep 2004 21:41:34 -0000
@@ -317,9 +317,6 @@
Tcl_Obj *objPtr));
static int GetCmdLocEncodingSize _ANSI_ARGS_((
CompileEnv *envPtr));
-static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *script, CONST char *command,
- int length));
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats _ANSI_ARGS_((
ByteCode *codePtr));
@@ -383,7 +380,7 @@
register AuxData *auxDataPtr;
LiteralEntry *entryPtr;
register int i;
- int length, result;
+ int length, result = TCL_OK;
char *string;
#ifdef TCL_COMPILE_DEBUG
@@ -398,43 +395,41 @@
string = Tcl_GetStringFromObj(objPtr, &length);
TclInitCompileEnv(interp, &compEnv, string, length);
- result = TclCompileScript(interp, string, length, &compEnv);
+ TclCompileScript(interp, string, length, &compEnv);
- if (result == TCL_OK) {
- /*
- * Successful compilation. Add a "done" instruction at the end.
- */
+ /*
+ * Successful compilation. Add a "done" instruction at the end.
+ */
- TclEmitOpcode(INST_DONE, &compEnv);
+ TclEmitOpcode(INST_DONE, &compEnv);
- /*
- * Invoke the compilation hook procedure if one exists.
- */
+ /*
+ * Invoke the compilation hook procedure if one exists.
+ */
- if (hookProc) {
- result = (*hookProc)(interp, &compEnv, clientData);
- }
+ if (hookProc) {
+ result = (*hookProc)(interp, &compEnv, clientData);
+ }
- /*
- * Change the object into a ByteCode object. Ownership of the literal
- * objects and aux data items is given to the ByteCode object.
- */
+ /*
+ * Change the object into a ByteCode object. Ownership of the literal
+ * objects and aux data items is given to the ByteCode object.
+ */
#ifdef TCL_COMPILE_DEBUG
- TclVerifyLocalLiteralTable(&compEnv);
+ TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/
- TclInitByteCodeObj(objPtr, &compEnv);
+ TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ if (tclTraceCompile >= 2) {
+ TclPrintByteCodeObj(interp, objPtr);
}
+#endif /* TCL_COMPILE_DEBUG */
if (result != TCL_OK) {
/*
- * Compilation errors.
+ * Handle any error from the hookProc
*/
entryPtr = compEnv.literalArrayPtr;
@@ -896,7 +891,7 @@
*----------------------------------------------------------------------
*/
-int
+void
TclCompileScript(interp, script, numBytes, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting.
* Also serves as context for finding and
@@ -987,7 +982,7 @@
TclCompileReturnCmd(interp, &subParse, envPtr);
Tcl_DecrRefCount(returnCmd);
Tcl_FreeParse(&subParse);
- return TCL_OK;
+ return;
}
gotParse = 1;
if (parse.numWords > 0) {
@@ -1002,7 +997,8 @@
if (!isFirstCmd) {
TclEmitOpcode(INST_POP, envPtr);
envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
- (envPtr->codeNext - envPtr->codeStart) - startCodeOffset;
+ (envPtr->codeNext - envPtr->codeStart)
+ - startCodeOffset;
}
/*
@@ -1118,30 +1114,27 @@
/*
* Fix the bytecode length.
*/
- unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1;
- unsigned int fixLen = envPtr->codeNext - envPtr->codeStart
- - savedCodeNext;
+ unsigned char *fixPtr = envPtr->codeStart
+ + savedCodeNext + 1;
+ unsigned int fixLen = envPtr->codeNext
+ - envPtr->codeStart
+ - savedCodeNext;
TclStoreInt4AtPtr(fixLen, fixPtr);
}
goto finishCommand;
} else if (code == TCL_OUT_LINE_COMPILE) {
/*
- * Restore numCommands and codeNext to their correct
- * values, removing any commands compiled before
- * TCL_OUT_LINE_COMPILE [Bugs 705406 and 735055]
+ * Restore numCommands and codeNext to their
+ * correct values, removing any commands
+ * compiled before TCL_OUT_LINE_COMPILE
+ * [Bugs 705406 and 735055]
*/
envPtr->numCommands = savedNumCmds;
- envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+ envPtr->codeNext = envPtr->codeStart
+ + savedCodeNext;
} else { /* an error */
- /*
- * There was a compilation error, the last
- * command did not get compiled into (*envPtr).
- * Decrement the number of commands
- * claimed to be in (*envPtr).
- */
- envPtr->numCommands--;
- goto log;
+ Tcl_Panic("TclCompileScript: compileProc returned TCL_ERROR\n");
}
}
@@ -1177,11 +1170,8 @@
* The word is not a simple string of characters.
*/
- code = TclCompileTokens(interp, tokenPtr+1,
+ TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- goto log;
- }
}
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
TclEmitInstInt4(INST_EXPAND_STKTOP,
@@ -1260,16 +1250,6 @@
envPtr->numSrcBytes = (p - script);
Tcl_DStringFree(&ds);
- return TCL_OK;
-
- log:
- LogCompilationInfo(interp, script, parse.commandStart, commandLength);
- if (gotParse) {
- Tcl_FreeParse(&parse);
- }
- envPtr->numSrcBytes = (p - script);
- Tcl_DStringFree(&ds);
- return code;
}
/*
@@ -1293,7 +1273,7 @@
*----------------------------------------------------------------------
*/
-int
+void
TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting. */
Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
@@ -1307,7 +1287,7 @@
char buffer[TCL_UTF_MAX];
CONST char *name, *p;
int numObjsToConcat, nameBytes, localVarName, localVar;
- int length, i, code;
+ int length, i;
unsigned char *entryCodeNext = envPtr->codeNext;
Tcl_DStringInit(&textBuffer);
@@ -1341,11 +1321,8 @@
Tcl_DStringFree(&textBuffer);
}
- code = TclCompileScript(interp, tokenPtr->start+1,
+ TclCompileScript(interp, tokenPtr->start+1,
tokenPtr->size-2, envPtr);
- if (code != TCL_OK) {
- goto error;
- }
numObjsToConcat++;
break;
@@ -1422,16 +1399,8 @@
envPtr);
}
} else {
- code = TclCompileTokens(interp, tokenPtr+2,
+ TclCompileTokens(interp, tokenPtr+2,
tokenPtr->numComponents-1, envPtr);
- if (code != TCL_OK) {
- char errorBuffer[150];
- sprintf(errorBuffer,
- "\n (parsing index for array \"%.*s\")",
- ((nameBytes > 100)? 100 : nameBytes), name);
- Tcl_AddObjErrorInfo(interp, errorBuffer, -1);
- goto error;
- }
if (localVar < 0) {
TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
} else if (localVar <= 255) {
@@ -1486,11 +1455,6 @@
envPtr);
}
Tcl_DStringFree(&textBuffer);
- return TCL_OK;
-
- error:
- Tcl_DStringFree(&textBuffer);
- return code;
}
/*
@@ -1514,7 +1478,7 @@
*----------------------------------------------------------------------
*/
-int
+void
TclCompileCmdWord(interp, tokenPtr, count, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting. */
Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
@@ -1523,30 +1487,23 @@
* Must be at least 1. */
CompileEnv *envPtr; /* Holds the resulting instructions. */
{
- int code;
-
- /*
- * Handle the common case: if there is a single text token, compile it
- * into an inline sequence of instructions.
- */
-
if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
- code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
- return code;
- }
-
- /*
- * Multiple tokens or the single token involves substitutions. Emit
- * instructions to invoke the eval command procedure at runtime on the
- * result of evaluating the tokens.
- */
+ /*
+ * Handle the common case: if there is a single text token,
+ * compile it into an inline sequence of instructions.
+ */
+
+ TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
+ } else {
+ /*
+ * Multiple tokens or the single token involves substitutions.
+ * Emit instructions to invoke the eval command procedure at
+ * runtime on the result of evaluating the tokens.
+ */
- code = TclCompileTokens(interp, tokenPtr, count, envPtr);
- if (code != TCL_OK) {
- return code;
+ TclCompileTokens(interp, tokenPtr, count, envPtr);
+ TclEmitOpcode(INST_EVAL_STK, envPtr);
}
- TclEmitOpcode(INST_EVAL_STK, envPtr);
- return TCL_OK;
}
/*
@@ -1570,7 +1527,7 @@
*----------------------------------------------------------------------
*/
-int
+void
TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting. */
Tcl_Token *tokenPtr; /* Points to first in an array of word
@@ -1582,10 +1539,7 @@
CompileEnv *envPtr; /* Holds the resulting instructions. */
{
Tcl_Token *wordPtr;
- int numBytes, i, code;
- CONST char *script;
-
- code = TCL_OK;
+ int i, concatItems;
/*
* If the expression is a single word that doesn't require
@@ -1593,10 +1547,16 @@
*/
if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
- script = tokenPtr[1].start;
- numBytes = tokenPtr[1].size;
- code = TclCompileExpr(interp, script, numBytes, envPtr);
- return code;
+ CONST char *script = tokenPtr[1].start;
+ int numBytes = tokenPtr[1].size;
+ int savedNumCmds = envPtr->numCommands;
+ unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+
+ if (TclCompileExpr(interp, script, numBytes, envPtr) == TCL_OK) {
+ return;
+ }
+ envPtr->numCommands = savedNumCmds;
+ envPtr->codeNext = envPtr->codeStart + savedCodeNext;
}
/*
@@ -1606,30 +1566,22 @@
wordPtr = tokenPtr;
for (i = 0; i < numWords; i++) {
- code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
- envPtr);
- if (code != TCL_OK) {
- break;
- }
+ TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
if (i < (numWords - 1)) {
TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
envPtr);
}
wordPtr += (wordPtr->numComponents + 1);
}
- if (code == TCL_OK) {
- int concatItems = 2*numWords - 1;
- while (concatItems > 255) {
- TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
- concatItems -= 254;
- }
- if (concatItems > 1) {
- TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
- }
- TclEmitOpcode(INST_EXPR_STK, envPtr);
+ concatItems = 2*numWords - 1;
+ while (concatItems > 255) {
+ TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
+ concatItems -= 254;
}
-
- return code;
+ if (concatItems > 1) {
+ TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+ }
+ TclEmitOpcode(INST_EXPR_STK, envPtr);
}
/*
@@ -1791,62 +1743,6 @@
/*
*----------------------------------------------------------------------
*
- * LogCompilationInfo --
- *
- * This procedure is invoked after an error occurs during compilation.
- * It adds information to the "errorInfo" variable to describe the
- * command that was being compiled when the error occurred.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Information about the command is added to errorInfo and the
- * line number stored internally in the interpreter is set. If this
- * is the first call to this procedure or Tcl_AddObjErrorInfo since
- * an error occurred, then old information in errorInfo is
- * deleted.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-LogCompilationInfo(interp, script, command, length)
- Tcl_Interp *interp; /* Interpreter in which to log the
- * information. */
- CONST char *script; /* First character in script containing
- * command (must be <= command). */
- CONST char *command; /* First character in command that
- * generated the error. */
- int length; /* Number of bytes in command (-1 means
- * use all bytes up to first null byte). */
-{
- register CONST char *p;
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj *message;
-
- /*
- * Compute the line number where the error occurred.
- */
-
- iPtr->errorLine = 1;
- for (p = script; p != command; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
-
- message = Tcl_NewStringObj("\n while compiling\n\"", -1);
- Tcl_IncrRefCount(message);
- TclAppendLimitedToObj(message, command, length, 153, NULL);
- Tcl_AppendToObj(message, "\"", -1);
- TclAppendObjToErrorInfo(interp, message);
- Tcl_DecrRefCount(message);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TclFindCompiledLocal --
*
* This procedure is called at compile time to look up and optionally
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.47
diff -u -r1.47 tclCompile.h
--- generic/tclCompile.h 3 Jul 2004 02:03:36 -0000 1.47
+++ generic/tclCompile.h 23 Sep 2004 21:41:34 -0000
@@ -766,19 +766,19 @@
*/
EXTERN void TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
-EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr));
EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *script, int numBytes,
CompileEnv *envPtr));
-EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr));
-EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *script, int numBytes,
CompileEnv *envPtr));
-EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr));
EXTERN int TclCreateAuxData _ANSI_ARGS_((ClientData clientData,
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.173
diff -u -r1.173 tclInt.h
--- generic/tclInt.h 17 Sep 2004 22:06:24 -0000 1.173
+++ generic/tclInt.h 23 Sep 2004 21:41:34 -0000
@@ -844,18 +844,19 @@
/*
* The type of procedures called by the Tcl bytecode compiler to compile
* commands. Pointers to these procedures are kept in the Command structure
- * describing each command. When a CompileProc returns, the interpreter's
- * result is set to error information, if any. In addition, the CompileProc
- * returns an integer value, which is one of the following:
+ * describing each command. The integer value returned by a CompileProc
+ * must be one of the following:
*
* TCL_OK Compilation completed normally.
- * TCL_ERROR Compilation failed because of an error;
- * the interpreter's result describes what went wrong.
- * TCL_OUT_LINE_COMPILE Compilation failed because, e.g., the command is
- * too complex for effective inline compilation. The
- * CompileProc believes the command is legal but
- * should be compiled "out of line" by emitting code
- * to invoke its command procedure at runtime.
+ * TCL_OUT_LINE_COMPILE Compilation could not be completed. This can
+ * be just a judgment by the CompileProc that the
+ * command is too complex to compile effectively,
+ * or it can indicate that in the current state of
+ * the interp, the command would raise an error.
+ * In the latter circumstance, we defer error reporting
+ * until the actual runtime, because by then changes
+ * in the interp state may allow the command to be
+ * successfully evaluated.
*/
#define TCL_OUT_LINE_COMPILE (TCL_CONTINUE + 1)
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.55
diff -u -r1.55 tclProc.c
--- generic/tclProc.c 17 Sep 2004 22:59:15 -0000 1.55
+++ generic/tclProc.c 23 Sep 2004 21:41:35 -0000
@@ -1581,7 +1581,7 @@
CompileEnv *envPtr; /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
- int i, code;
+ int i;
int savedStackDepth = envPtr->currStackDepth;
tokenPtr = parsePtr->tokenPtr;
@@ -1590,11 +1590,8 @@
envPtr->currStackDepth = savedStackDepth;
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
- code = TclCompileTokens(interp, tokenPtr+1,
+ TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
- if (code != TCL_OK) {
- return code;
- }
TclEmitOpcode(INST_POP, envPtr);
}
}
Index: tests/compExpr-old.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compExpr-old.test,v
retrieving revision 1.9
diff -u -r1.9 compExpr-old.test
--- tests/compExpr-old.test 19 May 2004 20:15:31 -0000 1.9
+++ tests/compExpr-old.test 23 Sep 2004 21:41:36 -0000
@@ -15,7 +15,7 @@
# RCS: @(#) $Id: compExpr-old.test,v 1.9 2004/05/19 20:15:31 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -479,11 +479,11 @@
catch {expr $i.2} msg
set msg
} 123.2
-test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
+test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
catch {expr {$a(foo}} msg
set errorInfo
-} {missing )
- while compiling
+} -match glob -result {missing )
+ while *ing
"expr {$a(foo}"}
test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
expr $
@@ -508,95 +508,91 @@
test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} {
expr {[set i 123; set i]}
} 123
-test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} {
+test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"expr {[set]}"}
-test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} {
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
+test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set i}} msg
set errorInfo
-} {missing close-bracket
- while compiling
-"expr {[set i}"}
+} -match glob -result {missing close-bracket
+ while *ing
+"expr {\[set i}"}
test compExpr-old-14.25 {CompilePrimaryExpr: math function primary} {
format %.6g [expr exp(1.0)]
} 2.71828
test compExpr-old-14.26 {CompilePrimaryExpr: math function primary} {
format %.6g [expr pow(2.0+0.1,3.0+0.1)]
} 9.97424
-test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} {
+test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} -body {
catch {expr sinh::(2.0)} msg
set errorInfo
-} {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
- while compiling
+} -match glob -result {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
+ while *ing
"expr sinh::(2.0)"}
test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
} 14
-test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} {
+test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"expr 2+(3*[set])"}
-test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
+test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
catch {expr 2+(3*(4+5)} msg
set errorInfo
-} {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
- while compiling
+} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
+ while *ing
"expr 2+(3*(4+5)"}
test compExpr-old-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
} {{15 == 15} {15 == 15} {15 == 15}}
-test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} {
+test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} -body {
catch {expr @} msg
set errorInfo
-} {syntax error in expression "@": character not legal in expressions
- while compiling
+} -match glob -result {syntax error in expression "@": character not legal in expressions
+ while *ing
"expr @"}
-test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} {
+test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} -body {
catch {expr sinh2.0)} msg
set errorInfo
-} {syntax error in expression "sinh2.0)": variable references require preceding $
- while compiling
+} -match glob -result {syntax error in expression "sinh2.0)": variable references require preceding $
+ while *ing
"expr sinh2.0)"}
-test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} {
+test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
set errorInfo
-} {unknown math function "whazzathuh"
- while compiling
+} -match glob -result {unknown math function "whazzathuh"
+ while *ing
"expr whazzathuh(1)"}
-test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} {
+test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
set errorInfo
-} {too many arguments for math function
- while compiling
+} -match glob -result {too many arguments for math function
+ while *ing
"expr sin(1,2,3)"}
-test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} {
+test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
set errorInfo
-} {too few arguments for math function
- while compiling
+} -match glob -result {too few arguments for math function
+ while *ing
"expr sin()"}
-test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} {
+test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
set errorInfo
-} {too few arguments for math function
- while compiling
+} -match glob -result {too few arguments for math function
+ while *ing
"expr pow(1)"}
-test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} {
+test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
catch {expr sin(1} msg
set errorInfo
-} {syntax error in expression "sin(1": missing close parenthesis at end of function call
- while compiling
+} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
+ while *ing
"expr sin(1"}
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
expr 2*T1()
Index: tests/compExpr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/compExpr.test,v
retrieving revision 1.7
diff -u -r1.7 compExpr.test
--- tests/compExpr.test 19 May 2004 20:15:31 -0000 1.7
+++ tests/compExpr.test 23 Sep 2004 21:41:36 -0000
@@ -87,7 +87,7 @@
catch {unset a}
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+} {0 1}
test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
expr {5*6}
} 30
@@ -180,7 +180,7 @@
catch {unset a}
set a 15
list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+} {0 1}
test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
catch {unset a}
set a false
@@ -195,7 +195,7 @@
catch {unset a}
set a 15
list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+} {0 54}
test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
catch {unset a}
@@ -284,7 +284,7 @@
} 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
list [catch {expr {1? 15 : [expr *2]}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
+} {0 15}
test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
format %.6g [expr atan2(1.0, 2.0)]
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.25
diff -u -r1.25 expr.test
--- tests/expr.test 19 Sep 2004 15:03:48 -0000 1.25
+++ tests/expr.test 23 Sep 2004 21:41:36 -0000
@@ -507,11 +507,11 @@
catch {expr $i.2} msg
set msg
} 123.2
-test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} {
+test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
catch {expr {$a(foo}} msg
set errorInfo
-} {missing )
- while compiling
+} -match glob -result {missing )
+ while *ing
"expr {$a(foo}"}
test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
expr $
@@ -536,95 +536,91 @@
test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
expr {[set i 123; set i]}
} 123
-test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} {
+test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set]}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"expr {[set]}"}
-test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} {
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
+test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
catch {expr {[set i}} msg
set errorInfo
-} {missing close-bracket
- while compiling
-"expr {[set i}"}
+} -match glob -result {missing close-bracket
+ while *ing
+"expr {\[set i}"}
test expr-14.25 {CompilePrimaryExpr: math function primary} {
format %.6g [expr exp(1.0)]
} 2.71828
test expr-14.26 {CompilePrimaryExpr: math function primary} {
format %.6g [expr pow(2.0+0.1,3.0+0.1)]
} 9.97424
-test expr-14.27 {CompilePrimaryExpr: error in math function primary} {
+test expr-14.27 {CompilePrimaryExpr: error in math function primary} -body {
catch {expr sinh::(2.0)} msg
set errorInfo
-} {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
- while compiling
+} -match glob -result {syntax error in expression "sinh::(2.0)": expected parenthesis enclosing function arguments
+ while *ing
"expr sinh::(2.0)"}
test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
expr 2+(3*4)
} 14
-test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} {
+test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
catch {expr 2+(3*[set])} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"expr 2+(3*[set])"}
-test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} {
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
+test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
catch {expr 2+(3*(4+5)} msg
set errorInfo
-} {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
- while compiling
+} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
+ while *ing
"expr 2+(3*(4+5)"}
test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
set i "5+10"
list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
} {{15 == 15} {15 == 15} {15 == 15}}
-test expr-14.32 {CompilePrimaryExpr: unexpected token} {
+test expr-14.32 {CompilePrimaryExpr: unexpected token} -body {
catch {expr @} msg
set errorInfo
-} {syntax error in expression "@": character not legal in expressions
- while compiling
+} -match glob -result {syntax error in expression "@": character not legal in expressions
+ while *ing
"expr @"}
-test expr-15.1 {CompileMathFuncCall: missing parenthesis} {
+test expr-15.1 {CompileMathFuncCall: missing parenthesis} -body {
catch {expr sinh2.0)} msg
set errorInfo
-} {syntax error in expression "sinh2.0)": variable references require preceding $
- while compiling
+} -match glob -result {syntax error in expression "sinh2.0)": variable references require preceding $
+ while *ing
"expr sinh2.0)"}
-test expr-15.2 {CompileMathFuncCall: unknown math function} {
+test expr-15.2 {CompileMathFuncCall: unknown math function} -body {
catch {expr whazzathuh(1)} msg
set errorInfo
-} {unknown math function "whazzathuh"
- while compiling
+} -match glob -result {unknown math function "whazzathuh"
+ while *ing
"expr whazzathuh(1)"}
-test expr-15.3 {CompileMathFuncCall: too many arguments} {
+test expr-15.3 {CompileMathFuncCall: too many arguments} -body {
catch {expr sin(1,2,3)} msg
set errorInfo
-} {too many arguments for math function
- while compiling
+} -match glob -result {too many arguments for math function
+ while *ing
"expr sin(1,2,3)"}
-test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} {
+test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
catch {expr sin()} msg
set errorInfo
-} {too few arguments for math function
- while compiling
+} -match glob -result {too few arguments for math function
+ while *ing
"expr sin()"}
-test expr-15.5 {CompileMathFuncCall: too few arguments} {
+test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
catch {expr pow(1)} msg
set errorInfo
-} {too few arguments for math function
- while compiling
+} -match glob -result {too few arguments for math function
+ while *ing
"expr pow(1)"}
-test expr-15.6 {CompileMathFuncCall: missing ')'} {
+test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
catch {expr sin(1} msg
set errorInfo
-} {syntax error in expression "sin(1": missing close parenthesis at end of function call
- while compiling
+} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
+ while *ing
"expr sin(1"}
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
expr 2*T1()
Index: tests/for.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/for.test,v
retrieving revision 1.9
diff -u -r1.9 for.test
--- tests/for.test 6 Dec 2001 10:59:18 -0000 1.9
+++ tests/for.test 23 Sep 2004 21:41:36 -0000
@@ -12,7 +12,7 @@
# RCS: @(#) $Id: for.test,v 1.9 2001/12/06 10:59:18 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -21,21 +21,21 @@
test for-1.1 {TclCompileForCmd: missing initial command} {
list [catch {for} msg] $msg
} {1 {wrong # args: should be "for start test next command"}}
-test for-1.2 {TclCompileForCmd: error in initial command} {
+test for-1.2 {TclCompileForCmd: error in initial command} -body {
list [catch {for {set}} msg] $msg $errorInfo
-} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
- while compiling
+} -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
+ while *ing
"for {set}"}}
catch {unset i}
test for-1.3 {TclCompileForCmd: missing test expression} {
catch {for {set i 0}} msg
set msg
} {wrong # args: should be "for start test next command"}
-test for-1.4 {TclCompileForCmd: error in test expression} {
+test for-1.4 {TclCompileForCmd: error in test expression} -body {
catch {for {set i 0} {$i<}} msg
set errorInfo
-} {wrong # args: should be "for start test next command"
- while compiling
+} -match glob -result {wrong # args: should be "for start test next command"
+ while *ing
"for {set i 0} {$i<}"}
test for-1.5 {TclCompileForCmd: test expression is enclosed in quotes} {
set i 0
@@ -49,15 +49,12 @@
catch {for {set i 0} {$i < 5} {incr i}} msg
set msg
} {wrong # args: should be "for start test next command"}
-test for-1.8 {TclCompileForCmd: error compiling command body} {
+test for-1.8 {TclCompileForCmd: error compiling command body} -body {
catch {for {set i 0} {$i < 5} {incr i} {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- ("for" body line 1)
- while compiling
-"for {set i 0} {$i < 5} {incr i} {set}"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
catch {unset a}
test for-1.9 {TclCompileForCmd: simple command body} {
set a {}
@@ -83,15 +80,12 @@
for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
set a
} {x1}
-test for-1.12 {TclCompileForCmd: error in "next" command} {
- catch {for {set i 0} {$i < 5} {set} {puts $i}} msg
+test for-1.12 {TclCompileForCmd: error in "next" command} -body {
+ catch {for {set i 0} {$i < 5} {set} {format $i}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- ("for" loop-end command)
- while compiling
-"for {set i 0} {$i < 5} {set} {puts $i}"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
test for-1.13 {TclCompileForCmd: long command body} {
set a {}
for {set i 1} {$i<6} {set i [expr $i+1]} {
@@ -656,11 +650,11 @@
catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
set msg
} {wrong # args: should be "for start test next command"}
-test for-6.6 {Tcl_ForObjCmd: error in initial command} {
+test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
set z for
list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
-} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
("for" initial command)
invoked from within
@@ -677,12 +671,12 @@
$z {set i 6} "$i > 5" {incr i} {set y $i}
set i
} 6
-test for-6.9 {Tcl_ForObjCmd: error executing command body} {
+test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
set z for
catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
("for" body line 1)
invoked from within
@@ -714,12 +708,12 @@
$z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
set a
} {x1}
-test for-6.13 {Tcl_ForObjCmd: error in "next" command} {
+test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
set z for
catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
("for" loop-end command)
invoked from within
Index: tests/if.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/if.test,v
retrieving revision 1.7
diff -u -r1.7 if.test
--- tests/if.test 4 Dec 2001 15:36:29 -0000 1.7
+++ tests/if.test 23 Sep 2004 21:41:36 -0000
@@ -13,7 +13,7 @@
# RCS: @(#) $Id: if.test,v 1.7 2001/12/04 15:36:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -26,11 +26,10 @@
test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
list [catch {if {[error "error in condition"]} foo} msg] $msg
} {1 {error in condition}}
-test if-1.3 {TclCompileIfCmd: error in if/elseif test} {
+test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body {
list [catch {if {1+}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
- ("if" test expression)
- while compiling
+} -match glob -result {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression*
+ while *ing
"if {1+}"}}
test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
set a {}
@@ -63,15 +62,12 @@
catch {if 1<2 then} msg
set msg
} {wrong # args: no script following "then" argument}
-test if-1.10 {TclCompileIfCmd: error in "then" body} {
+test if-1.10 {TclCompileIfCmd: error in "then" body} -body {
set a {}
list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- ("if" then script line 1)
- while compiling
-"if {$a!="xxx"} then {set}"}}
+} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}}
test if-1.11 {TclCompileIfCmd: error in "then" body} {
list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
} {1 {error in then clause}}
@@ -177,12 +173,11 @@
catch {if 1<2 {set a 1} elseif} msg
set msg
} {wrong # args: no expression after "elseif" argument}
-test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} {
+test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body {
set a {}
list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
- ("if" test expression)
- while compiling
+} -match glob -result {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression*
+ while *ing
"if 3>4 {set a 1} elseif {1>}"}}
test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
catch {unset i}
@@ -304,16 +299,13 @@
catch {if 2<1 {set a 1} else} msg
set msg
} {wrong # args: no script following "else" argument}
-test if-3.4 {TclCompileIfCmd: error compiling body after "else"} {
+test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body {
set a {}
catch {if 2<1 {set a 1} else {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- ("if" else script line 1)
- while compiling
-"if 2<1 {set a 1} else {set}"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
set a {}
catch {if 2<1 {set a 1} else {set a 2} or something} msg
@@ -552,12 +544,12 @@
catch {$z 1<2 then} msg
set msg
} {wrong # args: no script following "then" argument}
-test if-5.10 {if cmd with computed command names: error in "then" body} {
+test if-5.10 {if cmd with computed command names: error in "then" body} -body {
set z if
set a {}
list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
invoked from within
"$z {$a!="xxx"} then {set}"}}
@@ -807,13 +799,13 @@
catch {$z 2<1 {set a 1} else} msg
set msg
} {wrong # args: no script following "else" argument}
-test if-7.4 {if cmd with computed command names: error compiling body after "else"} {
+test if-7.4 {if cmd with computed command names: error compiling body after "else"} -body {
set z if
set a {}
catch {$z 2<1 {set a 1} else {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
invoked from within
"$z 2<1 {set a 1} else {set}"}
Index: tests/incr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/incr.test,v
retrieving revision 1.9
diff -u -r1.9 incr.test
--- tests/incr.test 28 Apr 2003 12:34:33 -0000 1.9
+++ tests/incr.test 23 Sep 2004 21:41:36 -0000
@@ -13,7 +13,7 @@
# RCS: @(#) $Id: incr.test,v 1.9 2003/04/28 12:34:33 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -174,15 +174,13 @@
set i 5
incr i -100
} -95
-test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} {
+test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
set i 5
catch {incr i [set]} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"incr i [set]"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
set i 25
incr i "-100"
@@ -218,13 +216,11 @@
(reading value of variable to increment)
invoked from within
"incr {"foo}"}}
-test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} {
+test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
list [catch {incr [set]} msg] $msg $errorInfo
-} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"incr [set]"}}
+} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} {
proc readonly args {error "variable is read-only"}
set x 123
@@ -426,16 +422,14 @@
set i 5
$z i -100
} -95
-test incr-2.19 {incr command (not compiled): increment given, but erroneous} {
+test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
set z incr
set i 5
catch {$z i [set]} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"$z i [set]"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
test incr-2.20 {incr command (not compiled): increment given, in quotes} {
set z incr
set i 25
@@ -478,14 +472,12 @@
(reading value of variable to increment)
invoked from within
"$z {"foo}"}}
-test incr-2.27 {incr command (not compiled): runtime error, bad variable name} {
+test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
set z incr
list [catch {$z [set]} msg] $msg $errorInfo
-} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- while compiling
-"$z [set]"}}
+} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} {
set z incr
proc readonly args {error "variable is read-only"}
Index: tests/while.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/while.test,v
retrieving revision 1.8
diff -u -r1.8 while.test
--- tests/while.test 4 Dec 2001 15:36:29 -0000 1.8
+++ tests/while.test 23 Sep 2004 21:41:37 -0000
@@ -13,7 +13,7 @@
# RCS: @(#) $Id: while.test,v 1.8 2001/12/04 15:36:29 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -26,13 +26,12 @@
catch {while } msg
set msg
} {wrong # args: should be "while test command"}
-test while-1.2 {TclCompileWhileCmd: error in test expression} {
+test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
set i 0
catch {while {$i<} break} msg
set errorInfo
-} {syntax error in expression "$i<": premature end of expression
- ("while" test expression)
- while compiling
+} -match glob -result {syntax error in expression "$i<": premature end of expression*
+ while *ing
"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
@@ -66,16 +65,13 @@
catch {while {$i < 5} } msg
set msg
} {wrong # args: should be "while test command"}
-test while-1.8 {TclCompileWhileCmd: error compiling command body} {
+test while-1.8 {TclCompileWhileCmd: error compiling command body} -body {
set i 0
catch {while {$i < 5} {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
-"set"
- ("while" body line 1)
- while compiling
-"while {$i < 5} {set}"}
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
+"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} {
set a {}
set i 1
@@ -350,13 +346,13 @@
catch {$z {$i < 5} } msg
set msg
} {wrong # args: should be "while test command"}
-test while-4.9 {while (not compiled): error compiling command body} {
+test while-4.9 {while (not compiled): error compiling command body} -body {
set i 0
set z while
catch {$z {$i < 5} {set}} msg
set errorInfo
-} {wrong # args: should be "set varName ?newValue?"
- while compiling
+} -match glob -result {wrong # args: should be "set varName ?newValue?"
+ while *ing
"set"
("while" body line 1)
invoked from within
