diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclExecute.c | 21 | ||||
| -rw-r--r-- | tests/expr.test | 6 |
3 files changed, 24 insertions, 8 deletions
@@ -1,3 +1,8 @@ +2007-08-08 Don Porter <dgp@users.sourceforge.net> + + * generic/tclExecute.c: Corrected improper use of bignum arguments + * tests/expr.test: to *SHIFT operations. [Bug 1770224]. + 2007-08-07 Miguel Sofer <msofer@users.sf.net> * generic/tclInt.h: remove comments refering to VAR_SCALAR, as diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 38480a2..b710e17 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.309 2007/08/05 02:46:09 das Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.310 2007/08/08 20:25:04 dgp Exp $ */ #include "tclInt.h" @@ -4506,10 +4506,14 @@ TclExecuteByteCode( invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0); break; #endif - case TCL_NUMBER_BIG: - /* TODO: const correctness? */ - invalid = (mp_cmp_d((mp_int *)ptr2, 0) == MP_LT); + case TCL_NUMBER_BIG: { + mp_int big2; + + Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); + invalid = (mp_cmp_d(&big2, 0) == MP_LT); + mp_clear(&big2); break; + } default: /* Unused, here to silence compiler warning */ invalid = 0; @@ -4617,10 +4621,13 @@ TclExecuteByteCode( zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0); break; #endif - case TCL_NUMBER_BIG: - /* TODO: const correctness ? */ - zero = (mp_cmp_d((mp_int *)ptr1, 0) == MP_GT); + case TCL_NUMBER_BIG: { + mp_int big1; + Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); + zero = (mp_cmp_d(&big1, 0) == MP_GT); + mp_clear(&big1); break; + } default: /* Unused, here to silence compiler warning. */ zero = 0; diff --git a/tests/expr.test b/tests/expr.test index daab2f4..f73c613 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.67 2006/12/06 16:37:00 kennykb Exp $ +# RCS: @(#) $Id: expr.test,v 1.68 2007/08/08 20:25:05 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -6658,6 +6658,10 @@ test expr-47.12 {isqrt of various sizes of integer} { set trouble } {} +test expr-48.1 {Bug 1770224} { + expr {-0x8000000000000001 >> 0x8000000000000000} +} -1 + # cleanup if {[info exists a]} { unset a |