* generic/tclExecute.c (TclExecuteByteCode):

        When parsing an integer operand for a unary
        minus expression operator, check for a wide
        integer that is actually LONG_MIN. If found,
        convert it back to a long int type.
	* tests/expr.test: Add constraint for 32bit
        long int type and 64bit wide int type. Add
        tests that parse the smallest/largest long int
        and wide int values.

3 files changed, 293 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index 6544b3c..592000a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2005-06-28  Mo DeJong  <mdejong@users.sourceforge.net>
+
+	* generic/tclExecute.c (TclExecuteByteCode):
+        When parsing an integer operand for a unary
+        minus expression operator, check for a wide
+        integer that is actually LONG_MIN. If found,
+        convert it back to a long int type.
+	* tests/expr.test: Add constraint for 32bit
+        long int type and 64bit wide int type. Add
+        tests that parse the smallest/largest long int
+        and wide int values.
+
 2004-06-24  Kevin Kenny  <kennykb@acm.org>
 	
 	* generic/tclEvent.c (Tcl_Finalize):
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ad06d99..06456d3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,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.192 2005/06/20 23:10:24 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.193 2005/06/29 03:29:00 mdejong Exp $
  */
 
 #include "tclInt.h"
@@ -4224,10 +4224,11 @@ TclExecuteByteCode(interp, codePtr)
 	double d;
 	int boolvar;
 	long i;
+	int negate_value = 1;
 	Tcl_WideInt w;
 	Tcl_ObjType *tPtr;
 	Tcl_Obj *valuePtr;
-	
+
 	valuePtr = *tosPtr;
 	tPtr = valuePtr->typePtr;
 	if (IS_INTEGER_TYPE(tPtr) 
@@ -4247,6 +4248,23 @@ TclExecuteByteCode(interp, codePtr)
 	    char *s = Tcl_GetStringFromObj(valuePtr, &length);
 	    if (TclLooksLikeInt(s, length)) {
 		GET_WIDE_OR_INT(result, valuePtr, i, w);
+
+		/*
+		 * An integer was parsed. If parsing a literal that
+		 * is the smallest long value, then it would have
+		 * been promoted to a wide since it would not fit in
+		 * a long type without the leading '-'. Convert
+		 * back to the smallest possible long.
+		 */
+
+		if ((result == TCL_OK) &&
+		        (*pc == INST_UMINUS) &&
+		        (valuePtr->typePtr == &tclWideIntType) &&
+		        (w == -Tcl_LongAsWide(LONG_MIN))) {
+		    valuePtr->typePtr = &tclIntType;
+		    valuePtr->internalRep.longValue = LONG_MIN;
+		    negate_value = 0;
+		}
 	    } else {
 		result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
 	    }
@@ -4270,11 +4288,14 @@ TclExecuteByteCode(interp, codePtr)
 		 */
 		if (tPtr == &tclIntType) {
 		    i = valuePtr->internalRep.longValue;
-		    TclNewLongObj(objResultPtr, -i);
+		    if (negate_value) {
+		        i = -i;
+		    }
+		    TclNewLongObj(objResultPtr, i);
 			TRACE_WITH_OBJ(("%ld => ", i), objResultPtr);
 		} else if (tPtr == &tclWideIntType) {
 		    TclGetWide(w,valuePtr);
-		    TclNewWideIntObj(objResultPtr, -w);		
+		    TclNewWideIntObj(objResultPtr, -w);
 		    TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
 		} else {
 		    d = valuePtr->internalRep.doubleValue;
@@ -4288,7 +4309,10 @@ TclExecuteByteCode(interp, codePtr)
 		 */
 		if (tPtr == &tclIntType) {
 		    i = valuePtr->internalRep.longValue;
-		    TclSetLongObj(valuePtr, -i);
+		    if (negate_value) {
+		        i = -i;
+		    }
+		    TclSetLongObj(valuePtr, i);
 		    TRACE_WITH_OBJ(("%ld => ", i), valuePtr);
 		} else if (tPtr == &tclWideIntType) {
 		    TclGetWide(w,valuePtr);
diff --git a/tests/expr.test b/tests/expr.test
index 067ad20..a7ea152 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: expr.test,v 1.33 2005/05/25 16:13:17 dgp Exp $
+# RCS: @(#) $Id: expr.test,v 1.34 2005/06/29 03:29:02 mdejong Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -21,6 +21,12 @@ testConstraint testmathfunctions [expr {
     ([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"})
 }]
 
+# Determine if "long int" type is a 32 bit number and if the wide
+# type is a 64 bit number on this machine.
+
+testConstraint longis32bit [expr {(0x7FFFFFFF + 1) eq (0 - 0x80000000)}]
+testConstraint wideis64bit [expr {" 0x8000000000000000 " == "0x8000000000000000"}]
+
 # procedures used below
 
 proc put_hello_char {c} {
@@ -251,6 +257,15 @@ test expr-4.9 {CompileLorExpr: long lor arm} {
     set i 7
     expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
 } 1
+test expr-4.10 {CompileLorExpr: error compiling ! operand} {
+    list [catch {expr {!"a"}} msg] $msg
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-4.11 {CompileLorExpr: error compiling land arms} {
+    list [catch {expr {"a"||0}} msg] $msg
+} {1 {expected boolean value but got "a"}}
+test expr-4.12 {CompileLorExpr: error compiling land arms} {
+    list [catch {expr {0||"a"}} msg] $msg
+} {1 {expected boolean value but got "a"}}
 
 test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
 test expr-5.2 {CompileLandExpr: error in bitor expr} -body {
@@ -380,6 +395,46 @@ test expr-8.23 {CompileBitAndExpr: error in equality expr} {
     catch {expr {false nefalse}} msg
     set msg
 } {syntax error in expression "false nefalse": extra tokens at end of expression}
+test expr-8.24 {CompileEqualityExpr: simple equality exprs} {
+    set x 12398712938788234
+    expr {$x == 100}
+} 0
+test expr-8.25 {CompileEqualityExpr: simple equality exprs} {
+    expr {"0x12 " == "0x12"}
+} 1
+test expr-8.26 {CompileEqualityExpr: simple equality exprs} {
+    expr {"0x12 " eq "0x12"}
+} 0
+test expr-8.27 {CompileEqualityExpr: simple equality exprs} {
+    expr {"1.0e100000000" == "0.0"}
+} 0
+test expr-8.28 {CompileEqualityExpr: just relational expr} {
+    expr {"0y" == "0x0"}
+} 0
+test expr-8.29 {CompileEqualityExpr: just relational expr} {
+    # Compare original strings from variables.
+    set v1 "0y"
+    set v2 "0x12"
+    expr {$v1 < $v2}
+} 0
+test expr-8.30 {CompileEqualityExpr: simple equality exprs} {
+    expr {"fake" != "bob"}
+} 1
+test expr-8.31 {expr edge cases} {
+    list [catch {expr {1e}} err] $err
+} {1 {syntax error in expression "1e": extra tokens at end of expression}}
+test expr-8.32 {expr edge cases} {
+    list [catch {expr {1E}} err] $err
+} {1 {syntax error in expression "1E": extra tokens at end of expression}}
+test expr-8.33 {expr edge cases} {
+    list [catch {expr {1e+}} err] $err
+} {1 {syntax error in expression "1e+": extra tokens at end of expression}}
+test expr-8.34 {expr edge cases} {
+    list [catch {expr {1E+}} err] $err
+} {1 {syntax error in expression "1E+": extra tokens at end of expression}}
+test expr-8.35 {expr edge cases} {
+    list [catch {expr {1ea}} err] $err
+} {1 {syntax error in expression "1ea": extra tokens at end of expression}}
 
 test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
@@ -839,6 +894,44 @@ test expr-21.9 	{non-numeric boolean literals} {expr !off  } 1
 test expr-21.10 {non-numeric boolean literals} {expr !on   } 0
 test expr-21.11 {non-numeric boolean literals} {expr !no   } 1
 test expr-21.12 {non-numeric boolean literals} {expr !yes  } 0
+test expr-21.13 {non-numeric boolean literals} {
+    list [catch {expr !truef} err] $err
+} {1 {syntax error in expression "!truef": the word "truef" requires a preceding $ if it's a variable or function arguments if it's a function}}
+test expr-21.14 {non-numeric boolean literals} {
+    list [catch {expr !"truef"} err] $err
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-21.15 {non-numeric boolean variables} {
+    set v truef
+    list [catch {expr {!$v}} err] $err
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-21.16 {non-numeric boolean variables} {
+    set v "true "
+    list [catch {expr {!$v}} err] $err
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-21.17 {non-numeric boolean variables} {
+    set v "tru"
+    list [catch {expr {!$v}} err] $err
+} {0 0}
+test expr-21.18 {non-numeric boolean variables} {
+    set v "fal"
+    list [catch {expr {!$v}} err] $err
+} {0 1}
+test expr-21.19 {non-numeric boolean variables} {
+    set v "y"
+    list [catch {expr {!$v}} err] $err
+} {0 0}
+test expr-21.20 {non-numeric boolean variables} {
+    set v "of"
+    list [catch {expr {!$v}} err] $err
+} {0 1}
+test expr-21.21 {non-numeric boolean variables} {
+    set v "o"
+    list [catch {expr {!$v}} err] $err
+} {1 {can't use non-numeric string as operand of "!"}}
+test expr-21.22 {non-numeric boolean variables} {
+    set v ""
+    list [catch {expr {!$v}} err] $err
+} {1 {can't use empty string as operand of "!"}}
 
 # Test for non-numeric float handling.
 #
@@ -5244,6 +5337,164 @@ test expr-31.15 {boolean conversion} -body {
     expr bool("fred")
 } -returnCodes error -match glob -result *
 
+
+test expr-32.1 {expr mod basics} {
+    set mod_nums [list \
+        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
+        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
+        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \
+        {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \
+        {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \
+        {-1 -1} {-1 -2} {-1 -3} {-1 -4} {-1 -5} \
+        {0 -100} {0 -1} {0 1} {0 100} \
+        {1 1} {1 2} {1 3} {1 4} {1 5} \
+        {1 -1} {1 -2} {1 -3} {1 -4} {1 -5} \
+        {2 1} {2 2} {2 3} {2 4} {2 5} \
+        {2 -1} {2 -2} {2 -3} {2 -4} {2 -5} \
+        {3 1} {3 2} {3 3} {3 4} {3 5} \
+        {3 -1} {3 -2} {3 -3} {3 -4} {3 -5} \
+        ]
+    set results [list]
+    foreach pair $mod_nums {
+        set dividend [lindex $pair 0]
+        set divisor [lindex $pair 1]
+        lappend results [expr {$dividend % $divisor}]
+    }
+    set results
+} [list \
+    0 1 0 1 2 \
+    0 -1 0 -3 -3 \
+    0 0 1 2 3 \
+    0 0 -2 -2 -2 \
+    0 1 2 3 4 \
+    0 -1 -1 -1 -1 \
+    0 0 0 0 \
+    0 1 1 1 1 \
+    0 -1 -2 -3 -4 \
+    0 0 2 2 2 \
+    0 0 -1 -2 -3 \
+    0 1 0 3 3 \
+    0 -1 0 -1 -2 \
+    ]
+        
+test expr-32.2 {expr div basics} {
+    set mod_nums [list \
+        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
+        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
+        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \
+        {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \
+        {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \
+        {-1 -1} {-1 -2} {-1 -3} {-1 -4} {-1 -5} \
+        {0 -100} {0 -1} {0 1} {0 100} \
+        {1 1} {1 2} {1 3} {1 4} {1 5} \
+        {1 -1} {1 -2} {1 -3} {1 -4} {1 -5} \
+        {2 1} {2 2} {2 3} {2 4} {2 5} \
+        {2 -1} {2 -2} {2 -3} {2 -4} {2 -5} \
+        {3 1} {3 2} {3 3} {3 4} {3 5} \
+        {3 -1} {3 -2} {3 -3} {3 -4} {3 -5} \
+        ]
+    set results [list]
+    foreach pair $mod_nums {
+        set dividend [lindex $pair 0]
+        set divisor [lindex $pair 1]
+        lappend results [expr {$dividend / $divisor}]
+    }
+    set results
+} [list \
+    -3 -2 -1 -1 -1 \
+    3 1 1 0 0 \
+    -2 -1 -1 -1 -1 \
+    2 1 0 0 0 \
+    -1 -1 -1 -1 -1 \
+    1 0 0 0 0 \
+    0 0 0 0 \
+    1 0 0 0 0 \
+    -1 -1 -1 -1 -1 \
+    2 1 0 0 0 \
+    -2 -1 -1 -1 -1 \
+    3 1 1 0 0 \
+    -3 -2 -1 -1 -1 \
+    ]
+
+test expr-33.1 {parse largest long value} {longis32bit} {
+    set max_long_str 2147483647
+    set max_long_hex "0x7FFFFFFF "
+
+    # Convert to integer (long, not wide) internal rep
+    set max_long 2147483647
+    string is integer $max_long
+
+    list \
+        [expr {" $max_long_str "}] \
+        [expr {$max_long_str + 0}] \
+        [expr {$max_long + 0}] \
+        [expr {2147483647 + 0}] \
+        [expr {$max_long == $max_long_hex}] \
+        [expr {(2147483647 + 1) < 0}] \
+
+} {2147483647 2147483647 2147483647 2147483647 1 1}
+
+test expr-33.2 {parse smallest long value} {longis32bit} {
+    set min_long_str -2147483648
+    set min_long_hex "-0x80000000 "
+
+    set min_long -2147483648
+    # This will convert to integer (not wide) internal rep
+    string is integer $min_long
+
+    # Note: If the final expression returns 0 then the
+    # expression literal is being promoted to a wide type
+    # when it should be parsed as a long type.
+    list \
+        [expr {" $min_long_str "}] \
+        [expr {$min_long_str + 0}] \
+        [expr {$min_long + 0}] \
+        [expr {-2147483648 + 0}] \
+        [expr {$min_long == $min_long_hex}] \
+        [expr {(-2147483648 - 1) == 0x7FFFFFFF}] \
+
+} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
+
+test expr-33.3 {parse largest wide value} {wideis64bit} {
+    set max_wide_str 9223372036854775807
+    set max_wide_hex "0x7FFFFFFFFFFFFFFF "
+
+    # Convert to wide integer
+    set max_wide 9223372036854775807
+    string is integer $max_wide
+
+    list \
+        [expr {" $max_wide_str "}] \
+        [expr {$max_wide_str + 0}] \
+        [expr {$max_wide + 0}] \
+        [expr {9223372036854775807 + 0}] \
+        [expr {$max_wide == $max_wide_hex}] \
+        [expr {(9223372036854775807 + 1) < 0}] \
+
+} {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1}
+
+test expr-33.4 {parse smallest wide value} {wideis64bit} {
+    set min_wide_str -9223372036854775808
+    set min_wide_hex "-0x8000000000000000 "
+
+    set min_wide -9223372036854775808
+    # Convert to wide integer
+    string is integer $min_wide
+
+    # Note: If the final expression returns 0 then the
+    # wide integer is not being parsed correctly with
+    # the leading - sign.
+    list \
+        [expr {" $min_wide_str "}] \
+        [expr {$min_wide_str + 0}] \
+        [expr {$min_wide + 0}] \
+        [expr {-9223372036854775808 + 0}] \
+        [expr {$min_wide == $min_wide_hex}] \
+        [expr {(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \
+
+} {-9223372036854775808 -9223372036854775808 -9223372036854775808 -9223372036854775808 1 1}
+
+
 # cleanup
 if {[info exists a]} {
     unset a