Attachment "expr-in.patch" to
ticket [882238ffff]
added by
rmax
2004-01-22 23:55:38.
? PATCH
? build
Index: doc/expr.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/expr.n,v
retrieving revision 1.12
diff -u -r1.12 expr.n
--- doc/expr.n 12 Sep 2003 23:55:32 -0000 1.12
+++ doc/expr.n 22 Jan 2004 16:25:42 -0000
@@ -115,6 +115,16 @@
may be applied to string operands, and bit-wise NOT may be
applied only to integers.
.TP 20
+\fBin\fR
+.VS 8.5
+Searches a string in a list. The result is identical to the expression
+.br
+\fB[lsearch -exact list string] >= 0\fR
+.br
+with \fBstring\fR being the left hand side and \fBlist\fR being the right hand
+side operator of \fBin\fR.
+.VE 8.5
+.TP 20
\fB**\fR
.VS 8.5
Exponentiation. None of these operands may be applied to string
Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.21
diff -u -r1.21 tclCompExpr.c
--- generic/tclCompExpr.c 12 Jan 2004 18:50:15 -0000 1.21
+++ generic/tclCompExpr.c 22 Jan 2004 16:25:42 -0000
@@ -93,6 +93,7 @@
#define OP_STREQ 21
#define OP_STRNEQ 22
#define OP_EXPON 23
+#define OP_IN 24
/*
* Table describing the expression operators. Entries in this table must
@@ -136,6 +137,7 @@
{"eq", 2, INST_STR_EQ},
{"ne", 2, INST_STR_NEQ},
{"**", 2, INST_EXPON},
+ {"in", 2, INST_LIST_IN},
{NULL}
};
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.42
diff -u -r1.42 tclCompile.h
--- generic/tclCompile.h 20 Jan 2004 15:49:54 -0000 1.42
+++ generic/tclCompile.h 22 Jan 2004 16:25:42 -0000
@@ -543,8 +543,11 @@
#define INST_LIST_INDEX_IMM 102
#define INST_LIST_RANGE_IMM 103
+/* TIP #xx - expr 'in' operator */
+#define INST_LIST_IN 104
+
/* The last opcode */
-#define LAST_INST_OPCODE 103
+#define LAST_INST_OPCODE 104
/*
* Table describing the Tcl bytecode instructions: their name (for
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.121
diff -u -r1.121 tclExecute.c
--- generic/tclExecute.c 18 Jan 2004 16:19:05 -0000 1.121
+++ generic/tclExecute.c 22 Jan 2004 16:25:43 -0000
@@ -2738,6 +2738,7 @@
case INST_STR_EQ:
case INST_STR_NEQ:
+ case INST_LIST_IN:
{
/*
* String (in)equality check
@@ -2753,6 +2754,39 @@
* we don't really have to think hard about equality.
*/
iResult = (*pc == INST_STR_EQ);
+
+ } else if (*pc == INST_LIST_IN) {
+ char *s1, *s2;
+ int s1len, s2len, llen, i;
+ Tcl_Obj *o;
+
+ s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+ result = Tcl_ListObjLength(interp, value2Ptr, &llen);
+ if (result != TCL_OK) {
+ goto checkForCatch;
+ }
+ iResult = 0;
+ if (llen == 0 && s1len == 0) {
+ /* empty string matches empty list */
+ iResult =1;
+ } else {
+ i = 0;
+ do {
+ result = Tcl_ListObjIndex(interp, value2Ptr, i, &o);
+ if (result != TCL_OK) {
+ goto checkForCatch;
+ }
+ if (o != NULL) {
+ s2 = Tcl_GetStringFromObj(o, &s2len);
+ } else {
+ s2 = "";
+ }
+ if (s1len == s2len) {
+ iResult = (strcmp(s1, s2) == 0);
+ }
+ i++;
+ } while (i < llen && iResult == 0);
+ }
} else {
char *s1, *s2;
int s1len, s2len;
Index: generic/tclParseExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParseExpr.c,v
retrieving revision 1.19
diff -u -r1.19 tclParseExpr.c
--- generic/tclParseExpr.c 14 Oct 2003 15:44:53 -0000 1.19
+++ generic/tclParseExpr.c 22 Jan 2004 16:25:44 -0000
@@ -136,6 +136,11 @@
#define EXPON 36
/*
+ * 'in' operator
+ */
+#define IN 37
+
+/*
* Mapping from lexemes to strings; used for debugging messages. These
* entries must match the order and number of the lexeme definitions above.
*/
@@ -146,7 +151,7 @@
"*", "/", "%", "+", "-",
"<<", ">>", "<", ">", "<=", ">=", "==", "!=",
"&", "^", "|", "&&", "||", "?", ":",
- "!", "~", "eq", "ne", "**"
+ "!", "~", "eq", "ne", "**", "in"
};
/*
@@ -171,6 +176,7 @@
static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseExponentialExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseInExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
int opBytes, CONST char *src, int srcBytes,
@@ -1045,7 +1051,7 @@
* ParseExponentialExpr --
*
* This procedure parses a Tcl exponential expression:
- * exponentialExpr ::= unaryExpr {'**' unaryExpr}
+ * exponentialExpr ::= inExpr {'**' inExpr}
*
* Results:
* The return value is TCL_OK on a successful parse and TCL_ERROR
@@ -1073,7 +1079,7 @@
srcStart = infoPtr->start;
firstIndex = parsePtr->numTokens;
- code = ParseUnaryExpr(infoPtr);
+ code = ParseInExpr(infoPtr);
if (code != TCL_OK) {
return code;
}
@@ -1105,6 +1111,68 @@
/*
*----------------------------------------------------------------------
*
+ * ParseInExpr --
+ *
+ * This procedure parses a Tcl in expression:
+ * inExpr ::= unaryExpr 'in' unaryExpr | unaryExpr
+ *
+ * Results:
+ * The return value is TCL_OK on a successful parse and TCL_ERROR
+ * on failure. If TCL_ERROR is returned, then the interpreter's result
+ * contains an error message.
+ *
+ * Side effects:
+ * If there is insufficient space in parsePtr to hold all the
+ * information about the subexpression, then additional space is
+ * malloc-ed.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseInExpr(infoPtr)
+ ParseInfo *infoPtr; /* Holds the parse state for the
+ * expression being parsed. */
+{
+ Tcl_Parse *parsePtr = infoPtr->parsePtr;
+ int firstIndex, lexeme, code;
+ CONST char *srcStart, *operator;
+
+ HERE("inExpr", 13);
+ srcStart = infoPtr->start;
+ firstIndex = parsePtr->numTokens;
+
+ code = ParseUnaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ lexeme = infoPtr->lexeme;
+ while (lexeme == IN) {
+ operator = infoPtr->start;
+ code = GetLexeme(infoPtr); /* skip over ** */
+ if (code != TCL_OK) {
+ return code;
+ }
+ code = ParseUnaryExpr(infoPtr);
+ if (code != TCL_OK) {
+ return code;
+ }
+
+ /*
+ * Generate tokens for the subexpression and 'in' operator.
+ */
+
+ PrependSubExprTokens(operator, 2, srcStart,
+ (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
+ lexeme = infoPtr->lexeme;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseUnaryExpr --
*
* This procedure parses a Tcl unary expression:
@@ -1132,7 +1200,7 @@
int firstIndex, lexeme, code;
CONST char *srcStart, *operator;
- HERE("unaryExpr", 13);
+ HERE("unaryExpr", 14);
srcStart = infoPtr->start;
firstIndex = parsePtr->numTokens;
@@ -1202,7 +1270,7 @@
* We simply recurse on parenthesized subexpressions.
*/
- HERE("primaryExpr", 14);
+ HERE("primaryExpr", 15);
lexeme = infoPtr->lexeme;
if (lexeme == OPEN_PAREN) {
code = GetLexeme(infoPtr); /* skip over the '(' */
@@ -1872,6 +1940,18 @@
case 'e':
if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = STREQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+ } else {
+ goto checkFuncName;
+ }
+
+ case 'i':
+ if ((src[1] == 'n') && ((infoPtr->lastChar - src) > 1) &&
+ (src[2] != 't')) {
+ infoPtr->lexeme = IN;
infoPtr->size = 2;
infoPtr->next = src+2;
parsePtr->term = infoPtr->next;
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.20
diff -u -r1.20 expr.test
--- tests/expr.test 19 Sep 2003 23:05:40 -0000 1.20
+++ tests/expr.test 22 Jan 2004 16:25:44 -0000
@@ -860,6 +860,48 @@
test epxr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1
test epxr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0
+# Tests for the 'in' operator
+test expr-24.1 {'in' operator: first element matches} {
+ expr {"a" in "a b c"}
+} [expr {[lsearch -exact "a b c" a] >=0}]
+
+test expr-24.2 {'in' operator: inner element matches} {
+ expr {"a" in "b a c"}
+} [expr {[lsearch -exact "b a c" a] >= 0}]
+
+test expr-24.3 {'in' operator: last elemet matches} {
+ expr {"a" in "c b a"}
+} [expr {[lsearch -exact "c b a" a] >= 0}]
+
+test expr-24.4 {'in' operator: empty list} {
+ expr {"a" in ""}
+} [expr {[lsearch -exact "" a] >= 0}]
+
+test expr-24.5 {'in' operator: empty string - match} {
+ expr {"" in {a b c ""}}
+} [expr {[lsearch -exact {a b c ""} ""] >= 0}]
+
+test expr-24.6 {'in' operator: empty syting - no match} {
+ expr {"" in "a b c"}
+} [expr {[lsearch -exact "a b c" ""] >= 0}]
+
+test expr-24.7 {'in' operator: both empty} {
+ expr {"" in ""}
+} [expr {[lsearch -exact "" ""] >= 0}]
+
+test expr-24.8 {'in' operator: variables - match} {
+ set a a
+ set b [list a b c]
+ expr {$a in $b}
+} 1
+
+test expr-24.8 {'in' operator: variables - no match} {
+ set a a
+ set b [list b c d]
+ expr {$a in $b}
+} 0
+
+
# cleanup
if {[info exists a]} {
unset a
