* generic/tclCompCmds.c: Additional commits correct most

        * generic/tclExecute.c: failing tests illustrating bugs uncovered
        * generic/tclMathOp.c:  in [Path 1578137].

3 files changed, 79 insertions, 11 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5954394..464f7d2 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -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: tclCompCmds.c,v 1.96 2006/12/07 15:02:45 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.97 2006/12/07 23:35:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -4658,6 +4658,13 @@ CompileAssociativeBinaryOpCmd(
 	PushLiteral(envPtr, identity, -1);
 	return TCL_OK;
     }
+    if (parsePtr->numWords == 2) {
+	/*
+	 * TODO: Fixup the single argument case to require
+	 * numeric argument.  Fallback on direct eval until fixed
+	 */
+	return TCL_ERROR;
+    }
     for (words=1 ; words<parsePtr->numWords ; words++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, words);
@@ -4968,6 +4975,12 @@ TclCompileDivOpCmd(
 	CompileWord(envPtr, tokenPtr, interp,1);
 	TclEmitOpcode(INST_DIV, envPtr);
 	return TCL_OK;
+    } else {
+	/*
+	 * TODO: get compiled version that passes mathop-6.18
+	 * For now, fallback to direct evaluation.
+	 */
+	return TCL_ERROR;
     }
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     CompileWord(envPtr, tokenPtr, interp,1);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0e3368d..86e1db2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.256 2006/12/01 14:31:19 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.257 2006/12/07 23:35:29 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3942,8 +3942,13 @@ TclExecuteByteCode(
 
 	if (*pc == INST_LSHIFT) {
 	    /* Large left shifts create integer overflow */
-	    result = Tcl_GetIntFromObj(NULL, value2Ptr, &shift);
-	    if (result != TCL_OK) {
+	    /* BEWARE!  Can't use Tcl_GetIntFromObj() here because
+	     * that converts values in the (unsigned int) range to
+	     * their signed int counterparts, leading to incorrect
+	     * results.
+	     */
+	    if ((type2 != TCL_NUMBER_LONG)
+		    || (*((CONST long *)ptr2) > (long) INT_MAX)) {
 		/*
 		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
 		 * an mp_int, but since we're using mp_mul_2d() to do the
@@ -3953,8 +3958,12 @@ TclExecuteByteCode(
 
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"integer value too large to represent", -1));
+		result = TCL_ERROR;
 		goto checkForCatch;
 	    }
+	    shift = (int)(*((CONST long *)ptr2));
+
+
 	    /* Handle shifts within the native long range */
 	    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
 	    if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long))
@@ -4786,6 +4795,7 @@ TclExecuteByteCode(
 	    if (type2 == TCL_NUMBER_BIG) {
 		Tcl_SetObjResult(interp,
 			Tcl_NewStringObj("exponent too large", -1));
+		result = TCL_ERROR;
 		goto checkForCatch;
 	    }
 	    /* TODO: Perform those computations that fit in native types */
@@ -4806,7 +4816,7 @@ TclExecuteByteCode(
 #endif
 		{
 		    /* Check for overflow */
-		    if (((w1 < 0) && (w2 < 0) && (wResult > 0))
+		    if (((w1 < 0) && (w2 < 0) && (wResult >= 0))
 			    || ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
 			goto overflow;
 		    }
@@ -4821,7 +4831,7 @@ TclExecuteByteCode(
 		{
 		    /* Must check for overflow */
 		    if (((w1 < 0) && (w2 > 0) && (wResult > 0))
-			    || ((w1 > 0) && (w2 < 0) && (wResult < 0))) {
+			    || ((w1 >= 0) && (w2 < 0) && (wResult < 0))) {
 			goto overflow;
 		    }
 		}
@@ -4906,6 +4916,7 @@ TclExecuteByteCode(
 			    Tcl_NewStringObj("exponent too large", -1));
 		    mp_clear(&big1);
 		    mp_clear(&big2);
+		    result = TCL_ERROR;
 		    goto checkForCatch;
 		}
 		mp_expt_d(&big1, big2.dp[0], &bigResult);
diff --git a/generic/tclMathOp.c b/generic/tclMathOp.c
index 375a546..ed28123 100644
--- a/generic/tclMathOp.c
+++ b/generic/tclMathOp.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclMathOp.c,v 1.3 2006/12/07 15:02:46 dkf Exp $
+ * RCS: @(#) $Id: tclMathOp.c,v 1.4 2006/12/07 23:35:30 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -316,7 +316,7 @@ CombineIntFloat(
 #endif
 	    {
 		/* Check for overflow */
-		if (((w1 < 0) && (w2 < 0) && (wResult > 0))
+		if (((w1 < 0) && (w2 < 0) && (wResult >= 0))
 			|| ((w1 > 0) && (w2 > 0) && (wResult < 0))) {
 		    goto overflow;
 		}
@@ -331,7 +331,7 @@ CombineIntFloat(
 	    {
 		/* Must check for overflow */
 		if (((w1 < 0) && (w2 > 0) && (wResult > 0))
-			|| ((w1 > 0) && (w2 < 0) && (wResult < 0))) {
+			|| ((w1 >= 0) && (w2 < 0) && (wResult < 0))) {
 		    goto overflow;
 		}
 	    }
@@ -1172,6 +1172,13 @@ TclAddOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"+\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1238,6 +1245,13 @@ TclMulOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"*\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1304,6 +1318,13 @@ TclAndOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), -1);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"&\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1370,6 +1391,13 @@ TclOrOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"|\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1436,6 +1464,13 @@ TclXorOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"^\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1502,6 +1537,13 @@ TclPowOpCmd(
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
 	return TCL_OK;
     } else if (objc == 2) {
+	ClientData ptr1;
+	int type1;
+	if (TclGetNumberFromObj(NULL, objv[1], &ptr1, &type1) != TCL_OK) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "can't use non-numeric string as operand of \"**\"",-1));
+	    return TCL_ERROR;
+	}
 	Tcl_SetObjResult(interp, objv[1]);
 	return TCL_OK;
     } else if (objc == 3) {
@@ -1776,7 +1818,8 @@ TclLshiftOpCmd(
     }
 
     /* Large left shifts create integer overflow */
-    if (Tcl_GetIntFromObj(NULL, objv[2], &shift) != TCL_OK) {
+    if ((type2 != TCL_NUMBER_LONG)
+	    || (*((const long *)ptr2) > (long) INT_MAX)) {
 	/*
 	 * Technically, we could hold the value (1 << (INT_MAX+1)) in an
 	 * mp_int, but since we're using mp_mul_2d() to do the work, and it
@@ -1787,6 +1830,7 @@ TclLshiftOpCmd(
 		"integer value too large to represent", -1));
 	return TCL_ERROR;
     }
+    shift = (int)(*((const long *)ptr2));
 
     /* Handle shifts within the native long range */
     if ((type1 == TCL_NUMBER_LONG) && ((size_t)shift < CHAR_BIT*sizeof(long))
@@ -2283,7 +2327,7 @@ TclNeqOpCmd(
 	/*
 	 * Got proper numbers
 	 */
-	if (cmp != MP_EQ) {
+	if (cmp == MP_EQ) {
 	    result = 0;
 	}
     }