summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h21
-rw-r--r--generic/tclParse.c23
-rw-r--r--generic/tclParseExpr.c8
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;
}
generated by cgit v0.12 at 2024-11-18 18:13:02 (GMT)