summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBinary.c40
-rw-r--r--tests/binary.test10
3 files changed, 35 insertions, 21 deletions
diff --git a/ChangeLog b/ChangeLog
index 4d63e28..868aece 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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