Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.2696
retrieving revision 1.2697
diff -u -r1.2696 -r1.2697
--- ChangeLog 24 Jun 2005 20:07:08 -0000 1.2696
+++ ChangeLog 29 Jun 2005 03:28:56 -0000 1.2697
@@ -1,3 +1,15 @@
+2005-06-28 Mo DeJong <[email protected]>
+
+ * 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 <[email protected]>
* generic/tclEvent.c (Tcl_Finalize):
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.192
retrieving revision 1.193
diff -u -r1.192 -r1.193
--- generic/tclExecute.c 20 Jun 2005 23:10:24 -0000 1.192
+++ generic/tclExecute.c 29 Jun 2005 03:29:00 -0000 1.193
@@ -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 @@
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 @@
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 @@
*/
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 @@
*/
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);
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- tests/expr.test 25 May 2005 16:13:17 -0000 1.33
+++ tests/expr.test 29 Jun 2005 03:29:02 -0000 1.34
@@ -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 @@
([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 @@
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 @@
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.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 @@
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
