diff options
author | surles <surles@noemail.net> | 1999-04-21 18:16:44 (GMT) |
---|---|---|
committer | surles <surles@noemail.net> | 1999-04-21 18:16:44 (GMT) |
commit | a25fa4a4d88708ff1dcf8d5d4baaa8a231bb6e81 (patch) | |
tree | ef9e0f2e9d84e84787a71ed5b2d822f6fefac901 /generic | |
parent | 4e68dbc1d601df57ce2d6ef3ba9a505c094a02c3 (diff) | |
download | tcl-a25fa4a4d88708ff1dcf8d5d4baaa8a231bb6e81.zip tcl-a25fa4a4d88708ff1dcf8d5d4baaa8a231bb6e81.tar.gz tcl-a25fa4a4d88708ff1dcf8d5d4baaa8a231bb6e81.tar.bz2 |
merged the parse changes between TclPro1.2 and Tcl8.1. Fixed bug in Windows makefile caused when the win/pkgIndex.tcl file was replaced
FossilOrigin-Name: 2874a749d4680fc13a6a74f2d24b0eaf1782343a
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.h | 21 | ||||
-rw-r--r-- | generic/tclParse.c | 23 | ||||
-rw-r--r-- | generic/tclParseExpr.c | 8 |
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; } |