diff options
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 160 |
1 files changed, 92 insertions, 68 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e7b0aa0..45f1422 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.72 2003/02/03 20:16:52 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.73 2003/02/16 01:36:32 msofer Exp $ */ #include "tclInt.h" @@ -3579,13 +3579,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) * in case TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); - /* For nested scripts, this variable will be set to point to the first - * char after the end of the script - needed only to compare pointers, - * nothing will be read nor written there. - */ - - CONST char *onePast = NULL; - /* * The variables below keep track of how much state has been * allocated while evaluating the script, so that it can be freed @@ -3614,7 +3607,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) bytesLeft = numBytes; if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; - onePast = script + numBytes; } else { nested = 0; } @@ -3627,14 +3619,13 @@ Tcl_EvalEx(interp, script, numBytes, flags) } gotParse = 1; - /* - * A nested script can only terminate in ']'. If the script is not - * nested, onePast is NULL and the second test is not performed. - */ + if (nested && parse.term == (script + numBytes)) { + /* + * A nested script can only terminate in ']'. If + * the parsing got terminated at the end of the script, + * there was no closing ']'. Report the syntax error. + */ - next = parse.commandStart + parse.commandSize; - if ((next == onePast) && (onePast[-1] != ']')) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("missing close-bracket", -1)); code = TCL_ERROR; goto error; } @@ -3702,15 +3693,17 @@ Tcl_EvalEx(interp, script, numBytes, flags) * Advance to the next command in the script. */ + next = parse.commandStart + parse.commandSize; bytesLeft -= next - p; p = next; Tcl_FreeParse(&parse); gotParse = 0; - if ((nested != 0) && (p > script) && (p[-1] == ']')) { + if (nested && (*parse.term == ']')) { /* * We get here in the special case where the TCL_BRACKET_TERM - * flag was set in the interpreter and we reached a close - * bracket in the script. Return immediately. + * flag was set in the interpreter and the latest parsed command + * was terminated by the matching close-bracket we seek. + * Return immediately. */ iPtr->termOffset = (p - 1) - script; @@ -3732,12 +3725,12 @@ Tcl_EvalEx(interp, script, numBytes, flags) if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { commandLength = parse.commandSize; - if ((parse.commandStart + commandLength) != (script + numBytes)) { + if (parse.term == parse.commandStart + commandLength - 1) { /* - * The command where the error occurred didn't end at the end - * of the script (i.e. it ended at a terminator character such - * as ";". Reduce the length by one so that the error message - * doesn't include the terminator character. + * The terminator character (such as ; or ]) of the command where + * the error occurred is the last character in the parsed command. + * Reduce the length by one so that the error message doesn't + * include the terminator character. */ commandLength -= 1; @@ -3749,60 +3742,91 @@ Tcl_EvalEx(interp, script, numBytes, flags) Tcl_DecrRefCount(objv[i]); } if (gotParse) { - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; Tcl_FreeParse(&parse); + } + if (objv != staticObjArray) { + ckfree((char *) objv); + } + iPtr->varFramePtr = savedVarFramePtr; - if ((nested != 0) && (p > script)) { - CONST char *nextCmd = NULL; /* pointer to start of next command */ + /* + * All that's left to do before returning is to set iPtr->termOffset + * to point past the end of the script we just evaluated. + */ - /* - * We get here in the special case where the TCL_BRACKET_TERM - * flag was set in the interpreter. - * - * At this point, we want to find the end of the script - * (either end of script or the closing ']'). - */ + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; - while ((p[-1] != ']') && bytesLeft) { - if (Tcl_ParseCommand(NULL, p, bytesLeft, nested, &parse) - != TCL_OK) { - /* - * We were looking for the ']' to close the script. - * But if we find a syntax error, it is ok to quit - * early since in that case we no longer need to know - * where the ']' is (if there was one). We reset the - * pointer to the start of the command that after the - * one causing the return. -- hobbs - */ - - p = (nextCmd == NULL) ? parse.commandStart : nextCmd; - break; - } + if (!nested) { + iPtr->termOffset = p - script; + return code; + } - if (nextCmd == NULL) { - nextCmd = parse.commandStart; - } + /* + * When we are nested (the TCL_BRACKET_TERM flag was set in the + * interpreter), we must find the matching close-bracket to + * end the script we are evaluating. + * + * When our return code is TCL_CONTINUE or TCL_RETURN, we want + * to correctly set iPtr->termOffset to point to that matching + * close-bracket so our caller can move to the part of the + * string beyond the script we were asked to evaluate. + * So we try to parse past the rest of the commands. + */ - /* - * Advance to the next command in the script. - */ + next = NULL; + while (bytesLeft && (*parse.term != ']')) { + if (TCL_OK != Tcl_ParseCommand(NULL, p, bytesLeft, 1, &parse)) { + /* + * Syntax error. Set the termOffset to the beginning of + * the last command parsed. + */ - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; - Tcl_FreeParse(&parse); + if (next == NULL) { + iPtr->termOffset = (parse.commandStart - 1) - script; + } else { + iPtr->termOffset = (next - 1) - script; } - iPtr->termOffset = (p - 1) - script; - } else { - iPtr->termOffset = p - script; - } + return code; + } + next = parse.commandStart + parse.commandSize; + bytesLeft -= next - p; + p = next; + next = parse.commandStart; + Tcl_FreeParse(&parse); } - if (objv != staticObjArray) { - ckfree((char *) objv); + + if (bytesLeft) { + /* + * parse.term points to the close-bracket. + */ + + iPtr->termOffset = parse.term - script; + } else if (parse.term == script + numBytes) { + /* + * There was no close-bracket. Syntax error. + */ + + iPtr->termOffset = parse.term - script; + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing close-bracket", -1)); + return TCL_ERROR; + } else if (*parse.term != ']') { + /* + * There was no close-bracket. Syntax error. + */ + + iPtr->termOffset = (parse.term + 1) - script; + Tcl_SetObjResult(interp, + Tcl_NewStringObj("missing close-bracket", -1)); + return TCL_ERROR; + } else { + /* + * parse.term points to the close-bracket. + */ + iPtr->termOffset = parse.term - script; } - iPtr->varFramePtr = savedVarFramePtr; return code; } |