TIP #275: Support unsigned values in binary command

4 files changed, 238 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index 3c1bb71..2f4c9d9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2006-10-06  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* doc/binary.n:        TIP #275: Support unsigned values in
+	* generic/tclBinary.c: binary command. Tests and documentation
+	* tests/binary.test:   updated.
+
 2006-10-05  Andreas Kupries  <andreask@activestate.com>
 
 	* library/tm.tcl: Fixed bug in TIP #189 implementation, now
diff --git a/doc/binary.n b/doc/binary.n
index 1944749..4cac04d 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -4,7 +4,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.n,v 1.28 2005/12/16 11:12:31 dkf Exp $
+'\" RCS: @(#) $Id: binary.n,v 1.29 2006/10/06 13:37:20 patthoyts Exp $
 '\" 
 .so man.macros
 .TH binary n 8.0 Tcl "Tcl Built-In Commands"
@@ -35,7 +35,8 @@ the additional arguments.  The resulting binary value is returned.
 .PP
 The \fIformatString\fR consists of a sequence of zero or more field
 specifiers separated by zero or more spaces.  Each field specifier is
-a single type character followed by an optional numeric \fIcount\fR.
+a single type character followed by an optional flag character followed
+by an optional numeric \fIcount\fR.
 Most field specifiers consume one argument to obtain the value to be
 formatted.  The type character specifies how the value is to be
 formatted.  The \fIcount\fR typically indicates how many items of the
@@ -43,7 +44,8 @@ specified type are taken from the value.  If present, the \fIcount\fR
 is a non-negative decimal integer or \fB*\fR, which normally indicates
 that all of the items in the value are to be used.  If the number of
 arguments does not match the number of fields in the format string
-that consume arguments, then an error is generated.
+that consume arguments, then an error is generated. The flag character
+is ignored for for \fBbinary format\fR.
 .PP
 Here is a small example to clarify the relation between the field
 specifiers and the arguments:
@@ -380,7 +382,8 @@ variable.
 As with \fBbinary format\fR, the \fIformatString\fR consists of a
 sequence of zero or more field specifiers separated by zero or more
 spaces.  Each field specifier is a single type character followed by
-an optional numeric \fIcount\fR.  Most field specifiers consume one
+an optional flag character followed by an optional numeric \fIcount\fR.
+Most field specifiers consume one
 argument to obtain the variable into which the scanned values should
 be placed.  The type character specifies how the binary data is to be
 interpreted.  The \fIcount\fR typically indicates how many items of
@@ -392,7 +395,9 @@ position to satisfy the current field specifier, then the
 corresponding variable is left untouched and \fBbinary scan\fR returns
 immediately with the number of variables that were set.  If there are
 not enough arguments for all of the fields in the format string that
-consume arguments, then an error is generated.
+consume arguments, then an error is generated. The flag character 'u'
+may be given to cause some types to be read as unsigned values. The flag
+is accepted for all field types but is ignored for non-integer fields.
 .PP
 A similar example as with \fBbinary format\fR should explain the
 relation between field specifiers and arguments in case of the binary
@@ -429,11 +434,11 @@ will be sign extended.  Thus the following will occur:
 set signShort [\fBbinary format\fR s1 0x8000]
 \fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
 .CE
-If you want to produce an unsigned value, then you can mask the return 
-value to the desired size.  For example, to produce an unsigned short 
-value:
+If you require unsigned values you can include the 'u' flag character following
+the field type. For example, to read an unsigned short value:
 .CS
-set val [expr { $val & 0xFFFF }]; \fI# val == 0x8000\fR
+set signShort [\fBbinary format\fR s1 0x8000]
+\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
 .CE
 .PP
 Each type-count pair moves an imaginary cursor through the binary data,
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 1d7a48d..9b7e53e 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -10,10 +10,11 @@
  * 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.29 2006/08/10 12:15:30 dkf Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.30 2006/10/06 13:37:21 patthoyts Exp $
  */
 
 #include "tclInt.h"
+#include "tclTomMath.h"
 
 #include <math.h>
 
@@ -26,6 +27,13 @@
 #define BINARY_NOCOUNT -2	/* No count was specified in format. */
 
 /*
+ * The following flags may be ORed together and returned by GetFormatSpec
+ */
+
+#define BINARY_SIGNED 0		/* Field to be read as signed data */
+#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */
+
+/*
  * The following defines the maximum number of different (integer) numbers
  * placed in the object cache by 'binary scan' before it bails out and
  * switches back to Plan A (creating a new object for each value.)
@@ -54,9 +62,9 @@ static int		FormatNumber(Tcl_Interp *interp, int type,
 			    Tcl_Obj *src, unsigned char **cursorPtr);
 static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
 static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
-			    int *countPtr);
+			    int *countPtr, int *flagsPtr);
 static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
-			    Tcl_HashTable **numberCachePtr);
+			    int flags, Tcl_HashTable **numberCachePtr);
 static int		SetByteArrayFromAny(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
@@ -563,6 +571,7 @@ Tcl_BinaryObjCmd(
     char cmd;			/* Current format character. */
     int count;			/* Count associated with current format
 				 * character. */
+    int flags;			/* Format field flags */
     char *format;		/* Pointer to current position in format
 				 * string. */
     Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
@@ -608,7 +617,8 @@ Tcl_BinaryObjCmd(
 	length = 0;
 	while (*format != '\0') {
 	    str = format;
-	    if (!GetFormatSpec(&format, &cmd, &count)) {
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
 		break;
 	    }
 	    switch (cmd) {
@@ -770,7 +780,8 @@ Tcl_BinaryObjCmd(
 	cursor = buffer;
 	maxPos = cursor;
 	while (*format != 0) {
-	    if (!GetFormatSpec(&format, &cmd, &count)) {
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
 		break;
 	    }
 	    if ((count == 0) && (cmd != '@')) {
@@ -1028,7 +1039,8 @@ Tcl_BinaryObjCmd(
 	offset = 0;
 	while (*format != '\0') {
 	    str = format;
-	    if (!GetFormatSpec(&format, &cmd, &count)) {
+	    flags = 0;
+	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
 		goto done;
 	    }
 	    switch (cmd) {
@@ -1240,7 +1252,7 @@ Tcl_BinaryObjCmd(
 		    if ((length - offset) < size) {
 			goto done;
 		    }
-		    valuePtr = ScanNumber(buffer+offset, cmd, &numberCachePtr);
+		    valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr);
 		    offset += size;
 		} else {
 		    if (count == BINARY_ALL) {
@@ -1252,7 +1264,7 @@ Tcl_BinaryObjCmd(
 		    valuePtr = Tcl_NewObj();
 		    src = buffer+offset;
 		    for (i = 0; i < count; i++) {
-			elementPtr = ScanNumber(src, cmd, &numberCachePtr);
+			elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr);
 			src += size;
 			Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
 		    }
@@ -1373,7 +1385,8 @@ static int
 GetFormatSpec(
     char **formatPtr,		/* Pointer to format string. */
     char *cmdPtr,		/* Pointer to location of command char. */
-    int *countPtr)		/* Pointer to repeat count value. */
+    int *countPtr,		/* Pointer to repeat count value. */
+    int *flagsPtr)		/* Pointer to field flags */
 {
     /*
      * Skip any leading blanks.
@@ -1397,6 +1410,10 @@ GetFormatSpec(
 
     *cmdPtr = **formatPtr;
     (*formatPtr)++;
+    if (**formatPtr == 'u') {
+	(*formatPtr)++;
+	(*flagsPtr) |= BINARY_UNSIGNED;
+    }
     if (**formatPtr == '*') {
 	(*formatPtr)++;
 	(*countPtr) = BINARY_ALL;
@@ -1778,6 +1795,7 @@ static Tcl_Obj *
 ScanNumber(
     unsigned char *buffer,	/* Buffer to scan number from. */
     int type,			/* Format character from "binary scan" */
+    int flags,			/* Format field flags */
     Tcl_HashTable **numberCachePtrPtr)
 				/* Place to look for cache of scanned
 				 * value objects, or NULL if too many
@@ -1794,6 +1812,7 @@ ScanNumber(
      * the exact size of the integer types. So, we have to handle sign
      * extension explicitly by checking the high bit and padding with 1's as
      * needed.
+     * This practice is disabled if the BINARY_UNSIGNED flag is set.
      */
 
     switch (type) {
@@ -1806,8 +1825,10 @@ ScanNumber(
 	 */
 
 	value = buffer[0];
-	if (value & 0x80) {
-	    value |= -0x100;
+	if (!(flags & BINARY_UNSIGNED)) {
+	    if (value & 0x80) {
+		value |= -0x100;
+	    }
 	}
 	goto returnNumericObject;
 
@@ -1824,8 +1845,10 @@ ScanNumber(
 	} else {
 	    value = (long) (buffer[1] + (buffer[0] << 8));
 	}
-	if (value & 0x8000) {
-	    value |= -0x10000;
+	if (!(flags & BINARY_UNSIGNED)) {
+	    if (value & 0x8000) {
+		value |= -0x10000;
+	    }
 	}
 	goto returnNumericObject;
 
@@ -1840,22 +1863,28 @@ ScanNumber(
 	    value = (long) (buffer[0]
 		    + (buffer[1] << 8)
 		    + (buffer[2] << 16)
-		    + (buffer[3] << 24));
+		    + (((long)buffer[3]) << 24));
 	} else {
 	    value = (long) (buffer[3]
 		    + (buffer[2] << 8)
 		    + (buffer[1] << 16)
-		    + (buffer[0] << 24));
+		    + (((long)buffer[0]) << 24));
 	}
 
 	/*
 	 * Check to see if the value was sign extended properly on systems
 	 * where an int is more than 32-bits.
+	 * We avoid caching unsigned integers as we cannot distinguish between
+	 * 32bit signed and unsigned in the hash (short and char are ok).
 	 */
 
-	if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
-	    value -= (((unsigned int)1)<<31);
-	    value -= (((unsigned int)1)<<31);
+	if ((flags & BINARY_UNSIGNED)) {
+	    return Tcl_NewWideIntObj((unsigned long)value);
+	} else {
+	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+		value -= (((unsigned int)1)<<31);
+		value -= (((unsigned int)1)<<31);
+	    }
 	}
 
     returnNumericObject:
@@ -1920,7 +1949,16 @@ ScanNumber(
 		    | (((Tcl_WideUInt) buffer[1]) << 48)
 		    | (((Tcl_WideUInt) buffer[0]) << 56);
 	}
-	return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+	if (flags & BINARY_UNSIGNED) {
+	    Tcl_Obj *bigObj = NULL;
+	    mp_int big;
+
+	    TclBNInitBignumFromWideUInt(&big, uwvalue);
+	    bigObj = Tcl_NewBignumObj(&big);
+	    return bigObj;
+	} else {
+	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+	}
 
 	/*
 	 * Do not cache double values; they are already too large to use as
diff --git a/tests/binary.test b/tests/binary.test
index a16cede..9395140 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.28 2006/04/05 15:17:39 dgp Exp $
+# RCS: @(#) $Id: binary.test,v 1.29 2006/10/06 13:37:21 patthoyts Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -905,6 +905,30 @@ test binary-26.10 {Tcl_BinaryObjCmd: scan} {
     set arg2 bar
     list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
 } {2 {112 -121} 5}
+test binary-26.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 cu* arg1] $arg1
+} {1 {82 163}}
+test binary-26.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 cu arg1] $arg1
+} {1 82}
+test binary-26.13 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xff cu arg1] $arg1
+} {1 255}
+test binary-26.14 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
+} {2 128 -128}
+test binary-26.15 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
+} {2 -128 128}
 
 test binary-27.1 {Tcl_BinaryObjCmd: scan} {
     list [catch {binary scan abc s} msg] $msg
@@ -945,6 +969,22 @@ test binary-27.9 {Tcl_BinaryObjCmd: scan} {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
 } {2 {-23726 21587} 5}
+test binary-27.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
+} {1 {41810 21587}}
+test binary-27.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
+} {2 65535 -1}
+test binary-27.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
+} {2 -1 65535}
 
 test binary-28.1 {Tcl_BinaryObjCmd: scan} {
     list [catch {binary scan abc S} msg] $msg
@@ -985,6 +1025,14 @@ test binary-28.9 {Tcl_BinaryObjCmd: scan} {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
 } {2 {21155 21332} 5}
+test binary-28.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1}
+    list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
+} {1 {41810 21587}}
 
 test binary-29.1 {Tcl_BinaryObjCmd: scan} {
     list [catch {binary scan abc i} msg] $msg
@@ -1025,6 +1073,18 @@ test binary-29.9 {Tcl_BinaryObjCmd: scan} {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
 } {2 {1414767442 67305985} 5}
+test binary-29.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-29.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-29.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
+} {2 128 2147483648}
 
 test binary-30.1 {Tcl_BinaryObjCmd: scan} {
     list [catch {binary scan abc I} msg] $msg
@@ -1065,6 +1125,18 @@ test binary-30.9 {Tcl_BinaryObjCmd: scan} {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
 } {2 {1386435412 16909060} 5}
+test binary-30.10 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-30.11 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-30.12 {Tcl_BinaryObjCmd: scan} {
+    catch {unset arg1 arg2}
+    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
+} {2 2147483648 128}
 
 test binary-31.1 {Tcl_BinaryObjCmd: scan} {
     list [catch {binary scan abc f} msg] $msg
@@ -1384,6 +1456,26 @@ test binary-39.5 {ScanNumber: sign extension} {
     catch {unset arg1}
     list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
 } {1 {16843010 -2130640639 25297153 16876033 16843137}}
+test binary-39.6 {ScanNumber: no sign extension} {
+    catch {unset arg1}
+    list [binary scan \x52\xa3 cu2 arg1] $arg1
+} {1 {82 163}}
+test binary-39.7 {ScanNumber: no sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
+} {1 {513 33025 386 33409}}
+test binary-39.8 {ScanNumber: no sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
+} {1 {258 385 33281 33154}}
+test binary-39.9 {ScanNumber: no sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
+} {1 {33620225 16843137 16876033 25297153 2164326657}}
+test binary-39.10 {ScanNumber: no sign extension} {
+    catch {unset arg1}
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
+} {1 {16843010 2164326657 25297153 16876033 16843137}}
 
 test binary-40.3 {ScanNumber: NaN} \
     -body {
@@ -1463,6 +1555,26 @@ 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-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
+    catch {unset arg1}
+    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
+} {1 -9223372036854775808}
+test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    catch {unset arg1}
+    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    catch {unset arg1}
+    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    catch {unset arg1 arg2}
+    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
+test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    catch {unset arg1 arg2}
+    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
 
 test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
     binary scan [binary format sws 16450 -1 19521] c* x
@@ -1800,6 +1912,18 @@ test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
 } {2 {-23726 21587} 5}
+test binary-55.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-55.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
 
 # scan t (b)
 test binary-55.1 {Tcl_BinaryObjCmd: scan} {
@@ -1841,6 +1965,18 @@ test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
 } {2 {21155 21332} 5}
+test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
 
 # scan n (s)
 test binary-56.1 {Tcl_BinaryObjCmd: scan} {
@@ -1882,6 +2018,18 @@ test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian  {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
 } {2 {1414767442 67305985} 5}
+test binary-57.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
+test binary-57.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
 
 # scan n (b)
 test binary-57.1 {Tcl_BinaryObjCmd: scan} {
@@ -1923,6 +2071,18 @@ test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
 } {2 {1386435412 16909060} 5}
+test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
+test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
+    catch {unset arg1 arg2}
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
 
 # scan Q/q
 test binary-58.1 {Tcl_BinaryObjCmd: scan} {