summaryrefslogtreecommitdiffstats
path: root/generic/tclCompile.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompile.c')
-rw-r--r--generic/tclCompile.c104
1 files changed, 74 insertions, 30 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index c069d76..feeb7e6 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.41 2002/09/24 12:53:33 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.42 2003/02/16 01:36:32 msofer Exp $
*/
#include "tclInt.h"
@@ -798,7 +798,9 @@ TclFreeCompileEnv(envPtr)
int
TclCompileScript(interp, script, numBytes, nested, envPtr)
- Tcl_Interp *interp; /* Used for error and status reporting. */
+ Tcl_Interp *interp; /* Used for error and status reporting.
+ * Also serves as context for finding and
+ * compiling commands. May not be NULL. */
CONST char *script; /* The source script to compile. */
int numBytes; /* Number of bytes in script. If < 0, the
* script consists of all bytes up to the
@@ -824,7 +826,6 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_Token *tokenPtr;
int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
int commandLength, objIndex, code;
- char prev;
Tcl_DString ds;
Tcl_DStringInit(&ds);
@@ -843,12 +844,56 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
p = script;
bytesLeft = numBytes;
gotParse = 0;
- while (bytesLeft > 0) {
+ do {
if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
code = TCL_ERROR;
goto error;
}
gotParse = 1;
+ if (nested) {
+ /*
+ * This is an unusual situation where the caller has passed us
+ * a non-zero value for "nested". How unusual? Well, this
+ * procedure, TclCompileScript, is internal to Tcl, so all
+ * callers should be within Tcl itself. All but one of those
+ * callers explicitly pass in (nested = 0). The exceptional
+ * caller is TclSetByteCodeFromAny, which will pass in
+ * (nested = 1) if and only if the flag TCL_BRACKET_TERM
+ * is set in the evalFlags field of interp.
+ *
+ * It appears that the TCL_BRACKET_TERM flag is only ever set
+ * by Tcl_SubstObj, and it immediately calls Tcl_EvalEx
+ * which clears the flag before passing the interp along.
+ * So, I don't think this procedure, TclCompileScript, is
+ * **ever** called with (nested != 0).
+ * (The testsuite indeed doesn't exercise this code. MS)
+ *
+ * This means that the branches in this procedure that are
+ * only active when (nested != 0) are probably never exercised.
+ * This means that any bugs in them go unnoticed, and any bug
+ * fixes in them have a semi-theoretical nature.
+ *
+ * All that said, the spec for this procedure says it should
+ * handle the (nested != 0) case, so here's an attempt to fix
+ * bugs (Tcl Bug 681841) in that case. Just in case some
+ * callers eventually come along and expect it to work...
+ */
+
+ if (parse.term == (script + numBytes)) {
+ /*
+ * The (nested != 0) case is meant to indicate that the
+ * caller found an open bracket ([) and asked us to
+ * parse and compile Tcl commands up to the matching
+ * close bracket (]). We have to detect and handle
+ * the case where the close bracket is missing.
+ */
+
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("missing close-bracket", -1));
+ code = TCL_ERROR;
+ goto error;
+ }
+ }
if (parse.numWords > 0) {
/*
* If not the first command, pop the previous command's result
@@ -870,15 +915,10 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
*/
commandLength = parse.commandSize;
- prev = '\0';
- if (commandLength > 0) {
- prev = parse.commandStart[commandLength-1];
- }
- if (((parse.commandStart+commandLength) != (script+numBytes))
- || ((prev=='\n') || (nested && (prev==']')))) {
+ if (parse.term == parse.commandStart + commandLength - 1) {
/*
- * The command didn't end at the end of the script (i.e. it
- * ended at a terminator character such as ";". Reduce the
+ * The command terminator character (such as ; or ]) is
+ * the last character in the parsed command. Reduce the
* length by one so that the trace message doesn't include
* the terminator character.
*/
@@ -963,7 +1003,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* claimed to be in (*envPtr).
*/
envPtr->numCommands--;
- goto error;
+ goto log;
}
}
@@ -993,7 +1033,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
- goto error;
+ goto log;
}
}
}
@@ -1031,16 +1071,17 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
p = next;
Tcl_FreeParse(&parse);
gotParse = 0;
- if (nested && (p[-1] == ']')) {
+ if (nested && (*parse.term == ']')) {
/*
* We get here in the special case where TCL_BRACKET_TERM was
- * set in the interpreter and we reached a close bracket in the
- * script. Stop compilation.
+ * set in the interpreter and the latest parsed command was
+ * terminated by the matching close-bracket we were looking for.
+ * Stop compilation.
*/
break;
}
- }
+ } while (bytesLeft > 0);
/*
* If the source script yielded no instructions (e.g., if it was empty),
@@ -1052,7 +1093,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
envPtr);
}
- if ((nested != 0) && (p > script) && (p[-1] == ']')) {
+ if (nested) {
+ /*
+ * When (nested != 0) back up 1 character to have
+ * iPtr->termOffset indicate the offset to the matching
+ * close-bracket.
+ */
+
iPtr->termOffset = (p - 1) - script;
} else {
iPtr->termOffset = (p - script);
@@ -1069,21 +1116,18 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
*/
commandLength = parse.commandSize;
- prev = '\0';
- if (commandLength > 0) {
- prev = parse.commandStart[commandLength-1];
- }
- if (((parse.commandStart+commandLength) != (script+numBytes))
- || ((prev == '\n') || (nested && (prev == ']')))) {
+ 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;
}
+
+ log:
LogCompilationInfo(interp, script, parse.commandStart, commandLength);
if (gotParse) {
Tcl_FreeParse(&parse);
@@ -1163,7 +1207,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
}
code = TclCompileScript(interp, tokenPtr->start+1,
- tokenPtr->size-2, /*nested*/ 1, envPtr);
+ tokenPtr->size-2, /*nested*/ 0, envPtr);
if (code != TCL_OK) {
goto error;
}