Don Porter's fix for bad parsing of nested scripts [Bug 681841].

5 files changed, 202 insertions, 105 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;
 }
 
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 8d74efa..1465f69 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompExpr.c,v 1.12 2002/08/05 03:24:40 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.13 2003/02/16 01:36:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -398,7 +398,7 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
 	    
         case TCL_TOKEN_COMMAND:
 	    code = TclCompileScript(interp, tokenPtr->start+1,
-		    tokenPtr->size-2, /*nested*/ 1, envPtr);
+		    tokenPtr->size-2, /*nested*/ 0, envPtr);
 	    if (code != TCL_OK) {
 		goto done;
 	    }
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;
 		}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 7e8fced..ec8c9f0 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.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: tclParse.c,v 1.24 2003/02/11 18:34:43 hobbs Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.25 2003/02/16 01:36:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -306,6 +306,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
 	src += scanned; numBytes -= scanned;
 	if (numBytes == 0) {
+	    parsePtr->term = src;
 	    break;
 	}
 	if ((type & terminators) != 0) {
@@ -376,6 +377,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	}
 
 	if (numBytes == 0) {
+	    parsePtr->term = src;
 	    break;
 	}
 	if ((type & terminators) != 0) {
@@ -408,7 +410,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
     if (parsePtr->commandStart == NULL) {
 	parsePtr->commandStart = string;
     }
-    parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
+    parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
     return TCL_ERROR;
 }
 
@@ -859,10 +861,24 @@ ParseTokens(src, numBytes, mask, parsePtr)
 		}
 		src = nested.commandStart + nested.commandSize;
 		numBytes = parsePtr->end - src;
+
+		/*
+		 * This is equivalent to Tcl_FreeParse(&nested), but
+		 * presumably inlined here for sake of runtime optimization
+		 */
+
 		if (nested.tokenPtr != nested.staticTokens) {
 		    ckfree((char *) nested.tokenPtr);
 		}
-		if ((*nested.term == ']') && !nested.incomplete) {
+
+		/*
+		 * Check for the closing ']' that ends the command
+		 * substitution.  It must have been the last character of
+		 * the parsed command.
+		 */
+
+		if ((nested.term < parsePtr->end) && (*nested.term == ']')
+			&& !nested.incomplete) {
 		    break;
 		}
 		if (numBytes == 0) {
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 85be0cd..bb88159 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.16 2002/12/11 20:30:16 dgp Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.17 2003/02/16 01:36:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1287,10 +1287,23 @@ ParsePrimaryExpr(infoPtr)
 		return TCL_ERROR;
 	    }
 	    src = (nested.commandStart + nested.commandSize);
+
+	    /*
+	     * This is equivalent to Tcl_FreeParse(&nested), but
+	     * presumably inlined here for sake of runtime optimization
+	     */
+
 	    if (nested.tokenPtr != nested.staticTokens) {
 		ckfree((char *) nested.tokenPtr);
 	    }
-	    if ((src[-1] == ']') && !nested.incomplete) {
+
+	    /*
+	     * Check for the closing ']' that ends the command substitution.
+	     * It must have been the last character of the parsed command.
+	     */
+
+	    if ((nested.term < parsePtr->end) && (*nested.term == ']') 
+		    && !nested.incomplete) {
 		break;
 	    }
 	    if (src == parsePtr->end) {