From 7ab2eee54bc6371397693ad5a6610e8d5efc4cc8 Mon Sep 17 00:00:00 2001 From: surles Date: Wed, 21 Apr 1999 18:16:45 +0000 Subject: merged the parse changes between TclPro1.2 and Tcl8.1. Fixed bug in Windows makefile caused when the win/pkgIndex.tcl file was replaced --- generic/tcl.h | 21 ++++++++++++++++++++- generic/tclParse.c | 23 ++++++++++++++++++----- generic/tclParseExpr.c | 8 +++++++- win/makefile.vc | 3 +-- 4 files changed, 46 insertions(+), 9 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; } diff --git a/win/makefile.vc b/win/makefile.vc index b40b844..984fa5a 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -6,7 +6,7 @@ # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: makefile.vc,v 1.28 1999/04/19 22:05:25 surles Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.29 1999/04/21 18:16:46 surles Exp $ # Does not depend on the presence of any environment variables in # order to compile tcl; all needed information is derived from @@ -322,7 +322,6 @@ tcltest: setup $(TCLTEST) dlls $(CAT16) $(CAT32) plugin: setup $(TCLPLUGINDLL) $(TCLSHP) install: install-binaries install-libraries test: setup $(TCLTEST) dlls $(CAT16) $(CAT32) - copy $(WINDIR)\pkgIndex.tcl $(OUTDIR) set TCL_LIBRARY=$(ROOT)/library $(TCLTEST) << "$(TCLREGDLL)" load [lindex $$argv 0] registry -- cgit v0.12