summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog6
-rw-r--r--doc/binary.n131
-rw-r--r--generic/tclBinary.c490
-rw-r--r--tests/binary.test716
4 files changed, 1127 insertions, 216 deletions
diff --git a/ChangeLog b/ChangeLog
index ac64483..71efe32 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-05-13 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * doc/binary.n: TIP#129 IMPLEMENTATION [Patch 858211]
+ * generic/tclBinary.c: Note that the test suite probably has many more
+ * tests/binary.test: failures now due to alterations in constraints.
+
2004-05-12 Miguel Sofer <msofer@users.sf.net>
Optimisations for INST_START_CMD [Bug 926164].
diff --git a/doc/binary.n b/doc/binary.n
index 1bb5f68..0a863c1 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.16 2003/07/14 18:25:42 hobbs Exp $
+'\" RCS: @(#) $Id: binary.n,v 1.17 2004/05/13 10:12:56 dkf Exp $
'\"
.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
@@ -27,7 +27,6 @@ architecture, it might produce an 8-byte binary string consisting of
two 4-byte integers, one for each of the numbers. The second form of
the command, \fBbinary scan\fR, does the opposite: it extracts data
from a binary string and returns it as ordinary Tcl string values.
-
.SH "BINARY FORMAT"
.PP
The \fBbinary format\fR command generates a binary string whose layout
@@ -193,6 +192,14 @@ example,
will return a string equivalent to
\fB\\x00\\x03\\xff\\xfd\\x01\\x02\fR.
.RE
+.IP \fBt\fR 5
+.VS 8.5
+This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
+except that it stores the 16-bit integers in the output string in the
+native byte order of the machine where the Tcl script is running.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBi\fR 5
This form is the same as \fBc\fR except that it stores one or more
32-bit integers in little-endian byte order in the output string. The
@@ -217,8 +224,16 @@ For example,
will return a string equivalent to
\fB\\x00\\x00\\x00\\x03\\xff\\xff\\xff\\xfd\\x00\\x01\\x00\\x00\fR
.RE
+.IP \fBn\fR 5
+.VS 8.5
+This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
+\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
+output string in the native byte order of the machine where the Tcl
+script is running.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBw\fR 5
-.VS 8.4
This form is the same as \fBc\fR except that it stores one or more
64-bit integers in little-endian byte order in the output string. The
low-order 64-bits of each integer are stored as an eight-byte value at
@@ -239,11 +254,19 @@ For example,
\fBbinary format Wc 4785469626960341345 110\fR
.CE
will return the string \fBBigEndian\fR
-.VE
.RE
+.IP \fBm\fR 5
+.VS 8.5
+This form (mnemonically the mirror of \fBw\fR) is the same as \fBw\fR
+and \fBW\fR except that it stores the 64-bit integers in the output
+string in the native byte order of the machine where the Tcl script is
+running.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
-or more single-precision floating in the machine's native
+or more single-precision floating point numbers in the machine's native
representation in the output string. This representation is not
portable across architectures, so it should not be used to communicate
floating point numbers across the network. The size of a floating
@@ -251,7 +274,7 @@ point number may vary across architectures, so the number of bytes
that are generated may vary. If the value overflows the
machine's native representation, then the value of FLT_MAX
as defined by the system will be used instead. Because Tcl uses
-double-precision floating-point numbers internally, there may be some
+double-precision floating point numbers internally, there may be some
loss of precision in the conversion to single-precision. For example,
on a Windows system running on an Intel Pentium processor,
.RS
@@ -261,9 +284,22 @@ on a Windows system running on an Intel Pentium processor,
will return a string equivalent to
\fB\\xcd\\xcc\\xcc\\x3f\\x9a\\x99\\x59\\x40\fR.
.RE
+.IP \fBr\fR 5
+.VS 8.5
+This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
+it stores the single-precision floating point numbers in little-endian
+order. This conversion only produces meaningful output when used on
+machines which use the IEEE floating point representation (very
+common, but not universal.)
+.VE 8.5
+.IP \fBR\fR 5
+.VS 8.5
+This form is the same as \fBr\fR except that it stores the
+single-precision floating point numbers in big-endian order.
+.VE 8.5
.IP \fBd\fR 5
This form is the same as \fBf\fR except that it stores one or more one
-or more double-precision floating in the machine's native
+or more double-precision floating point numbers in the machine's native
representation in the output string. For example, on a
Windows system running on an Intel Pentium processor,
.RS
@@ -273,6 +309,19 @@ Windows system running on an Intel Pentium processor,
will return a string equivalent to
\fB\\x9a\\x99\\x99\\x99\\x99\\x99\\xf9\\x3f\fR.
.RE
+.IP \fBq\fR 5
+.VS 8.5
+This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
+except that it stores the double-precision floating point numbers in
+little-endian order. This conversion only produces meaningful output
+when used on machines which use the IEEE floating point representation
+(very common, but not universal.)
+.VE 8.5
+.IP \fBQ\fR 5
+.VS 8.5
+This form is the same as \fBq\fR except that it stores the
+double-precision floating point numbers in big-endian order.
+.VE 8.5
.IP \fBx\fR 5
Stores \fIcount\fR null bytes in the output string. If \fIcount\fR is
not specified, stores one null byte. If \fIcount\fR is \fB*\fR,
@@ -312,7 +361,6 @@ generated. This type does not consume an argument. For example,
.CE
will return \fBabfdeghi\\000\\000j\fR.
.RE
-
.SH "BINARY SCAN"
.PP
The \fBbinary scan\fR command parses fields from a binary string,
@@ -509,6 +557,14 @@ order. For example,
will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
stored in \fBvar2\fR.
.RE
+.IP \fBt\fR 5
+.VS 8.5
+The data is interpreted as \fIcount\fR 16-bit signed integers
+represented in the native byte order of the machine running the Tcl
+script. It is otherwise identical to \fBs\fR and \fBS\fR.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBi\fR 5
The data is interpreted as \fIcount\fR 32-bit signed integers
represented in little-endian byte order. The integers are stored in
@@ -535,8 +591,15 @@ order. For example,
will return \fB2\fR with \fB5 7\fR stored in \fBvar1\fR and \fB-16\fR
stored in \fBvar2\fR.
.RE
+.IP \fBn\fR 5
+.VS 8.5
+The data is interpreted as \fIcount\fR 32-bit signed integers
+represented in the native byte order of the machine running the Tcl
+script. It is otherwise identical to \fBi\fR and \fBI\fR.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBw\fR 5
-.VS 8.4
The data is interpreted as \fIcount\fR 64-bit signed integers
represented in little-endian byte order. The integers are stored in
the corresponding variable as a list. If \fIcount\fR is \fB*\fR, then
@@ -561,8 +624,15 @@ order. For example,
.CE
will return \fB2\fR with \fB21474836487\fR stored in \fBvar1\fR and \fB-16\fR
stored in \fBvar2\fR.
-.VE
.RE
+.IP \fBm\fR 5
+.VS 8.5
+The data is interpreted as \fIcount\fR 64-bit signed integers
+represented in the native byte order of the machine running the Tcl
+script. It is otherwise identical to \fBw\fR and \fBW\fR.
+To determine what the native byte order of the machine is, refer to
+the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
+.VE 8.5
.IP \fBf\fR 5
The data is interpreted as \fIcount\fR single-precision floating point
numbers in the machine's native representation. The floating point
@@ -582,6 +652,20 @@ Intel Pentium processor,
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fBvar1\fR.
.RE
+.IP \fBr\fR 5
+.VS 8.5
+This form is the same as \fBf\fR except that the data is interpreted
+as \fIcount\fR single-precision floating point number in little-endian
+order. This conversion is not portable to systems not using IEEE
+floating point representations.
+.VE 8.5
+.IP \fBR\fR 5
+.VS 8.5
+This form is the same as \fBf\fR except that the data is interpreted
+as \fIcount\fR single-precision floating point number in big-endian
+order. This conversion is not portable to systems not using IEEE
+floating point representations.
+.VE 8.5
.IP \fBd\fR 5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
@@ -594,6 +678,20 @@ running on an Intel Pentium processor,
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fBvar1\fR.
.RE
+.IP \fBq\fR 5
+.VS 8.5
+This form is the same as \fBd\fR except that the data is interpreted
+as \fIcount\fR double-precision floating point number in little-endian
+order. This conversion is not portable to systems not using IEEE
+floating point representations.
+.VE 8.5
+.IP \fBQ\fR 5
+.VS 8.5
+This form is the same as \fBd\fR except that the data is interpreted
+as \fIcount\fR double-precision floating point number in big-endian
+order. This conversion is not portable to systems not using IEEE
+floating point representations.
+.VE 8.5
.IP \fBx\fR 5
Moves the cursor forward \fIcount\fR bytes in \fIstring\fR. If
\fIcount\fR is \fB*\fR or is larger than the number of bytes after the
@@ -634,12 +732,13 @@ by \fIcount\fR. Note that position 0 refers to the first byte in
will return \fB2\fR with \fB1 2\fR stored in \fBvar1\fR and \fB020304\fR
stored in \fBvar2\fR.
.RE
-
-.SH "PLATFORM ISSUES"
-Sometimes it is desirable to format or scan integer values in the
-native byte order for the machine. Refer to the \fBbyteOrder\fR
-element of the \fBtcl_platform\fR array to decide which type character
-to use when formatting or scanning integers.
+.SH "PORTABILITY ISSUES"
+The \fBr\fR, \fBR\fR, \fBq\fR and \fBQ\fR conversions will only work
+reliably for transferring data between computers which are all using
+IEEE floating point representations. This is very common, but not
+universal. To transfer floating-point numbers portably between all
+architectures, use their textual representation (as produced by
+\fBformat\fR) instead.
.SH "SEE ALSO"
format(n), scan(n), tclvars(n)
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index a99519a..44fb2f0 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.17 2004/04/06 22:25:48 dgp Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.18 2004/05/13 10:12:55 dkf Exp $
*/
#include "tclInt.h"
@@ -67,6 +67,9 @@ static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
static void DeleteScanNumberCache _ANSI_ARGS_((
Tcl_HashTable *numberCachePtr));
+static int NeedReversing _ANSI_ARGS_((int format));
+static void CopyNumber _ANSI_ARGS_((CONST void *from, void *to,
+ unsigned int length, int type));
/*
* The following object type represents an array of bytes. An array of
@@ -127,7 +130,7 @@ typedef struct ByteArray {
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_NewByteArrayObj --
*
@@ -142,7 +145,7 @@ typedef struct ByteArray {
* Side effects:
* Memory allocated for new object and copy of byte array argument.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
@@ -177,7 +180,7 @@ Tcl_NewByteArrayObj(bytes, length)
#endif /* TCL_MEM_DEBUG */
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_DbNewByteArrayObj --
*
@@ -199,7 +202,7 @@ Tcl_NewByteArrayObj(bytes, length)
* Side effects:
* Memory allocated for new object and copy of byte array argument.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
@@ -340,7 +343,7 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
* new array; new bytes are undefined. When shrinking, the
* old array is truncated to the specified length.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
unsigned char *
@@ -374,7 +377,7 @@ Tcl_SetByteArrayLength(objPtr, length)
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* SetByteArrayFromAny --
*
@@ -386,7 +389,7 @@ Tcl_SetByteArrayLength(objPtr, length)
* Side effects:
* A ByteArray object is stored as the internal rep of objPtr.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static int
@@ -449,7 +452,7 @@ FreeByteArrayInternalRep(objPtr)
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* DupByteArrayInternalRep --
*
@@ -463,7 +466,7 @@ FreeByteArrayInternalRep(objPtr)
* Side effects:
* Allocates memory.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
@@ -488,7 +491,7 @@ DupByteArrayInternalRep(srcPtr, copyPtr)
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* UpdateStringOfByteArray --
*
@@ -506,7 +509,7 @@ DupByteArrayInternalRep(srcPtr, copyPtr)
* The object becomes a string object -- the internal rep is
* discarded and the typePtr becomes NULL.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static void
@@ -660,25 +663,32 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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);
@@ -707,7 +717,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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;
@@ -814,7 +824,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
memset((VOID *) (cursor + length), pad,
- (size_t) (count - length));
+ (size_t) (count - length));
}
cursor += count;
break;
@@ -951,13 +961,20 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
break;
}
case 'c':
+ case 't':
case 's':
case 'S':
+ case 'n':
case 'i':
case 'I':
+ case 'm':
case 'w':
case 'W':
+ case 'r':
+ case 'R':
case 'd':
+ case 'q':
+ case 'Q':
case 'f': {
int listc, i;
Tcl_Obj **listv;
@@ -1212,25 +1229,32 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
size = 1;
goto scanNumber;
}
+ case 't':
case 's':
case 'S': {
size = 2;
goto scanNumber;
}
+ case 'n':
case 'i':
case 'I': {
size = 4;
goto scanNumber;
}
+ case 'm':
case 'w':
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;
@@ -1427,6 +1451,135 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
/*
*----------------------------------------------------------------------
*
+ * NeedReversing --
+ *
+ * This routine determines, if bytes of a number need to be
+ * reversed. This depends on the endiannes of the machine and
+ * the desired format. It is in effect a table (whose contents
+ * depend on the endianness of the system) describing whether a
+ * value needs reversing or not. Anyone porting the code to a
+ * big-endian platform should take care to make sure that they
+ * define WORDS_BIGENDIAN though this is already done by
+ * configure for the Unix build; little-endian platforms
+ * (including Windows) don't need to do anything.
+ *
+ * Results:
+ * 1 if reversion is required, 0 if not.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NeedReversing(format)
+ int format;
+{
+ switch (format) {
+ /* native floats and doubles: never reverse */
+ case 'd':
+ case 'f':
+ /* big endian ints: never reverse */
+ case 'I':
+ case 'S':
+ case 'W':
+#ifdef WORDS_BIGENDIAN
+ /* native ints: reverse if we're little-endian */
+ case 'n':
+ case 't':
+ case 'm':
+ /* f+d: reverse if we're little-endian */
+ case 'Q':
+ case 'R':
+#else /* !WORDS_BIGENDIAN */
+ /* small endian floats: reverse if we're big-endian */
+ case 'q':
+ case 'r':
+#endif /* WORDS_BIGENDIAN */
+ return 0;
+
+#ifdef WORDS_BIGENDIAN
+ /* small endian floats: reverse if we're big-endian */
+ case 'q':
+ case 'r':
+#else /* !WORDS_BIGENDIAN */
+ /* native ints: reverse if we're little-endian */
+ case 'n':
+ case 't':
+ case 'm':
+ /* f+d: reverse if we're little-endian */
+ case 'Q':
+ case 'R':
+#endif /* WORDS_BIGENDIAN */
+ /* small endian ints: always reverse */
+ case 'i':
+ case 's':
+ case 'w':
+ return 1;
+ }
+
+ Tcl_Panic("unexpected fall-through");
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CopyNumber --
+ *
+ * This routine is called by FormatNumber and ScanNumber to copy
+ * a floating-point number. If required, bytes are reversed
+ * while copying. The behaviour is only fully defined when used
+ * with IEEE float and double values (guaranteed to be 4 and 8
+ * bytes long, respectively.)
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Copies length bytes
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CopyNumber(from, to, length, type)
+ CONST void *from; /* source */
+ void *to; /* destination */
+ unsigned int length; /* Number of bytes to copy */
+ int type; /* What type of thing are we copying? */
+{
+ if (NeedReversing(type)) {
+ CONST unsigned char *fromPtr = (CONST unsigned char *) from;
+ unsigned char *toPtr = (unsigned char *) to;
+
+ switch (length) {
+ case 4:
+ toPtr[0] = fromPtr[3];
+ toPtr[1] = fromPtr[2];
+ toPtr[2] = fromPtr[1];
+ toPtr[3] = fromPtr[0];
+ break;
+ case 8:
+ toPtr[0] = fromPtr[7];
+ toPtr[1] = fromPtr[6];
+ toPtr[2] = fromPtr[5];
+ toPtr[3] = fromPtr[4];
+ toPtr[4] = fromPtr[3];
+ toPtr[5] = fromPtr[2];
+ toPtr[6] = fromPtr[1];
+ toPtr[7] = fromPtr[0];
+ break;
+ }
+ } else {
+ memcpy(to, from, length);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* FormatNumber --
*
* This routine is called by Tcl_BinaryObjCmd to format a number
@@ -1452,50 +1605,59 @@ FormatNumber(interp, type, src, cursorPtr)
long value;
double dvalue;
Tcl_WideInt wvalue;
+ float fvalue;
switch (type) {
case 'd':
+ case 'q':
+ case 'Q':
+ /*
+ * Double-precision floating point values.
+ */
+
+ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
+ *cursorPtr += sizeof(double);
+ return TCL_OK;
+
case 'f':
+ case 'r':
+ case 'R':
/*
- * For floating point types, we need to copy the data using
- * memcpy to avoid alignment issues.
+ * Single-precision floating point values.
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
return TCL_ERROR;
}
- if (type == 'd') {
- memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
- *cursorPtr += sizeof(double);
- } else {
- float fvalue;
- /*
- * Because some compilers will generate floating point exceptions
- * on an overflow cast (e.g. Borland), we restrict the values
- * to the valid range for float.
- */
+ /*
+ * Because some compilers will generate floating point exceptions
+ * on an overflow cast (e.g. Borland), we restrict the values
+ * to the valid range for float.
+ */
- if (fabs(dvalue) > (double)FLT_MAX) {
- fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
- } else {
- fvalue = (float) dvalue;
- }
- memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
- *cursorPtr += sizeof(float);
+ if (fabs(dvalue) > (double)FLT_MAX) {
+ fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
+ } else {
+ fvalue = (float) dvalue;
}
+ CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
+ *cursorPtr += sizeof(float);
return TCL_OK;
/*
- * Next cases separate from other integer cases because we
- * need a different API to get a wide.
+ * 64-bit integer values.
*/
case 'w':
case 'W':
+ case 'm':
if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
- if (type == 'w') {
+ if (NeedReversing(type)) {
*(*cursorPtr)++ = (unsigned char) wvalue;
*(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
@@ -1515,30 +1677,60 @@ FormatNumber(interp, type, src, cursorPtr)
*(*cursorPtr)++ = (unsigned char) wvalue;
}
return TCL_OK;
- default:
+
+ /*
+ * 32-bit integer values.
+ */
+ case 'i':
+ case 'I':
+ case 'n':
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') {
+ if (NeedReversing(type)) {
*(*cursorPtr)++ = (unsigned char) value;
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) (value >> 16);
*(*cursorPtr)++ = (unsigned char) (value >> 24);
- } else if (type == 'I') {
+ } else {
*(*cursorPtr)++ = (unsigned char) (value >> 24);
*(*cursorPtr)++ = (unsigned char) (value >> 16);
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) value;
}
return TCL_OK;
+
+ /*
+ * 16-bit integer values.
+ */
+ case 's':
+ case 'S':
+ case 't':
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (NeedReversing(type)) {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ } else {
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
+ }
+ return TCL_OK;
+
+ /*
+ * 8-bit integer values.
+ */
+ case 'c':
+ if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *(*cursorPtr)++ = (unsigned char) value;
+ return TCL_OK;
+
+ default:
+ Tcl_Panic("unexpected fallthrough");
+ return TCL_ERROR;
}
}
@@ -1572,6 +1764,8 @@ ScanNumber(buffer, type, numberCachePtrPtr)
* different numbers have been scanned. */
{
long value;
+ float fvalue;
+ double dvalue;
Tcl_WideUInt uwvalue;
/*
@@ -1583,92 +1777,114 @@ ScanNumber(buffer, type, numberCachePtrPtr)
*/
switch (type) {
- case 'c':
- /*
- * Characters need special handling. We want to produce a
- * signed result, but on some platforms (such as AIX) chars
- * are unsigned. To deal with this, check for a value that
- * should be negative but isn't.
- */
+ case 'c':
+ /*
+ * Characters need special handling. We want to produce a
+ * signed result, but on some platforms (such as AIX) chars
+ * are unsigned. To deal with this, check for a value that
+ * should be negative but isn't.
+ */
- value = buffer[0];
- if (value & 0x80) {
- value |= -0x100;
- }
- goto returnNumericObject;
+ value = buffer[0];
+ if (value & 0x80) {
+ value |= -0x100;
+ }
+ goto returnNumericObject;
+
+ /*
+ * 16-bit numeric values. We need the sign extension trick
+ * (see above) here as well.
+ */
- case 's':
+ case 's':
+ case 'S':
+ case 't':
+ if (NeedReversing(type)) {
value = (long) (buffer[0] + (buffer[1] << 8));
- goto shortValue;
- case 'S':
+ } else {
value = (long) (buffer[1] + (buffer[0] << 8));
- shortValue:
- if (value & 0x8000) {
- value |= -0x10000;
- }
- goto returnNumericObject;
+ }
+ if (value & 0x8000) {
+ value |= -0x10000;
+ }
+ goto returnNumericObject;
- case 'i':
+ /*
+ * 32-bit numeric values.
+ */
+
+ case 'i':
+ case 'I':
+ case 'n':
+ if (NeedReversing(type)) {
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
+ (buffer[3] << 24));
- goto intValue;
- case 'I':
+ } else {
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.
- */
+ }
+
+ /*
+ * Check to see if the value was sign extended properly on
+ * systems where an int is more than 32-bits.
+ */
+
+ if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+ value -= (((unsigned int)1)<<31);
+ value -= (((unsigned int)1)<<31);
+ }
- if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
- value -= (((unsigned int)1)<<31);
- value -= (((unsigned int)1)<<31);
+ returnNumericObject:
+
+ if (*numberCachePtrPtr == NULL) {
+ return Tcl_NewLongObj(value);
+ } else {
+ register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
+ register Tcl_HashEntry *hPtr;
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
+ if (!isNew) {
+ return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
}
- returnNumericObject:
- if (*numberCachePtrPtr == NULL) {
+ if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
+
+ /*
+ * We've overflowed the cache! Someone's parsing a
+ * LOT of varied binary data in a single call! Bail
+ * out by switching back to the old behaviour for the
+ * rest of the scan.
+ *
+ * Note that anyone just using the 'c' conversion (for
+ * bytes) cannot trigger this.
+ */
+
+ DeleteScanNumberCache(tablePtr);
+ *numberCachePtrPtr = NULL;
return Tcl_NewLongObj(value);
} else {
- register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
- register Tcl_HashEntry *hPtr;
- int isNew;
+ register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
- hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
- if (!isNew) {
- return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- }
- if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
- /*
- * We've overflowed the cache! Someone's parsing
- * a LOT of varied binary data in a single call!
- * Bail out by switching back to the old behaviour
- * for the rest of the scan.
- *
- * Note that anyone just using the 'c' conversion
- * (for bytes) cannot trigger this.
- */
- DeleteScanNumberCache(tablePtr);
- *numberCachePtrPtr = NULL;
- return Tcl_NewLongObj(value);
- } else {
- register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
-
- Tcl_IncrRefCount(objPtr);
- Tcl_SetHashValue(hPtr, (ClientData) objPtr);
- return objPtr;
- }
+ Tcl_IncrRefCount(objPtr);
+ Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+ return objPtr;
}
+ }
- /*
- * Do not cache wide values; they are already too large to
- * use as keys.
- */
- case 'w':
- uwvalue = ((Tcl_WideUInt) buffer[0])
+ /*
+ * Do not cache wide (64-bit) values; they are already too
+ * large to use as keys.
+ */
+
+ case 'w':
+ case 'W':
+ case 'm':
+ if (NeedReversing(type)) {
+ uwvalue = ((Tcl_WideUInt) buffer[0])
| (((Tcl_WideUInt) buffer[1]) << 8)
| (((Tcl_WideUInt) buffer[2]) << 16)
| (((Tcl_WideUInt) buffer[3]) << 24)
@@ -1676,9 +1892,8 @@ ScanNumber(buffer, type, numberCachePtrPtr)
| (((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)
@@ -1686,23 +1901,34 @@ ScanNumber(buffer, type, numberCachePtrPtr)
| (((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);
}
+ 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
+ * with the integer part of the cache.
+ */
+
+ /*
+ * 32-bit IEEE single-precision floating point.
+ */
+
+ case 'f':
+ case 'R':
+ case 'r':
+ CopyNumber(buffer, &fvalue, sizeof(float), type);
+ return Tcl_NewDoubleObj(fvalue);
+
+ /*
+ * 64-bit IEEE double-precision floating point.
+ */
+
+ case 'd':
+ case 'Q':
+ case 'q':
+ CopyNumber(buffer, &dvalue, sizeof(double), type);
+ return Tcl_NewDoubleObj(dvalue);
}
return NULL;
}
diff --git a/tests/binary.test b/tests/binary.test
index cf30f44..9cd63b8 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -10,12 +10,14 @@
# 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.14 2004/03/17 18:14:17 das Exp $
+# RCS: @(#) $Id: binary.test,v 1.15 2004/05/13 10:12:56 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+::tcltest::testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+::tcltest::testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
@@ -426,40 +428,40 @@ test binary-13.2 {Tcl_BinaryObjCmd: format} {
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
-test binary-13.4 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f 1.6
} \x3f\xcc\xcc\xcd
-test binary-13.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f 1.6
} \xcd\xcc\xcc\x3f
-test binary-13.6 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
-test binary-13.7 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
-test binary-13.8 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
-test binary-13.9 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
-test binary-13.10 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian {
binary format f2 {1.6 3.4 5.6}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
-test binary-13.11 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f2 {1.6 3.4 5.6}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
-test binary-13.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable unixOnly} {
+test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
binary format f -3.402825e+38
} \xff\x7f\xff\xff
-test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable pcOnly} {
+test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
binary format f -3.402825e+38
} \xff\xff\x7f\xff
-test binary-13.14 {Tcl_BinaryObjCmd: float underflow} {nonPortable unixOnly} {
+test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
binary format f -3.402825e-100
} \x80\x00\x00\x00
-test binary-13.15 {Tcl_BinaryObjCmd: float underflow} {nonPortable pcOnly} {
+test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} {
@@ -469,11 +471,11 @@ test binary-13.17 {Tcl_BinaryObjCmd: format} {
set a {1.6 3.4}
list [catch {binary format f $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
-test binary-13.18 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format f1 $a
} \x3f\xcc\xcc\xcd
-test binary-13.19 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
set a {1.6 3.4}
binary format f1 $a
} \xcd\xcc\xcc\x3f
@@ -487,31 +489,31 @@ test binary-14.2 {Tcl_BinaryObjCmd: format} {
test binary-14.3 {Tcl_BinaryObjCmd: format} {
binary format d0 1.6
} {}
-test binary-14.4 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
-test binary-14.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
-test binary-14.6 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d* {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
-test binary-14.7 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d* {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.8 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d2 {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
-test binary-14.9 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.10 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
binary format d2 {1.6 3.4 5.6}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
-test binary-14.11 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable unixOnly} {
+test binary-14.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
binary format d NaN
} \x7f\xff\xff\xff\xff\xff\xff\xff
test binary-14.14 {Tcl_BinaryObjCmd: format} {
@@ -521,11 +523,11 @@ test binary-14.15 {Tcl_BinaryObjCmd: format} {
set a {1.6 3.4}
list [catch {binary format d $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
-test binary-14.16 {Tcl_BinaryObjCmd: format} {nonPortable unixOnly} {
+test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format d1 $a
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
-test binary-14.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
+test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
set a {1.6 3.4}
binary format d1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
@@ -1066,43 +1068,43 @@ test binary-30.9 {Tcl_BinaryObjCmd: scan} {
test binary-31.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc f} msg] $msg
} {1 {not enough arguments for all format specifiers}}
-test binary-31.2 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
} {1 {1.60000002384 3.40000009537}}
-test binary-31.3 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
} {1 {1.60000002384 3.40000009537}}
-test binary-31.4 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
} {1 1.60000002384}
-test binary-31.5 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
} {1 1.60000002384}
-test binary-31.6 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
} {1 1.60000002384}
-test binary-31.7 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.60000002384}
-test binary-31.8 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
-test binary-31.9 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
-test binary-31.10 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
} {1 {1.60000002384 3.40000009537}}
-test binary-31.11 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.60000002384 3.40000009537}}
@@ -1116,13 +1118,13 @@ test binary-31.13 {Tcl_BinaryObjCmd: scan} {
set arg1 1
list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-31.14 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-31.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 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.60000002384 3.40000009537} 5}
-test binary-31.15 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
@@ -1132,43 +1134,43 @@ test binary-31.15 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
test binary-32.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc d} msg] $msg
} {1 {not enough arguments for all format specifiers}}
-test binary-32.2 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.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 d* arg1] $arg1
} {1 {1.6 3.4}}
-test binary-32.3 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.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 d* arg1] $arg1
} {1 {1.6 3.4}}
-test binary-32.4 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.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 d arg1] $arg1
} {1 1.6}
-test binary-32.5 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.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 d arg1] $arg1
} {1 1.6}
-test binary-32.6 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
} {1 1.6}
-test binary-32.7 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
} {1 1.6}
-test binary-32.8 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
catch {unset arg1}
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
} {1 {}}
-test binary-32.9 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1}
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
} {1 {}}
-test binary-32.10 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.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 d2 arg1] $arg1
} {1 {1.6 3.4}}
-test binary-32.11 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.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 d2 arg1] $arg1
} {1 {1.6 3.4}}
@@ -1182,13 +1184,13 @@ test binary-32.13 {Tcl_BinaryObjCmd: scan} {
set arg1 1
list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-32.14 {Tcl_BinaryObjCmd: scan} {nonPortable unixOnly} {
+test binary-32.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 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
-test binary-32.15 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
+test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
@@ -1348,16 +1350,16 @@ test binary-38.3 {FormatNumber: word alignment} {
test binary-38.4 {FormatNumber: word alignment} {
set x [binary format c1I1 1 1]
} \x01\x00\x00\x00\x01
-test binary-38.5 {FormatNumber: word alignment} {nonPortable unixOnly} {
+test binary-38.5 {FormatNumber: word alignment} bigEndian {
set x [binary format c1d1 1 1.6]
} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a
-test binary-38.6 {FormatNumber: word alignment} {nonPortable pcOnly} {
+test binary-38.6 {FormatNumber: word alignment} littleEndian {
set x [binary format c1d1 1 1.6]
} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f
-test binary-38.7 {FormatNumber: word alignment} {nonPortable unixOnly} {
+test binary-38.7 {FormatNumber: word alignment} bigEndian {
set x [binary format c1f1 1 1.6]
} \x01\x3f\xcc\xcc\xcd
-test binary-38.8 {FormatNumber: word alignment} {nonPortable pcOnly} {
+test binary-38.8 {FormatNumber: word alignment} littleEndian {
set x [binary format c1f1 1 1.6]
} \x01\xcd\xcc\xcc\x3f
@@ -1382,32 +1384,30 @@ test binary-39.5 {ScanNumber: sign extension} {
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-40.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+test binary-40.1 {ScanNumber: floating point overflow} {nonPortable bigEndian} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
} {1 -NaN}
-test binary-40.3 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+test binary-40.3 {ScanNumber: floating point overflow} {littleEndian pcOnly} {
catch {unset arg1}
set result [binary scan \xff\xff\xff\xff f1 arg1]
- if {([string compare $arg1 -1.\#QNAN] == 0)
- || ([string compare $arg1 -NAN] == 0)} {
+ if {[string equal $arg1 -1.\#QNAN] || [string equal $arg1 -NAN]} {
lappend result success
} else {
- lappend result failure
+ lappend result failure $arg1
}
} {1 success}
-test binary-40.4 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
+test binary-40.4 {ScanNumber: floating point overflow} {nonPortable bigEndian} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
} {1 -NaN}
-test binary-40.6 {ScanNumber: floating point overflow} {nonPortable pcOnly} {
+test binary-40.6 {ScanNumber: floating point overflow} {littleEndian pcOnly} {
catch {unset arg1}
set result [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1]
- if {([string compare $arg1 -1.\#QNAN] == 0)
- || ([string compare $arg1 -NAN] == 0)} {
+ if {[string equal $arg1 -1.\#QNAN] || [string equal $arg1 -NAN]} {
lappend result success
} else {
- lappend result failure
+ lappend result failure $arg1
}
} {1 success}
@@ -1427,19 +1427,19 @@ test binary-41.4 {ScanNumber: word alignment} {
catch {unset arg1; unset arg2}
list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} {2 1 1}
-test binary-41.5 {ScanNumber: word alignment} {nonPortable unixOnly} {
+test binary-41.5 {ScanNumber: word alignment} bigEndian {
catch {unset arg1; unset arg2}
list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.60000002384}
-test binary-41.6 {ScanNumber: word alignment} {nonPortable pcOnly} {
+test binary-41.6 {ScanNumber: word alignment} littleEndian {
catch {unset arg1; unset arg2}
list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.60000002384}
-test binary-41.7 {ScanNumber: word alignment} {nonPortable unixOnly} {
+test binary-41.7 {ScanNumber: word alignment} bigEndian {
catch {unset arg1; unset arg2}
list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
-test binary-41.8 {ScanNumber: word alignment} {nonPortable pcOnly} {
+test binary-41.8 {ScanNumber: word alignment} littleEndian {
catch {unset arg1; unset arg2}
list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
@@ -1513,6 +1513,586 @@ test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
list [binary scan aba ccc x x x] $x
} {3 97}
+### TIP#129: endian specifiers ----
+
+# 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} bigEndian {
+ binary format d NaN
+} \x7f\xff\xff\xff\xff\xff\xff\xff
+test binary-51.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable 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 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 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}
+
# cleanup
::tcltest::cleanupTests
return
generated by cgit v0.12 at 2024-11-02 03:30:55 (GMT)