merged the parse changes between TclPro1.2 and Tcl8.1. Fixed bug in Windows makefile caused when the win/pkgIndex.tcl file was replaced

3 files changed, 45 insertions, 7 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 65e5570..895d34e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.40 1999/04/17 00:32:27 hershey Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.41 1999/04/21 18:16:45 surles Exp $
  */
 
 #ifndef _TCL
@@ -1328,6 +1328,23 @@ typedef struct Tcl_Token {
 #define TCL_TOKEN_OPERATOR	128
 
 /*
+ * Parsing error types.  On any parsing error, one of these values
+ * will be stored in the error field of the Tcl_Parse structure
+ * defined below.
+ */
+
+#define TCL_PARSE_SUCCESS		0
+#define TCL_PARSE_QUOTE_EXTRA		1
+#define TCL_PARSE_BRACE_EXTRA		2
+#define TCL_PARSE_MISSING_BRACE		3
+#define TCL_PARSE_MISSING_BRACKET	4
+#define TCL_PARSE_MISSING_PAREN		5
+#define TCL_PARSE_MISSING_QUOTE		6
+#define TCL_PARSE_MISSING_VAR_BRACE	7
+#define TCL_PARSE_SYNTAX		8
+#define TCL_PARSE_BAD_NUMBER		9
+
+/*
  * A structure of the following type is filled in by Tcl_ParseCommand.
  * It describes a single command parsed from an input string.
  */
@@ -1357,6 +1374,8 @@ typedef struct Tcl_Parse {
     int numTokens;		/* Total number of tokens in command. */
     int tokensAvailable;	/* Total number of tokens available at
 				 * *tokenPtr. */
+    int errorType;		/* One of the parsing error types defined
+				 * above. */
 
     /*
      * The fields below are intended only for the private use of the
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 679b039..ba1b837 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -14,7 +14,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.3 1999/04/16 00:46:51 stanton Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.4 1999/04/21 18:16:45 surles Exp $
  */
 
 #include "tclInt.h"
@@ -262,6 +262,7 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
     parsePtr->end = string + numBytes;
     parsePtr->interp = interp;
     parsePtr->incomplete = 0;
+    parsePtr->errorType = TCL_PARSE_SUCCESS;
     if (nested != 0) {
 	terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
     } else {
@@ -458,14 +459,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
 	if (src == parsePtr->end) {
 	    break;
 	}
-	if (interp != NULL) {
-	    if (src[-1] == '"') { 
+	if (src[-1] == '"') { 
+	    if (interp != NULL) {
 		Tcl_SetResult(interp, "extra characters after close-quote",
 			TCL_STATIC);
-	    } else {
+	    }
+	    parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
+	} else {
+	    if (interp != NULL) {
 		Tcl_SetResult(interp, "extra characters after close-brace",
 			TCL_STATIC);
 	    }
+	    parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
 	}
 	parsePtr->term = src;
 	goto error;
@@ -590,6 +595,7 @@ ParseTokens(src, mask, parsePtr)
 	    while (1) {
 		if (Tcl_ParseCommand(parsePtr->interp, src,
 			parsePtr->end - src, 1, &nested) != TCL_OK) {
+		    parsePtr->errorType = nested.errorType;
 		    parsePtr->term = nested.term;
 		    parsePtr->incomplete = nested.incomplete;
 		    return TCL_ERROR;
@@ -606,6 +612,7 @@ ParseTokens(src, mask, parsePtr)
 			Tcl_SetResult(parsePtr->interp,
 			    "missing close-bracket", TCL_STATIC);
 		    }
+		    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 		    parsePtr->term = tokenPtr->start;
 		    parsePtr->incomplete = 1;
 		    return TCL_ERROR;
@@ -734,7 +741,6 @@ TclExpandTokenArray(parsePtr)
 	    (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
 	ckfree((char *) parsePtr->tokenPtr);
-	parsePtr->tokenPtr = parsePtr->staticTokens;
     }
     parsePtr->tokenPtr = newPtr;
     parsePtr->tokensAvailable = newCount;
@@ -1598,6 +1604,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 	parsePtr->string = string;
 	parsePtr->end = end;
 	parsePtr->interp = interp;
+	parsePtr->errorType = TCL_PARSE_SUCCESS;
 	parsePtr->incomplete = 0;
     }
 
@@ -1654,6 +1661,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 			"missing close-brace for variable name",
 			TCL_STATIC);
 		}
+		parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
 		parsePtr->term = tokenPtr->start-1;
 		parsePtr->incomplete = 1;
 		goto error;
@@ -1708,6 +1716,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
 		    Tcl_SetResult(parsePtr->interp, "missing )",
 			    TCL_STATIC);
 		}
+		parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
 		parsePtr->term = src;
 		parsePtr->incomplete = 1;
 		goto error;
@@ -1880,6 +1889,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
 	parsePtr->string = string;
 	parsePtr->end = end;
 	parsePtr->interp = interp;
+	parsePtr->errorType = TCL_PARSE_SUCCESS;
     }
 
     src = string+1;
@@ -1945,6 +1955,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
 	    }
+	    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
 	    parsePtr->term = string;
 	    parsePtr->incomplete = 1;
 	    goto error;
@@ -2047,6 +2058,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
 	parsePtr->string = string;
 	parsePtr->end = end;
 	parsePtr->interp = interp;
+	parsePtr->errorType = TCL_PARSE_SUCCESS;
     }
     
     if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
@@ -2056,6 +2068,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
 	if (interp != NULL) {
 	    Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
 	}
+	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
 	parsePtr->term = string;
 	parsePtr->incomplete = 1;
 	goto error;
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 306d5de..fdbeaae 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.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: tclParseExpr.c,v 1.2 1999/04/16 00:46:51 stanton Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.3 1999/04/21 18:16:46 surles Exp $
  */
 
 #include "tclInt.h"
@@ -1279,6 +1279,7 @@ ParsePrimaryExpr(infoPtr)
 	    if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
 		    &nested) != TCL_OK) {
 		parsePtr->term = nested.term;
+		parsePtr->errorType = nested.errorType;
 		parsePtr->incomplete = nested.incomplete;
 		return TCL_ERROR;
 	    }
@@ -1295,6 +1296,7 @@ ParsePrimaryExpr(infoPtr)
 			    TCL_STATIC);
 		}
 		parsePtr->term = tokenPtr->start;
+		parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 		parsePtr->incomplete = 1;
 		return TCL_ERROR;
 	    }
@@ -1514,6 +1516,7 @@ GetLexeme(infoPtr)
 		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
 			    (char *) NULL);
 		}
+		parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
 		return TCL_ERROR;
 	    }
  	    if (termPtr != src) {
@@ -1537,6 +1540,7 @@ GetLexeme(infoPtr)
 		    if (interp != NULL) {
 			TclExprFloatError(interp, doubleValue);
 		    }
+		    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
 		    return TCL_ERROR;
 		}
 		
@@ -1823,4 +1827,6 @@ LogSyntaxError(infoPtr)
 	    ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);
     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
 	    buffer, (char *) NULL);
+    infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
+    infoPtr->parsePtr->term = infoPtr->start;
 }