summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-10-19 11:20:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-10-19 11:20:46 (GMT)
commit3e798bfe4700fd510a0daf3944429c75596786da (patch)
tree0d4157d7788b2129f63ef6b24881a10f0dc13b47
parentc00bdffb6aa0fca3575ef0ab1a07813f696f1839 (diff)
downloadtcl-3e798bfe4700fd510a0daf3944429c75596786da.zip
tcl-3e798bfe4700fd510a0daf3944429c75596786da.tar.gz
tcl-3e798bfe4700fd510a0daf3944429c75596786da.tar.bz2
Improve coverage of [error] compilation.
-rw-r--r--generic/tclCompCmds.c43
1 files changed, 36 insertions, 7 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 25201eb..c55635a 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2135,19 +2135,48 @@ TclCompileErrorCmd(
{
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
- * However, we only deal with the case where there is just a message.
*/
- Tcl_Token *messageTokenPtr;
+
+ Tcl_Token *tokenPtr;
DefineLineInformation; /* TIP #280 */
- if (parsePtr->numWords != 2) {
+ if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
- messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushStringLiteral(envPtr, "-code error -level 0");
- CompileWord(envPtr, messageTokenPtr, interp, 1);
- TclEmitOpcode(INST_RETURN_STK, envPtr);
+ /*
+ * Handle the message.
+ */
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 1);
+
+ /*
+ * Construct the options. Note that -code and -level are not here.
+ */
+
+ if (parsePtr->numWords == 2) {
+ PushStringLiteral(envPtr, "");
+ } else {
+ PushStringLiteral(envPtr, "-errorinfo");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 2);
+ if (parsePtr->numWords == 3) {
+ TclEmitInstInt4( INST_LIST, 2, envPtr);
+ } else {
+ PushStringLiteral(envPtr, "-errorcode");
+ tokenPtr = TokenAfter(tokenPtr);
+ CompileWord(envPtr, tokenPtr, interp, 3);
+ TclEmitInstInt4( INST_LIST, 4, envPtr);
+ }
+ }
+
+ /*
+ * Issue the error via 'returnImm error 0'.
+ */
+
+ TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr);
+ TclEmitInt4( 0, envPtr);
return TCL_OK;
}