diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2013-10-19 11:20:46 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2013-10-19 11:20:46 (GMT) |
commit | 3e798bfe4700fd510a0daf3944429c75596786da (patch) | |
tree | 0d4157d7788b2129f63ef6b24881a10f0dc13b47 | |
parent | c00bdffb6aa0fca3575ef0ab1a07813f696f1839 (diff) | |
download | tcl-3e798bfe4700fd510a0daf3944429c75596786da.zip tcl-3e798bfe4700fd510a0daf3944429c75596786da.tar.gz tcl-3e798bfe4700fd510a0daf3944429c75596786da.tar.bz2 |
Improve coverage of [error] compilation.
-rw-r--r-- | generic/tclCompCmds.c | 43 |
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; } |