diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBinary.c | 40 | ||||
| -rw-r--r-- | tests/binary.test | 10 |
3 files changed, 35 insertions, 21 deletions
@@ -1,3 +1,9 @@ +2003-02-21 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * tests/binary.test (binary-44.[34]): + * generic/tclBinary.c (ScanNumber): Fixed problem with unwanted + sign-bit propagation when scanning wide ints. [Bug #690774] + 2003-02-21 Daniel Steffen <das@users.sourceforge.net> * mac/tclMacChan.c (TclpCutFileChannel, TclpSpliceFileChannel): diff --git a/generic/tclBinary.c b/generic/tclBinary.c index c8ff568..4dfb505 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -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: tclBinary.c,v 1.12 2002/02/15 14:28:48 dkf Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.13 2003/02/21 21:54:11 dkf Exp $ */ #include "tclInt.h" @@ -1588,7 +1588,7 @@ ScanNumber(buffer, type, numberCachePtrPtr) * different numbers have been scanned. */ { long value; - Tcl_WideInt wvalue; + Tcl_WideUInt uwvalue; /* * We cannot rely on the compiler to properly sign extend integer values @@ -1678,25 +1678,25 @@ ScanNumber(buffer, type, numberCachePtrPtr) } } case 'w': - value = (long) (buffer[4] - | (buffer[5] << 8) - | (buffer[6] << 16) - | (buffer[7] << 24)); - wvalue = ((Tcl_WideInt) value) << 32 | (buffer[0] - | (buffer[1] << 8) - | (buffer[2] << 16) - | (buffer[3] << 24)); - return Tcl_NewWideIntObj(wvalue); + uwvalue = ((Tcl_WideUInt) buffer[0]) + | (((Tcl_WideUInt) buffer[1]) << 8) + | (((Tcl_WideUInt) buffer[2]) << 16) + | (((Tcl_WideUInt) buffer[3]) << 24) + | (((Tcl_WideUInt) buffer[4]) << 32) + | (((Tcl_WideUInt) buffer[5]) << 40) + | (((Tcl_WideUInt) buffer[6]) << 48) + | (((Tcl_WideUInt) buffer[7]) << 56); + return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); case 'W': - value = (long) (buffer[3] - | (buffer[2] << 8) - | (buffer[1] << 16) - | (buffer[0] << 24)); - wvalue = ((Tcl_WideInt) value) << 32 | (buffer[7] - | (buffer[6] << 8) - | (buffer[5] << 16) - | (buffer[4] << 24)); - return Tcl_NewWideIntObj(wvalue); + uwvalue = ((Tcl_WideUInt) buffer[7]) + | (((Tcl_WideUInt) buffer[6]) << 8) + | (((Tcl_WideUInt) buffer[5]) << 16) + | (((Tcl_WideUInt) buffer[4]) << 24) + | (((Tcl_WideUInt) buffer[3]) << 32) + | (((Tcl_WideUInt) buffer[2]) << 40) + | (((Tcl_WideUInt) buffer[1]) << 48) + | (((Tcl_WideUInt) buffer[0]) << 56); + return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); case 'f': { float fvalue; memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float)); diff --git a/tests/binary.test b/tests/binary.test index 7fd6871..967fcbc 100644 --- a/tests/binary.test +++ b/tests/binary.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: binary.test,v 1.10 2002/10/03 13:34:32 dkf Exp $ +# RCS: @(#) $Id: binary.test,v 1.11 2003/02/21 21:54:11 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1476,6 +1476,14 @@ test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} { binary scan lcTolleH w x set x } 5216694956358656876 +test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { + binary scan [binary format w [expr {wide(3) << 31}]] w x + set x +} 6442450944 +test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { + binary scan [binary format W [expr {wide(3) << 31}]] W x + set x +} 6442450944 test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} { binary scan [binary format sws 16450 -1 19521] c* x |