? 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
