Attachment "tip129.patch" to
ticket [860260ffff]
added by
mrohr
2003-12-15 17:22:08.
Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.14
diff -u -r1.14 tclBinary.c
--- generic/tclBinary.c 2 Dec 2003 09:29:54 -0000 1.14
+++ generic/tclBinary.c 15 Dec 2003 10:14:14 -0000
@@ -16,6 +16,7 @@
#include "tclInt.h"
#include "tclPort.h"
#include <math.h>
+#include <assert.h>
/*
* The following constants are used by GetFormatSpec to indicate various
@@ -656,25 +657,32 @@
size = 1;
goto doNumbers;
}
+ case 't':
case 's':
case 'S': {
size = 2;
goto doNumbers;
}
+ case 'n':
case 'i':
case 'I': {
size = 4;
goto doNumbers;
}
+ case 'm':
case 'w':
case 'W': {
size = 8;
goto doNumbers;
}
+ case 'r':
+ case 'R':
case 'f': {
size = sizeof(float);
goto doNumbers;
}
+ case 'q':
+ case 'Q':
case 'd': {
size = sizeof(double);
@@ -703,7 +711,7 @@
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
- Tcl_AppendResult(interp,
+ Tcl_AppendResult(interp,
"number of elements in list does not match count",
(char *) NULL);
return TCL_ERROR;
@@ -752,7 +760,7 @@
}
default: {
errorString = str;
- goto badField;
+ goto badfield;
}
}
}
@@ -810,7 +818,7 @@
memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
memset((VOID *) (cursor + length), pad,
- (size_t) (count - length));
+ (size_t) (count - length));
}
cursor += count;
break;
@@ -953,6 +961,13 @@
case 'I':
case 'w':
case 'W':
+ case 'q':
+ case 'Q':
+ case 'r':
+ case 'R':
+ case 't':
+ case 'm':
+ case 'n':
case 'd':
case 'f': {
int listc, i;
@@ -1204,29 +1219,43 @@
offset += (count + 1) / 2;
break;
}
+ case 'C':
case 'c': {
size = 1;
goto scanNumber;
}
+ case 'Z':
+ case 'z':
+ case 'T':
case 's':
+ case 't':
case 'S': {
size = 2;
goto scanNumber;
}
+ case 'j':
+ case 'J':
+ case 'N':
case 'i':
+ case 'n':
case 'I': {
size = 4;
goto scanNumber;
}
case 'w':
+ case 'm':
case 'W': {
size = 8;
goto scanNumber;
}
+ case 'r':
+ case 'R':
case 'f': {
size = sizeof(float);
goto scanNumber;
}
+ case 'q':
+ case 'Q':
case 'd': {
unsigned char *src;
@@ -1312,7 +1341,7 @@
default: {
DeleteScanNumberCache(numberCachePtr);
errorString = str;
- goto badField;
+ goto badfield;
}
}
}
@@ -1344,8 +1373,7 @@
errorString = "not enough arguments for all format specifiers";
goto error;
- badField:
- {
+ badfield: {
Tcl_UniChar ch;
char buf[TCL_UTF_MAX + 1];
@@ -1421,6 +1449,133 @@
}
/*
+ * ---------------------------------------------------------------------
+ *
+ * NeedReversion --
+ *
+ * This routine determines, if bytes of a number need to be reversed. This
+ * depends on the endiannes of the machine and the desired format.
+ *
+ * Results:
+ * int: 1 if reversion is required, 0 if not.
+ *
+ * Side effects:
+ * None
+ *
+ * ---------------------------------------------------------------------
+ */
+static int
+NeedReversion( format )
+ int format;
+{
+
+#if defined(WORDS_BIGENDIAN)
+ #define bBigEndian WORDS_BIGENDIAN
+#else
+ #define bBigEndian 0
+#endif
+
+
+ switch( format ) {
+ /* native floats and doubles: no */
+ case 'd':
+ case 'f':
+ return 0;
+
+ /* native ints: */
+ case 'n':
+ case 't':
+ case 'm':
+ case 'T':
+ case 'N':
+ return !(bBigEndian);
+
+ /* floats+doubles bigendian */
+ case 'Q':
+ case 'R':
+ return !(bBigEndian);
+
+ /* int's bigendian */
+ case 'I':
+ case 'S':
+ case 'W':
+ case 'Z':
+ case 'J':
+ return 0;
+
+ /* floats+doubles smallendian */
+ case 'q':
+ case 'r':
+ return (bBigEndian);
+
+ /* int's smallendian */
+ case 'i':
+ case 's':
+ case 'w':
+ case 'z':
+ case 'j':
+ return 1;
+
+ default:
+ /* we never come here */
+ panic("Bad format code");
+ return 0;
+ }
+#undef bBigEndian
+}
+
+/*
+ * ---------------------------------------------------------------------
+ *
+ * CopyNumber --
+ *
+ * This routine is called by FormatNumer and ScanNumber to copy a number.
+ * If required, bytes are reversed while copying.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Copies length bytes
+
+ * ---------------------------------------------------------------------
+ */
+static void
+CopyNumber( from, to, length, reverse )
+ unsigned char *from; /* source */
+ unsigned char *to; /* destination */
+ size_t length; /* Number of bytes to copy */
+ int reverse; /* if true, reverse order while copying */
+{
+ if( reverse ) {
+ switch( length ) {
+ case 2:
+ to[0]=from[1];
+ to[1]=from[0];
+ break;
+ case 4:
+ to[0]=from[3];
+ to[1]=from[2];
+ to[2]=from[1];
+ to[3]=from[0];
+ break;
+ case 8:
+ to[0]=from[7];
+ to[1]=from[6];
+ to[2]=from[5];
+ to[3]=from[4];
+ to[4]=from[3];
+ to[5]=from[2];
+ to[6]=from[1];
+ to[7]=from[0];
+ break;
+ }
+ } else {
+ memcpy( to, from, length );
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* FormatNumber --
@@ -1448,23 +1603,27 @@
long value;
double dvalue;
Tcl_WideInt wvalue;
+ float fvalue;
switch (type) {
- case 'd':
- case 'f':
- /*
- * For floating point types, we need to copy the data using
- * memcpy to avoid alignment issues.
- */
-
- if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- return TCL_ERROR;
- }
- if (type == 'd') {
- memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
+ /* double */
+ case 'd':
+ case 'q':
+ case 'Q':
+ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ CopyNumber( &dvalue, *cursorPtr, sizeof(double), NeedReversion(type) );
*cursorPtr += sizeof(double);
- } else {
- float fvalue;
+ return TCL_OK;
+
+ /* float */
+ case 'f':
+ case 'r':
+ case 'R':
+ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+ return TCL_ERROR;
+ }
/*
* Because some compilers will generate floating point exceptions
@@ -1477,64 +1636,87 @@
} else {
fvalue = (float) dvalue;
}
- memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
+ CopyNumber( &fvalue, *cursorPtr, sizeof(float), NeedReversion(type) );
*cursorPtr += sizeof(float);
- }
- return TCL_OK;
+ return TCL_OK;
- /*
- * Next cases separate from other integer cases because we
- * need a different API to get a wide.
- */
- case 'w':
- case 'W':
- if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
- return TCL_ERROR;
- }
- if (type == 'w') {
- *(*cursorPtr)++ = (unsigned char) wvalue;
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
- } else {
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
- *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
- *(*cursorPtr)++ = (unsigned char) wvalue;
- }
- return TCL_OK;
- default:
- if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
- return TCL_ERROR;
- }
- if (type == 'c') {
- *(*cursorPtr)++ = (unsigned char) value;
- } else if (type == 's') {
- *(*cursorPtr)++ = (unsigned char) value;
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- } else if (type == 'S') {
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) value;
- } else if (type == 'i') {
- *(*cursorPtr)++ = (unsigned char) value;
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) (value >> 16);
- *(*cursorPtr)++ = (unsigned char) (value >> 24);
- } else if (type == 'I') {
- *(*cursorPtr)++ = (unsigned char) (value >> 24);
- *(*cursorPtr)++ = (unsigned char) (value >> 16);
- *(*cursorPtr)++ = (unsigned char) (value >> 8);
- *(*cursorPtr)++ = (unsigned char) value;
- }
- return TCL_OK;
+ /*
+ * Next cases separate from other integer cases because we
+ * need a different API to get a wide.
+ */
+ case 'w':
+ case 'W':
+ case 'm':
+ if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if( NeedReversion(type) ) {
+ *(*cursorPtr)++ = (unsigned char) wvalue;
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
+ } else {
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
+ *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
+ *(*cursorPtr)++ = (unsigned char) wvalue;
+ }
+ return TCL_OK;
+
+ /* short */
+ case 's':
+ case 'S':
+ case 't':
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if( NeedReversion(type) ) {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ } else {
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
+ }
+ return TCL_OK;
+
+ /* int */
+ case 'i':
+ case 'I':
+ case 'n':
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if( NeedReversion(type) ) {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ } else {
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
+ }
+ return TCL_OK;
+
+ case 'c':
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *(*cursorPtr)++ = (unsigned char) value;
+ return TCL_OK;
+
+ default:
+ panic("FormatNumber called with bad format code");
+ return TCL_OK;
}
}
@@ -1580,6 +1762,7 @@
switch (type) {
case 'c':
+ case 'C':
/*
* Characters need special handling. We want to produce a
* signed result, but on some platforms (such as AIX) chars
@@ -1588,44 +1771,71 @@
*/
value = buffer[0];
- if (value & 0x80) {
+ if ((type=='c') && (value & 0x80)) {
value |= -0x100;
}
goto returnNumericObject;
-
- case 's':
- value = (long) (buffer[0] + (buffer[1] << 8));
- goto shortValue;
+
+ /* shorts */
+ case 'T':
+ case 'z':
+ case 'Z':
+ case 't':
case 'S':
- value = (long) (buffer[1] + (buffer[0] << 8));
- shortValue:
- if (value & 0x8000) {
+ case 's':
+ if( NeedReversion(type) ) {
+ value = (long) (buffer[0] + (buffer[1] << 8));
+ } else {
+ value = (long) (buffer[1] + (buffer[0] << 8));
+ }
+ if ((type=='s'||type=='S'||type=='t' ) && (value & 0x8000)) {
value |= -0x10000;
}
goto returnNumericObject;
-
+
+ /* int4 */
+ case 'j':
+ case 'J':
+ case 'N':
case 'i':
- value = (long) (buffer[0]
- + (buffer[1] << 8)
- + (buffer[2] << 16)
- + (buffer[3] << 24));
- goto intValue;
case 'I':
- value = (long) (buffer[3]
- + (buffer[2] << 8)
- + (buffer[1] << 16)
- + (buffer[0] << 24));
- intValue:
- /*
- * Check to see if the value was sign extended properly on
- * systems where an int is more than 32-bits.
- */
+ case 'n':
+ if( NeedReversion(type) ) {
+ value = (long) (((unsigned long)buffer[0])
+ + (((unsigned long)buffer[1]) << 8)
+ + (((unsigned long)buffer[2]) << 16)
+ + (((unsigned long)buffer[3]) << 24));
+ } else {
+ value = (long) (((unsigned long)buffer[3])
+ + (((unsigned long)buffer[2]) << 8)
+ + (((unsigned long)buffer[1]) << 16)
+ + (((unsigned long)buffer[0]) << 24));
+ }
- if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
- value -= (((unsigned int)1)<<31);
- value -= (((unsigned int)1)<<31);
+ if( value & (((unsigned int)1)<<31) ) {
+ /* signed? => the old way */
+ if( type=='i' || type=='I' || type=='n' ) {
+ if (value > 0) {
+ value -= (((unsigned int)1)<<31);
+ value -= (((unsigned int)1)<<31);
+ }
+ goto returnNumericObject;
+ } else {
+ /* unsigned */
+ if (value > 0) {
+ /* OK, value is positive */
+ goto returnNumericObject;
+ } else {
+ /* long is too narrow to carry this, return as wide int */
+ return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
+ }
+ }
+ } else {
+ goto returnNumericObject;
}
- returnNumericObject:
+
+ returnNumericObject:
+
if (*numberCachePtrPtr == NULL) {
return Tcl_NewLongObj(value);
} else {
@@ -1657,14 +1867,18 @@
Tcl_SetHashValue(hPtr, (ClientData) objPtr);
return objPtr;
}
- }
+ }
- /*
- * Do not cache wide values; they are already too large to
- * use as keys.
- */
+
+ /*
+ * Do not cache wide values; they are already too large to
+ * use as keys.
+ */
+ case 'm':
case 'w':
- uwvalue = ((Tcl_WideUInt) buffer[0])
+ case 'W':
+ if( NeedReversion(type) ) {
+ uwvalue = ((Tcl_WideUInt) buffer[0])
| (((Tcl_WideUInt) buffer[1]) << 8)
| (((Tcl_WideUInt) buffer[2]) << 16)
| (((Tcl_WideUInt) buffer[3]) << 24)
@@ -1672,9 +1886,8 @@
| (((Tcl_WideUInt) buffer[5]) << 40)
| (((Tcl_WideUInt) buffer[6]) << 48)
| (((Tcl_WideUInt) buffer[7]) << 56);
- return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
- case 'W':
- uwvalue = ((Tcl_WideUInt) buffer[7])
+ } else {
+ uwvalue = ((Tcl_WideUInt) buffer[7])
| (((Tcl_WideUInt) buffer[6]) << 8)
| (((Tcl_WideUInt) buffer[5]) << 16)
| (((Tcl_WideUInt) buffer[4]) << 24)
@@ -1682,23 +1895,37 @@
| (((Tcl_WideUInt) buffer[2]) << 40)
| (((Tcl_WideUInt) buffer[1]) << 48)
| (((Tcl_WideUInt) buffer[0]) << 56);
+ }
return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+
- /*
- * Do not cache double values; they are already too large
- * to use as keys and the values stored are utterly
- * incompatible too.
- */
- case 'f': {
- float fvalue;
- memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
- return Tcl_NewDoubleObj(fvalue);
- }
- case 'd': {
- double dvalue;
- memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
- return Tcl_NewDoubleObj(dvalue);
+ /*
+ * Do not cache double values; they are already too large
+ * to use as keys and the values stored are utterly
+ * incompatible too.
+ */
+ /* float's */
+ case 'f':
+ case 'R':
+ case 'r': {
+ float fvalue;
+ CopyNumber( buffer, &fvalue, sizeof(float), NeedReversion(type) );
+ return Tcl_NewDoubleObj(fvalue);
+ }
+
+ /* doubles's */
+ case 'd':
+ case 'Q':
+ case 'q': {
+ double dvalue;
+ CopyNumber( buffer, &dvalue, sizeof(double), NeedReversion(type) );
+ return Tcl_NewDoubleObj(dvalue);
}
+
+ default:
+ panic("ScanNumber called with bad format code");
+ return NULL;
+
}
return NULL;
}
@@ -1741,3 +1968,6 @@
}
Tcl_DeleteHashTable(numberCachePtr);
}
+/**
+ * vim:ts=8:nowrap:noet
+ **/
Index: tests/binary.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/binary.test,v
retrieving revision 1.13
diff -u -r1.13 binary.test
--- tests/binary.test 2 Dec 2003 09:29:54 -0000 1.13
+++ tests/binary.test 15 Dec 2003 10:14:19 -0000
@@ -17,6 +17,9 @@
namespace import -force ::tcltest::*
}
+testConstraint bigEndian [string equal $::tcl_platform(byteOrder) "bigEndian"]
+testConstraint littleEndian [string equal $::tcl_platform(byteOrder) "littleEndian"]
+
test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
set buf hellomatt
@@ -1523,6 +1526,961 @@
# caused by [Bug 851747].
list [binary scan aba ccc x x x] $x
} {3 97}
+
+# format t
+test binary-48.1 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format t} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-48.2 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format t blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-48.3 {Tcl_BinaryObjCmd: format} {
+ binary format S0 0x50
+} {}
+test binary-48.4 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t 0x50
+} \x00P
+test binary-48.5 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t 0x50
+} P\x00
+test binary-48.6 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t 0x5052
+} PR
+test binary-48.7 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t 0x5052
+} RP
+test binary-48.8 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t 0x505251 0x53
+} RQ
+test binary-48.9 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t 0x505251 0x53
+} QR
+test binary-48.10 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t2 {0x50 0x52}
+} \x00P\x00R
+test binary-48.11 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t2 {0x50 0x52}
+} P\x00R\x00
+test binary-48.12 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t* {0x5051 0x52}
+} PQ\x00R
+test binary-48.13 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t* {0x5051 0x52}
+} QPR\x00
+test binary-48.14 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format t2 {0x50 0x52 0x53} 0x54
+} \x00P\x00R
+test binary-48.15 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format t2 {0x50 0x52 0x53} 0x54
+} P\x00R\x00
+test binary-48.16 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format t2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-48.17 {Tcl_BinaryObjCmd: format} {
+ set a {0x50 0x51}
+ list [catch {binary format t $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-48.18 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ set a {0x50 0x51}
+ binary format t1 $a
+} \x00P
+test binary-48.18 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ set a {0x50 0x51}
+ binary format t1 $a
+} P\x00
+
+# format n
+test binary-49.1 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format n} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-49.2 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format n blat} msg] $msg
+} {1 {expected integer but got "blat"}}
+test binary-49.3 {Tcl_BinaryObjCmd: format} {
+ binary format n0 0x50
+} {}
+test binary-49.4 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n 0x50
+} P\x00\x00\x00
+test binary-49.5 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n 0x5052
+} RP\x00\x00
+test binary-49.6 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n 0x505251 0x53
+} QRP\x00
+test binary-49.7 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format i1 {0x505251 0x53}
+} QRP\x00
+test binary-49.8 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n 0x53525150
+} PQRS
+test binary-49.9 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n2 {0x50 0x52}
+} P\x00\x00\x00R\x00\x00\x00
+test binary-49.10 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ binary format n* {0x50515253 0x52}
+} SRQPR\x00\x00\x00
+test binary-49.11 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format n2 {0x50}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-49.12 {Tcl_BinaryObjCmd: format} {
+ set a {0x50 0x51}
+ list [catch {binary format n $a} msg] $msg
+} [list 1 "expected integer but got \"0x50 0x51\""]
+test binary-49.13 {Tcl_BinaryObjCmd: format} {littleEndian} {
+ set a {0x50 0x51}
+ binary format n1 $a
+} P\x00\x00\x00
+test binary-49.14 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n 0x50
+} \x00\x00\x00P
+test binary-49.15 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n 0x5052
+} \x00\x00PR
+test binary-49.16 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n 0x505251 0x53
+} \x00PRQ
+test binary-49.17 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format i1 {0x505251 0x53}
+} QRP\x00
+test binary-49.18 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n 0x53525150
+} SRQP
+test binary-49.19 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n2 {0x50 0x52}
+} \x00\x00\x00P\x00\x00\x00R
+test binary-49.20 {Tcl_BinaryObjCmd: format} {bigEndian} {
+ binary format n* {0x50515253 0x52}
+} PQRS\x00\x00\x00R
+
+# format m
+test binary-50.1 {Tcl_BinaryObjCmd: format wide int} {littleEndian} {
+ binary format m 7810179016327718216
+} HelloTcl
+test binary-50.2 {Tcl_BinaryObjCmd: format wide int} {bigEndian} {
+ binary format m 7810179016327718216
+} lcTolleH
+test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {littleEndian} {
+ binary scan [binary format m [expr {wide(3) << 31}]] w x
+ set x
+} 6442450944
+test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {bigEndian} {
+ binary scan [binary format m [expr {wide(3) << 31}]] W x
+ set x
+} 6442450944
+
+
+# format Q/q
+test binary-51.1 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format Q} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-51.2 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format q blat} msg] $msg
+} {1 {expected floating-point number but got "blat"}}
+test binary-51.3 {Tcl_BinaryObjCmd: format} {
+ binary format q0 1.6
+} {}
+test binary-51.4 {Tcl_BinaryObjCmd: format} {} {
+ binary format Q 1.6
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-51.5 {Tcl_BinaryObjCmd: format} {} {
+ binary format q 1.6
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f
+test binary-51.6 {Tcl_BinaryObjCmd: format} {} {
+ binary format Q* {1.6 3.4}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-51.7 {Tcl_BinaryObjCmd: format} {} {
+ binary format q* {1.6 3.4}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+test binary-51.8 {Tcl_BinaryObjCmd: format} {} {
+ binary format Q2 {1.6 3.4}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-51.9 {Tcl_BinaryObjCmd: format} {} {
+ binary format q2 {1.6 3.4}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
+ binary format Q2 {1.6 3.4 5.6}
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
+test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
+ binary format q2 {1.6 3.4 5.6}
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
+#test binary-51.12 {Tcl_BinaryObjCmd: float overflow} {unixOnly} {
+# binary format d NaN
+#} \x7f\xff\xff\xff\xff\xff\xff\xff
+#test binary-51.13 {Tcl_BinaryObjCmd: float overflow} {macOnly} {
+# binary format d NaN
+#} \x7f\xf8\x02\xa0\x00\x00\x00\x00
+test binary-51.14 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format q2 {1.6}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-51.15 {Tcl_BinaryObjCmd: format} {
+ set a {1.6 3.4}
+ list [catch {binary format q $a} msg] $msg
+} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
+ set a {1.6 3.4}
+ binary format Q1 $a
+} \x3f\xf9\x99\x99\x99\x99\x99\x9a
+test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
+ set a {1.6 3.4}
+ binary format q1 $a
+} \x9a\x99\x99\x99\x99\x99\xf9\x3f
+
+# format R/r
+test binary-53.1 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format r} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-53.2 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format r blat} msg] $msg
+} {1 {expected floating-point number but got "blat"}}
+test binary-53.3 {Tcl_BinaryObjCmd: format} {
+ binary format f0 1.6
+} {}
+test binary-53.4 {Tcl_BinaryObjCmd: format} {} {
+ binary format R 1.6
+} \x3f\xcc\xcc\xcd
+test binary-53.5 {Tcl_BinaryObjCmd: format} {} {
+ binary format r 1.6
+} \xcd\xcc\xcc\x3f
+test binary-53.6 {Tcl_BinaryObjCmd: format} {} {
+ binary format R* {1.6 3.4}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-53.7 {Tcl_BinaryObjCmd: format} {} {
+ binary format r* {1.6 3.4}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-53.8 {Tcl_BinaryObjCmd: format} {} {
+ binary format R2 {1.6 3.4}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-53.9 {Tcl_BinaryObjCmd: format} {} {
+ binary format r2 {1.6 3.4}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-53.10 {Tcl_BinaryObjCmd: format} {} {
+ binary format R2 {1.6 3.4 5.6}
+} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
+test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
+ binary format r2 {1.6 3.4 5.6}
+} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
+test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
+ binary format R -3.402825e+38
+} \xff\x7f\xff\xff
+test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
+ binary format r -3.402825e+38
+} \xff\xff\x7f\xff
+test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
+ binary format R -3.402825e-100
+} \x80\x00\x00\x00
+test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
+ binary format r -3.402825e-100
+} \x00\x00\x00\x80
+test binary-53.16 {Tcl_BinaryObjCmd: format} {
+ list [catch {binary format r2 {1.6}} msg] $msg
+} {1 {number of elements in list does not match count}}
+test binary-53.17 {Tcl_BinaryObjCmd: format} {
+ set a {1.6 3.4}
+ list [catch {binary format r $a} msg] $msg
+} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
+ set a {1.6 3.4}
+ binary format R1 $a
+} \x3f\xcc\xcc\xcd
+test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
+ set a {1.6 3.4}
+ binary format r1 $a
+} \xcd\xcc\xcc\x3f
+
+# scan t (s)
+test binary-54.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc t} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-54.2 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
+} {1 {-23726 21587}}
+test binary-54.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
+} {1 -23726}
+test binary-54.4 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 t1 arg1] $arg1
+} {1 -23726}
+test binary-54.5 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 t0 arg1] $arg1
+} {1 {}}
+test binary-54.6 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
+} {1 {-23726 21587}}
+test binary-54.7 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 t1 arg1] $arg1
+} {0 foo}
+test binary-54.8 {Tcl_BinaryObjCmd: scan} {} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-54.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
+} {2 {-23726 21587} 5}
+
+# scan t (b)
+test binary-55.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc t} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-55.2 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
+} {1 {21155 21332}}
+test binary-55.3 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
+} {1 21155}
+test binary-55.4 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 t1 arg1] $arg1
+} {1 21155}
+test binary-55.5 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 t0 arg1] $arg1
+} {1 {}}
+test binary-55.6 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
+} {1 {21155 21332}}
+test binary-55.7 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 t1 arg1] $arg1
+} {0 foo}
+test binary-55.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-55.9 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
+} {2 {21155 21332} 5}
+
+# scan n (s)
+test binary-56.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc n} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-56.2 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-56.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
+} {1 1414767442}
+test binary-56.4 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
+} {1 1414767442}
+test binary-56.5 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 n0 arg1] $arg1
+} {1 {}}
+test binary-56.6 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-56.7 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 n1 arg1] $arg1
+} {0 foo}
+test binary-56.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-56.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
+} {2 {1414767442 67305985} 5}
+
+# scan n (b)
+test binary-57.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc n} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-57.2 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-57.3 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
+} {1 1386435412}
+test binary-57.4 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
+} {1 1386435412}
+test binary-57.5 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 n0 arg1] $arg1
+} {1 {}}
+test binary-57.6 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-57.7 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 n1 arg1] $arg1
+} {0 foo}
+test binary-57.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-57.9 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
+} {2 {1386435412 16909060} 5}
+
+# scan Q/q
+test binary-58.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc q} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-58.2 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
+} {1 {1.6 3.4}}
+test binary-58.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
+} {1 {1.6 3.4}}
+test binary-58.4 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
+} {1 1.6}
+test binary-58.5 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
+} {1 1.6}
+test binary-58.6 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
+} {1 1.6}
+test binary-58.7 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
+} {1 1.6}
+test binary-58.8 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
+} {1 {}}
+test binary-58.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
+} {1 {}}
+test binary-58.10 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
+} {1 {1.6 3.4}}
+test binary-58.11 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
+} {1 {1.6 3.4}}
+test binary-58.12 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 q1 arg1] $arg1
+} {0 foo}
+test binary-58.13 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-58.14 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6 3.4} 5}
+test binary-58.15 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
+} {2 {1.6 3.4} 5}
+
+
+# scan R/r
+test binary-59.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc r} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-59.2 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
+} {1 {1.60000002384 3.40000009537}}
+test binary-59.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
+} {1 {1.60000002384 3.40000009537}}
+test binary-59.4 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
+} {1 1.60000002384}
+test binary-59.5 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
+} {1 1.60000002384}
+test binary-59.6 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
+} {1 1.60000002384}
+test binary-59.7 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
+} {1 1.60000002384}
+test binary-59.8 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
+} {1 {}}
+test binary-59.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
+} {1 {}}
+test binary-59.10 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
+} {1 {1.60000002384 3.40000009537}}
+test binary-59.11 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
+} {1 {1.60000002384 3.40000009537}}
+test binary-59.12 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 r1 arg1] $arg1
+} {0 foo}
+test binary-59.13 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-59.14 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
+} {2 {1.60000002384 3.40000009537} 5}
+test binary-59.15 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
+} {2 {1.60000002384 3.40000009537} 5}
+
+# scan m
+test binary-60.1 {Tcl_BinaryObjCmd: scan wide int} {bigEndian} {
+ binary scan HelloTcl m x
+ set x
+} 5216694956358656876
+test binary-60.2 {Tcl_BinaryObjCmd: scan wide int} {littleEndian} {
+ binary scan lcTolleH m x
+ set x
+} 5216694956358656876
+test binary-60.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {littleEndian} {
+ binary scan [binary format w [expr {wide(3) << 31}]] m x
+ set x
+} 6442450944
+test binary-60.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {bigEndian} {
+ binary scan [binary format W [expr {wide(3) << 31}]] m x
+ set x
+} 6442450944
+
+# scan C (unsigned char)
+test binary-61.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc C} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-61.2 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 C* arg1] $arg1
+} {1 {82 163}}
+test binary-61.3 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 C arg1] $arg1
+} {1 82}
+test binary-61.4 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 C1 arg1] $arg1
+} {1 82}
+test binary-61.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 C0 arg1] $arg1
+} {1 {}}
+test binary-61.6 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 C2 arg1] $arg1
+} {1 {82 163}}
+test binary-61.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xff C arg1] $arg1
+} {1 255}
+test binary-61.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 C3 arg1] $arg1
+} {0 foo}
+test binary-61.9 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 C1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-61.10 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x70\x87\x05 C2C* arg1 arg2] $arg1 $arg2
+} {2 {112 135} 5}
+
+# scan z (unsigned short se)
+test binary-62.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc z} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-62.2 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 z* arg1] $arg1
+} {1 {41810 21587}}
+test binary-62.3 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 z arg1] $arg1
+} {1 41810}
+test binary-62.4 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 z1 arg1] $arg1
+} {1 41810}
+test binary-62.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 z0 arg1] $arg1
+} {1 {}}
+test binary-62.6 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 z2 arg1] $arg1
+} {1 {41810 21587}}
+test binary-62.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 z1 arg1] $arg1
+} {0 foo}
+test binary-62.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 z1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-62.9 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x05 z2c* arg1 arg2] $arg1 $arg2
+} {2 {41810 21587} 5}
+
+# scan Z (unsigned short be)
+test binary-63.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc Z} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-63.2 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x54\x53 Z* arg1] $arg1
+} {1 {41810 21587}}
+test binary-63.3 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x53\x54 Z arg1] $arg1
+} {1 41810}
+test binary-63.4 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52 Z1 arg1] $arg1
+} {1 41810}
+test binary-63.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 Z0 arg1] $arg1
+} {1 {}}
+test binary-63.6 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x54\x53 Z2 arg1] $arg1
+} {1 {41810 21587}}
+test binary-63.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 Z1 arg1] $arg1
+} {0 foo}
+test binary-63.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 Z1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-63.9 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \xa3\x52\x54\x53\x05 Z2c* arg1 arg2] $arg1 $arg2
+} {2 {41810 21587} 5}
+
+# scan T (unsigned short native)
+test binary-64.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc T} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-64.2 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 T* arg1] $arg1
+} {1 {41810 21587}}
+test binary-64.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 T arg1] $arg1
+} {1 41810}
+test binary-64.4 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 T1 arg1] $arg1
+} {1 41810}
+test binary-64.5 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 T0 arg1] $arg1
+} {1 {}}
+test binary-64.6 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 T2 arg1] $arg1
+} {1 {41810 21587}}
+test binary-64.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 T1 arg1] $arg1
+} {0 foo}
+test binary-64.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53 T1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-64.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x05 T2c* arg1 arg2] $arg1 $arg2
+} {2 {41810 21587} 5}
+# be
+test binary-64.10 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x54\x53 T* arg1] $arg1
+} {1 {41810 21587}}
+test binary-64.11 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x53\x54 T arg1] $arg1
+} {1 41810}
+test binary-64.12 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52 T1 arg1] $arg1
+} {1 41810}
+test binary-64.13 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3 T0 arg1] $arg1
+} {1 {}}
+test binary-64.14 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \xa3\x52\x54\x53 T2 arg1] $arg1
+} {1 {41810 21587}}
+test binary-64.15 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \xa3\x52\x54\x53\x05 T2c* arg1 arg2] $arg1 $arg2
+} {2 {41810 21587} 5}
+
+# j (unsigned int4 se)
+test binary-64.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc j} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-64.2 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 j* arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-64.3 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 j arg1] $arg1
+} {1 1414767442}
+test binary-64.4 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 j1 arg1] $arg1
+} {1 1414767442}
+test binary-64.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 j0 arg1] $arg1
+} {1 {}}
+test binary-64.6 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 j2 arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-64.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 j1 arg1] $arg1
+} {0 foo}
+test binary-64.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 j1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-64.9 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 j2c* arg1 arg2] $arg1 $arg2
+} {2 {1414767442 67305985} 5}
+test binary-64.10 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x2b\xe9\x34\xff j arg1] $arg1
+} {1 4281657643}
+
+# scan J (unsigned int4 be)
+test binary-65.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc J} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-65.2 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 J* arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-65.3 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 J arg1] $arg1
+} {1 1386435412}
+test binary-65.4 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 J1 arg1] $arg1
+} {1 1386435412}
+test binary-65.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 J0 arg1] $arg1
+} {1 {}}
+test binary-65.6 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 J2 arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-65.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 J1 arg1] $arg1
+} {0 foo}
+test binary-65.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 J1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-65.9 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 J2c* arg1 arg2] $arg1 $arg2
+} {2 {1386435412 16909060} 5}
+test binary-65.10 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \xff\x34\xe9\x2b J arg1] $arg1
+} {1 4281657643}
+
+# N (unsigned int4 native), on se
+test binary-66.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc N} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-66.2 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N* arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-66.3 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N arg1] $arg1
+} {1 1414767442}
+test binary-66.4 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 N1 arg1] $arg1
+} {1 1414767442}
+test binary-66.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 N0 arg1] $arg1
+} {1 {}}
+test binary-66.6 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N2 arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-66.7 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 N1 arg1] $arg1
+} {0 foo}
+test binary-66.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 N1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-66.9 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ 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-66.10 {Tcl_BinaryObjCmd: scan} {littleEndian} {
+ catch {unset arg1}
+ list [binary scan \x2b\xe9\x34\xff N arg1] $arg1
+} {1 4281657643}
+
+# N (unsigned int4 native), on be
+test binary-67.1 {Tcl_BinaryObjCmd: scan} {
+ list [catch {binary scan abc N} msg] $msg
+} {1 {not enough arguments for all format specifiers}}
+test binary-67.2 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N* arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-67.3 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N arg1] $arg1
+} {1 1386435412}
+test binary-67.4 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54 N1 arg1] $arg1
+} {1 1386435412}
+test binary-67.5 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53 N0 arg1] $arg1
+} {1 {}}
+test binary-67.6 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 N2 arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-67.7 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 foo
+ list [binary scan \x52 N1 arg1] $arg1
+} {0 foo}
+test binary-67.8 {Tcl_BinaryObjCmd: scan} {
+ catch {unset arg1}
+ set arg1 1
+ list [catch {binary scan \x52\x53\x53\x54 N1 arg1(a)} msg] $msg
+} {1 {can't set "arg1(a)": variable isn't array}}
+test binary-67.9 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1 arg2}
+ set arg1 foo
+ 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-67.10 {Tcl_BinaryObjCmd: scan} {bigEndian} {
+ catch {unset arg1}
+ list [binary scan \xff\x34\xe9\x2b N arg1] $arg1
+} {1 4281657643}
+
+
# cleanup
::tcltest::cleanupTests
