Tcl Source Code

Artifact 027ebed225bbeca24f4306a7e8cb3d6758e1fda4:

Attachment "tip282-2.patch" to ticket [1969722fff] added by dgp 2008-05-23 03:40:53.

---

Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.97
diff -u -r1.97 tclCompExpr.c
--- generic/tclCompExpr.c	28 Feb 2008 20:40:24 -0000	1.97
+++ generic/tclCompExpr.c	22 May 2008 20:26:54 -0000
@@ -292,6 +292,11 @@
 					 * and END pairs with START, in the
 					 * same way that CLOSE_PAREN pairs with
 					 * OPEN_PAREN. */
+#define SEPARATOR	( BINARY | 29)
+#define ASSIGN		( BINARY | 30)	/* ASSIGN, like EXPON, is right
+					 * associative, and this distinction
+					 * is coded directly in ParseExpr() */
+
 /*
  * When ParseExpr() builds the parse tree it must choose which operands to
  * connect to which operators.  This is done according to operator precedence.
@@ -308,6 +313,8 @@
     PREC_CLOSE_PAREN,	/* ")" */
     PREC_OPEN_PAREN,	/* "(" */
     PREC_COMMA,		/* "," */
+    PREC_SEPARATOR,	/* ";" */
+    PREC_ASSIGN,	/* "=" */
     PREC_CONDITIONAL,	/* "?", ":" */
     PREC_OR,		/* "||" */
     PREC_AND,		/* "&&" */
@@ -365,8 +372,10 @@
     PREC_EQUAL,		/* NOT_IN_LIST */
     PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
     PREC_END,		/* END */
+    PREC_SEPARATOR,	/* SEPARATOR */
+    PREC_ASSIGN,	/* ASSIGN */
     /* Expansion room for more binary operators */
-    0,  0,  0,
+    0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  
@@ -420,8 +429,10 @@
     INST_LIST_NOT_IN,	/* NOT_IN_LIST */
     0,			/* CLOSE_PAREN */
     0,			/* END */
+    0,			/* SEPARATOR */
+    0,			/* ASSIGN */
     /* Expansion room for more binary operators */
-    0,  0,  0,
+    0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
     0,  
@@ -466,9 +477,9 @@
 	COMMA		/* , */,	MINUS		/* - */,
 	0		/* . */,	DIVIDE		/* / */,
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */
-	COLON		/* : */,	INVALID		/* ; */,
+	COLON		/* : */,	SEPARATOR	/* ; */,
 	0		/* < or << or <= */,
-	0		/* == or INVALID */,
+	0		/* = or == */,
 	0		/* > or >> or >= */,
 	QUESTION	/* ? */,	INVALID		/* @ */,
 	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,		/* A-M */
@@ -1155,6 +1166,11 @@
 			break;
 		    }
 
+		    /* Right association rules for assignment. */
+		    if (lexeme == ASSIGN) {
+			break;
+		    }
+
 		    /*
 		     * Special association rules for the conditional operators.
 		     * The "?" and ":" operators have equal precedence, but
@@ -1229,6 +1245,16 @@
 		    nodes[complete].constant = incompletePtr->constant;
 		}
 
+		/*
+		 * We declare all ASSIGN operators to be non-constant
+		 * expressions because we do not want to optimize their
+		 * variable-setting side effects out of existence.
+		 */
+
+		if (incompletePtr->lexeme == ASSIGN) {
+		    incompletePtr->constant = 0;
+		}
+
 		if (incompletePtr->lexeme == START) {
 
 		    /*
@@ -1842,7 +1868,7 @@
 	    *lexemePtr = EQUAL;
 	    return 2;
 	}
-	*lexemePtr = INCOMPLETE;
+	*lexemePtr = ASSIGN;
 	return 1;
 
     case '!':
@@ -2213,6 +2239,9 @@
 	    case OR:
 		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
 		break;
+	    case SEPARATOR:
+		TclEmitOpcode(INST_POP, envPtr);
+		break;
 	    }
 	} else {
 	    switch (nodePtr->lexeme) {
@@ -2222,7 +2251,18 @@
 		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
 		}
 		break;
+	    case ASSIGN:
+		if (convert) {
+		    /*
+		     * Make sure we assign to a variable only values that
+		     * have been numerically normalized in the expr way.
+		     */
+		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
+		}
+		TclEmitOpcode(INST_STORE_STK, envPtr);
+		break;
 	    case OPEN_PAREN:
+	    case SEPARATOR:
 
 		/* do nothing */
 		break;