summaryrefslogtreecommitdiffstats
path: root/generic/tclCompExpr.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompExpr.c')
-rw-r--r--generic/tclCompExpr.c100
1 files changed, 74 insertions, 26 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 74610c7..fa15fba 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -164,6 +164,8 @@ enum Marks {
* "=" is encountered. */
#define INVALID 5 /* A parse error. Used when any punctuation
* appears that's not a supported operator. */
+#define COMMENT 6 /* Comment. Lasts to end of line or end of
+ * expression, whichever comes first. */
/* Leaf lexemes */
@@ -462,7 +464,7 @@ static const unsigned char Lexeme[] = {
INVALID /* FS */, INVALID /* GS */,
INVALID /* RS */, INVALID /* US */,
INVALID /* SPACE */, 0 /* ! or != */,
- QUOTED /* " */, INVALID /* # */,
+ QUOTED /* " */, 0 /* # */,
VARIABLE /* $ */, MOD /* % */,
0 /* & or && */, INVALID /* ' */,
OPEN_PAREN /* ( */, CLOSE_PAREN /* ) */,
@@ -674,9 +676,10 @@ ParseExpr(
OpNode *newPtr = NULL;
do {
- if (size <= UINT_MAX/sizeof(OpNode)) {
- newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode));
- }
+ if (size <= UINT_MAX/sizeof(OpNode)) {
+ newPtr = (OpNode *) attemptckrealloc(nodes,
+ size * sizeof(OpNode));
+ }
} while ((newPtr == NULL)
&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
if (newPtr == NULL) {
@@ -708,6 +711,10 @@ ParseExpr(
int b;
switch (lexeme) {
+ case COMMENT:
+ start += scanned;
+ numBytes -= scanned;
+ continue;
case INVALID:
msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
scanned, start);
@@ -742,6 +749,32 @@ ParseExpr(
} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
lexeme = BOOLEAN;
} else {
+ /*
+ * Tricky case: see test expr-62.10
+ */
+
+ int scanned2 = scanned;
+ do {
+ scanned2 += TclParseAllWhiteSpace(
+ start + scanned2, numBytes - scanned2);
+ scanned2 += ParseLexeme(
+ start + scanned2, numBytes - scanned2, &lexeme,
+ NULL);
+ } while (lexeme == COMMENT);
+ if (lexeme == OPEN_PAREN) {
+ /*
+ * Actually a function call, but with obscuring
+ * comments. Skip to the start of the parentheses.
+ * Note that we assume that open parentheses are one
+ * byte long.
+ */
+
+ lexeme = FUNCTION;
+ Tcl_ListObjAppendElement(NULL, funcList, literal);
+ scanned = scanned2 - 1;
+ break;
+ }
+
Tcl_DecrRefCount(literal);
msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
(scanned < limit) ? scanned : limit - 3, start,
@@ -1009,7 +1042,7 @@ ParseExpr(
* later.
*/
- literal = Tcl_NewObj();
+ TclNewObj(literal);
if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
Tcl_ListObjAppendElement(NULL, litList, literal);
complete = lastParsed = OT_LITERAL;
@@ -1836,11 +1869,13 @@ Tcl_ParseExpr(
{
int code;
OpNode *opTree = NULL; /* Will point to the tree of operators. */
- Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */
- Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */
+ Tcl_Obj *litList; /* List to hold the literals. */
+ Tcl_Obj *funcList; /* List to hold the functon names. */
Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
/* Holds the Tcl_Tokens of substitutions. */
+ TclNewObj(litList);
+ TclNewObj(funcList);
if (numBytes < 0) {
numBytes = (start ? strlen(start) : 0);
}
@@ -1892,8 +1927,8 @@ ParseLexeme(
storage, if non-NULL. */
{
const char *end;
- int scanned;
- Tcl_UniChar ch = 0;
+ int scanned, size;
+ int ch;
Tcl_Obj *literal = NULL;
unsigned char byte;
@@ -1907,6 +1942,16 @@ ParseLexeme(
return 1;
}
switch (byte) {
+ case '#':
+ /*
+ * Scan forward over the comment contents.
+ */
+ for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) {
+ byte = UCHAR(start[size]);
+ }
+ *lexemePtr = COMMENT;
+ return size - (byte == '\n');
+
case '*':
if ((numBytes > 1) && (start[1] == '*')) {
*lexemePtr = EXPON;
@@ -2040,7 +2085,7 @@ ParseLexeme(
break;
}
- literal = Tcl_NewObj();
+ TclNewObj(literal);
if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
if (end < start + numBytes && !TclIsBareword(*end)) {
@@ -2100,14 +2145,14 @@ ParseLexeme(
*/
if (!TclIsBareword(*start) || *start == '_') {
- if (Tcl_UtfCharComplete(start, numBytes)) {
- scanned = TclUtfToUniChar(start, &ch);
+ if (TclUCS4Complete(start, numBytes)) {
+ scanned = TclUtfToUCS4(start, &ch);
} else {
- char utfBytes[4];
+ char utfBytes[8];
memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
- scanned = TclUtfToUniChar(utfBytes, &ch);
+ scanned = TclUtfToUCS4(utfBytes, &ch);
}
*lexemePtr = INVALID;
Tcl_DecrRefCount(literal);
@@ -2154,12 +2199,15 @@ TclCompileExpr(
int optimize) /* 0 for one-off expressions. */
{
OpNode *opTree = NULL; /* Will point to the tree of operators */
- Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */
- Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/
+ Tcl_Obj *litList; /* List to hold the literals */
+ Tcl_Obj *funcList; /* List to hold the functon names*/
Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
/* Holds the Tcl_Tokens of substitutions */
+ int code;
- int code = ParseExpr(interp, script, numBytes, &opTree, litList,
+ TclNewObj(litList);
+ TclNewObj(funcList);
+ code = ParseExpr(interp, script, numBytes, &opTree, litList,
funcList, parsePtr, 0 /* parseOnly */);
if (code == TCL_OK) {
@@ -2458,8 +2506,8 @@ CompileExprTree(
if (optimize) {
int length;
const char *bytes = TclGetStringFromObj(literal, &length);
- int index = TclRegisterLiteral(envPtr, bytes, length, 0);
- Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
+ int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
+ Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
/*
@@ -2479,7 +2527,7 @@ CompileExprTree(
objPtr->internalRep = literal->internalRep;
literal->typePtr = NULL;
}
- TclEmitPush(index, envPtr);
+ TclEmitPush(idx, envPtr);
} else {
/*
* When optimize==0, we know the expression is a one-off and
@@ -2505,7 +2553,7 @@ CompileExprTree(
if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
== TCL_OK) {
- int index;
+ int idx;
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
/*
@@ -2519,8 +2567,8 @@ CompileExprTree(
const char *bytes
= Tcl_GetStringFromObj(objPtr, &numBytes);
- index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
- tableValue = TclFetchLiteral(envPtr, index);
+ idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
+ tableValue = TclFetchLiteral(envPtr, idx);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
/*
@@ -2532,9 +2580,9 @@ CompileExprTree(
objPtr->typePtr = NULL;
}
} else {
- index = TclAddLiteralObj(envPtr, objPtr, NULL);
+ idx = TclAddLiteralObj(envPtr, objPtr, NULL);
}
- TclEmitPush(index, envPtr);
+ TclEmitPush(idx, envPtr);
} else {
TclCompileSyntaxError(interp, envPtr);
}
@@ -2711,7 +2759,7 @@ TclVariadicOpCmd(
int code;
if (objc < 2) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(occdPtr->i.identity));
return TCL_OK;
}
generated by cgit v0.12 at 2025-12-12 08:00:14 (GMT)