Tcl Source Code

2006-10-05  Andreas Kupries  <[email protected]>

	* library/tm.tcl: Fixed bug in TIP #189 implementation, now
	  allowing '_' in module names.

2006-10-05  Jeff Hobbs  <[email protected]>

2006-10-06  Pat Thoyts  <[email protected]>

	* doc/binary.n:        TIP #275: Support unsigned values in
	* generic/tclBinary.c: binary command. Tests and documentation
	* tests/binary.test:   updated.

2006-10-05  Andreas Kupries  <[email protected]>

	* library/tm.tcl: Fixed bug in TIP #189 implementation, now
	  allowing '_' in module names.

2006-10-05  Jeff Hobbs  <[email protected]>

'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: binary.n,v 1.28 2005/12/16 11:12:31 dkf Exp $
'\" 
.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
binary \- Insert and extract fields from binary strings
................................................................................
.PP
The \fBbinary format\fR command generates a binary string whose layout
is specified by the \fIformatString\fR and whose contents come from
the additional arguments.  The resulting binary value is returned.
.PP
The \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces.  Each field specifier is
a single type character followed by an optional numeric \fIcount\fR.

Most field specifiers consume one argument to obtain the value to be
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or \fB*\fR, which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated.

.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
.PP
................................................................................
Each \fIvarName\fR gives the name of a variable; when a field is
scanned from \fIstring\fR the result is assigned to the corresponding
variable.
.PP
As with \fBbinary format\fR, the \fIformatString\fR consists of a
sequence of zero or more field specifiers separated by zero or more
spaces.  Each field specifier is a single type character followed by

an optional numeric \fIcount\fR.  Most field specifiers consume one
argument to obtain the variable into which the scanned values should
be placed.  The type character specifies how the binary data is to be
interpreted.  The \fIcount\fR typically indicates how many items of
the specified type are taken from the data.  If present, the
\fIcount\fR is a non-negative decimal integer or \fB*\fR, which
normally indicates that all of the remaining items in the data are to
be used.  If there are not enough bytes left after the current cursor
position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set.  If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated.


.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
scan subcommand:
.CS
\fBbinary scan\fR $bytes s3s first second
.CE
................................................................................
long data size values.  In doing this, values that have their high
bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints),
will be sign extended.  Thus the following will occur:
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE
If you want to produce an unsigned value, then you can mask the return 
value to the desired size.  For example, to produce an unsigned short 
value:
.CS

set val [expr { $val & 0xFFFF }]; \fI# val == 0x8000\fR
.CE
.PP
Each type-count pair moves an imaginary cursor through the binary data,
reading bytes from the current position.  The cursor is initially
at position 0 at the beginning of the data.  The type may be any one of
the following characters:
.IP \fBa\fR 5

'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\"
'\" 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.29 2006/10/06 13:37:20 patthoyts Exp $
'\" 
.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
binary \- Insert and extract fields from binary strings
................................................................................
.PP
The \fBbinary format\fR command generates a binary string whose layout
is specified by the \fIformatString\fR and whose contents come from
the additional arguments.  The resulting binary value is returned.
.PP
The \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces.  Each field specifier is
a single type character followed by an optional flag character followed
by an optional numeric \fIcount\fR.
Most field specifiers consume one argument to obtain the value to be
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or \fB*\fR, which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character
is ignored for for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
.PP
................................................................................
Each \fIvarName\fR gives the name of a variable; when a field is
scanned from \fIstring\fR the result is assigned to the corresponding
variable.
.PP
As with \fBbinary format\fR, the \fIformatString\fR consists of a
sequence of zero or more field specifiers separated by zero or more
spaces.  Each field specifier is a single type character followed by
an optional flag character followed by an optional numeric \fIcount\fR.
Most field specifiers consume one
argument to obtain the variable into which the scanned values should
be placed.  The type character specifies how the binary data is to be
interpreted.  The \fIcount\fR typically indicates how many items of
the specified type are taken from the data.  If present, the
\fIcount\fR is a non-negative decimal integer or \fB*\fR, which
normally indicates that all of the remaining items in the data are to
be used.  If there are not enough bytes left after the current cursor
position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set.  If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated. The flag character 'u'
may be given to cause some types to be read as unsigned values. The flag
is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
scan subcommand:
.CS
\fBbinary scan\fR $bytes s3s first second
.CE
................................................................................
long data size values.  In doing this, values that have their high
bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints),
will be sign extended.  Thus the following will occur:
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE
If you require unsigned values you can include the 'u' flag character following
the field type. For example, to read an unsigned short value:

.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
.CE
.PP
Each type-count pair moves an imaginary cursor through the binary data,
reading bytes from the current position.  The cursor is initially
at position 0 at the beginning of the data.  The type may be any one of
the following characters:
.IP \fBa\fR 5

 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBinary.c,v 1.29 2006/08/10 12:15:30 dkf Exp $
 */

#include "tclInt.h"


#include <math.h>

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL -1		/* Use all elements in the argument. */
#define BINARY_NOCOUNT -2	/* No count was specified in format. */








/*
 * The following defines the maximum number of different (integer) numbers
 * placed in the object cache by 'binary scan' before it bails out and
 * switches back to Plan A (creating a new object for each value.)
 * Theoretically, it would be possible to keep the cache about for the values
 * that are already in it, but that makes the code slower in practise when
 * overflow happens, and makes little odds the rest of the time (as measured
................................................................................

static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
			    int *countPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(CONST void *from, void *to,
			    unsigned int length, int type);
................................................................................
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */

    char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
................................................................................

	format = Tcl_GetString(objv[2]);
	arg = 3;
	offset = 0;
	length = 0;
	while (*format != '\0') {
	    str = format;

	    if (!GetFormatSpec(&format, &cmd, &count)) {
		break;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A':
	    case 'b':
	    case 'B':
................................................................................
	 */

	arg = 3;
	format = Tcl_GetString(objv[2]);
	cursor = buffer;
	maxPos = cursor;
	while (*format != 0) {

	    if (!GetFormatSpec(&format, &cmd, &count)) {
		break;
	    }
	    if ((count == 0) && (cmd != '@')) {
		arg++;
		continue;
	    }
	    switch (cmd) {
................................................................................
	buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
	format = Tcl_GetString(objv[3]);
	cursor = buffer;
	arg = 4;
	offset = 0;
	while (*format != '\0') {
	    str = format;

	    if (!GetFormatSpec(&format, &cmd, &count)) {
		goto done;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A': {
		unsigned char *src;

................................................................................
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_NOCOUNT) {
		    if ((length - offset) < size) {
			goto done;
		    }
		    valuePtr = ScanNumber(buffer+offset, cmd, &numberCachePtr);
		    offset += size;
		} else {
		    if (count == BINARY_ALL) {
			count = (length - offset) / size;
		    }
		    if ((length - offset) < (count * size)) {
			goto done;
		    }
		    valuePtr = Tcl_NewObj();
		    src = buffer+offset;
		    for (i = 0; i < count; i++) {
			elementPtr = ScanNumber(src, cmd, &numberCachePtr);
			src += size;
			Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
		    }
		    offset += count*size;
		}

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
................................................................................
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    char **formatPtr,		/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    int *countPtr)		/* Pointer to repeat count value. */

{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {
	(*formatPtr)++;
................................................................................

    /*
     * Extract the command character and any trailing digits or '*'.
     */

    *cmdPtr = **formatPtr;
    (*formatPtr)++;




    if (**formatPtr == '*') {
	(*formatPtr)++;
	(*countPtr) = BINARY_ALL;
    } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
	(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
    } else {
	(*countPtr) = BINARY_NOCOUNT;
................................................................................
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */

    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
................................................................................

    /*
     * We cannot rely on the compiler to properly sign extend integer values
     * when we cast from smaller values to larger values because we don't know
     * the exact size of the integer types. So, we have to handle sign
     * extension explicitly by checking the high bit and padding with 1's as
     * needed.

     */

    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.
	 */

	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 't':
	if (NeedReversing(type)) {
	    value = (long) (buffer[0] + (buffer[1] << 8));
	} else {
	    value = (long) (buffer[1] + (buffer[0] << 8));
	}

	if (value & 0x8000) {
	    value |= -0x10000;

	}
	goto returnNumericObject;

	/*
	 * 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));
	} else {
	    value = (long) (buffer[3]
		    + (buffer[2] << 8)
		    + (buffer[1] << 16)
		    + (buffer[0] << 24));
	}

	/*
	 * 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);

	}

    returnNumericObject:

	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
................................................................................
		    | (((Tcl_WideUInt) buffer[5]) << 16)
		    | (((Tcl_WideUInt) buffer[4]) << 24)
		    | (((Tcl_WideUInt) buffer[3]) << 32)
		    | (((Tcl_WideUInt) buffer[2]) << 40)
		    | (((Tcl_WideUInt) buffer[1]) << 48)
		    | (((Tcl_WideUInt) buffer[0]) << 56);
	}








	return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);


	/*
	 * 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.
	 */

 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.30 2006/10/06 13:37:21 patthoyts Exp $
 */

#include "tclInt.h"
#include "tclTomMath.h"

#include <math.h>

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL -1		/* Use all elements in the argument. */
#define BINARY_NOCOUNT -2	/* No count was specified in format. */

/*
 * The following flags may be ORed together and returned by GetFormatSpec
 */

#define BINARY_SIGNED 0		/* Field to be read as signed data */
#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */

/*
 * The following defines the maximum number of different (integer) numbers
 * placed in the object cache by 'binary scan' before it bails out and
 * switches back to Plan A (creating a new object for each value.)
 * Theoretically, it would be possible to keep the cache about for the values
 * that are already in it, but that makes the code slower in practise when
 * overflow happens, and makes little odds the rest of the time (as measured
................................................................................

static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
			    int *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(CONST void *from, void *to,
			    unsigned int length, int type);
................................................................................
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
................................................................................

	format = Tcl_GetString(objv[2]);
	arg = 3;
	offset = 0;
	length = 0;
	while (*format != '\0') {
	    str = format;
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		break;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A':
	    case 'b':
	    case 'B':
................................................................................
	 */

	arg = 3;
	format = Tcl_GetString(objv[2]);
	cursor = buffer;
	maxPos = cursor;
	while (*format != 0) {
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		break;
	    }
	    if ((count == 0) && (cmd != '@')) {
		arg++;
		continue;
	    }
	    switch (cmd) {
................................................................................
	buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
	format = Tcl_GetString(objv[3]);
	cursor = buffer;
	arg = 4;
	offset = 0;
	while (*format != '\0') {
	    str = format;
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		goto done;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A': {
		unsigned char *src;

................................................................................
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_NOCOUNT) {
		    if ((length - offset) < size) {
			goto done;
		    }
		    valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr);
		    offset += size;
		} else {
		    if (count == BINARY_ALL) {
			count = (length - offset) / size;
		    }
		    if ((length - offset) < (count * size)) {
			goto done;
		    }
		    valuePtr = Tcl_NewObj();
		    src = buffer+offset;
		    for (i = 0; i < count; i++) {
			elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr);
			src += size;
			Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
		    }
		    offset += count*size;
		}

		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
................................................................................
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    char **formatPtr,		/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    int *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {
	(*formatPtr)++;
................................................................................

    /*
     * Extract the command character and any trailing digits or '*'.
     */

    *cmdPtr = **formatPtr;
    (*formatPtr)++;
    if (**formatPtr == 'u') {
	(*formatPtr)++;
	(*flagsPtr) |= BINARY_UNSIGNED;
    }
    if (**formatPtr == '*') {
	(*formatPtr)++;
	(*countPtr) = BINARY_ALL;
    } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
	(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
    } else {
	(*countPtr) = BINARY_NOCOUNT;
................................................................................
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
................................................................................

    /*
     * We cannot rely on the compiler to properly sign extend integer values
     * when we cast from smaller values to larger values because we don't know
     * the exact size of the integer types. So, we have to handle sign
     * extension explicitly by checking the high bit and padding with 1's as
     * needed.
     * This practice is disabled if the BINARY_UNSIGNED flag is set.
     */

    switch (type) {
    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 (!(flags & BINARY_UNSIGNED)) {
	    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 't':
	if (NeedReversing(type)) {
	    value = (long) (buffer[0] + (buffer[1] << 8));
	} else {
	    value = (long) (buffer[1] + (buffer[0] << 8));
	}
	if (!(flags & BINARY_UNSIGNED)) {
	    if (value & 0x8000) {
		value |= -0x10000;
	    }
	}
	goto returnNumericObject;

	/*
	 * 32-bit numeric values.
	 */

................................................................................
    case 'i':
    case 'I':
    case 'n':
	if (NeedReversing(type)) {
	    value = (long) (buffer[0]
		    + (buffer[1] << 8)
		    + (buffer[2] << 16)
		    + (((long)buffer[3]) << 24));
	} else {
	    value = (long) (buffer[3]
		    + (buffer[2] << 8)
		    + (buffer[1] << 16)
		    + (((long)buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.
	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if ((flags & BINARY_UNSIGNED)) {
	    return Tcl_NewWideIntObj((unsigned long)value);
	} else {
	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
		value -= (((unsigned int)1)<<31);
		value -= (((unsigned int)1)<<31);
	    }
	}

    returnNumericObject:

	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
................................................................................
		    | (((Tcl_WideUInt) buffer[5]) << 16)
		    | (((Tcl_WideUInt) buffer[4]) << 24)
		    | (((Tcl_WideUInt) buffer[3]) << 32)
		    | (((Tcl_WideUInt) buffer[2]) << 40)
		    | (((Tcl_WideUInt) buffer[1]) << 48)
		    | (((Tcl_WideUInt) buffer[0]) << 56);
	}
	if (flags & BINARY_UNSIGNED) {
	    Tcl_Obj *bigObj = NULL;
	    mp_int big;

	    TclBNInitBignumFromWideUInt(&big, uwvalue);
	    bigObj = Tcl_NewBignumObj(&big);
	    return bigObj;
	} else {
	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
	}

	/*
	 * Do not cache double values; they are already too large to use as
	 * keys and the values stored are utterly incompatible with the
	 * integer part of the cache.
	 */

#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: binary.test,v 1.28 2006/04/05 15:17:39 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-26.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 -121} 5}

























test binary-27.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc s} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}

















test binary-28.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc S} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}









test binary-29.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc i} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-29.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 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}













test binary-30.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc I} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-30.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 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}













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} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
................................................................................
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}





















test binary-40.3 {ScanNumber: NaN} \
    -body {
	catch {unset arg1}
	list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
    } \
    -match glob \
................................................................................
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944





















test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
................................................................................
} {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}
................................................................................
} {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}
................................................................................
} {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}
................................................................................
} {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}

#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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.29 2006/10/06 13:37:21 patthoyts Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-26.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 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu* arg1] $arg1
} {1 {82 163}}
test binary-26.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu arg1] $arg1
} {1 82}
test binary-26.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xff cu arg1] $arg1
} {1 255}
test binary-26.14 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
} {2 128 -128}
test binary-26.15 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
} {2 -128 128}

test binary-27.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc s} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
} {1 {41810 21587}}
test binary-27.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
} {2 65535 -1}
test binary-27.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
} {2 -1 65535}

test binary-28.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc S} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
} {1 {21155 21332}}
test binary-28.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
} {1 {41810 21587}}

test binary-29.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc i} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-29.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 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-29.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-29.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
} {2 128 2147483648}

test binary-30.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc I} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
................................................................................
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-30.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 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-30.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-30.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
} {2 2147483648 128}

test binary-31.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc f} msg] $msg
} {1 {not enough arguments for all format specifiers}}
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
................................................................................
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
test binary-39.6 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu2 arg1] $arg1
} {1 {82 163}}
test binary-39.7 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
} {1 {513 33025 386 33409}}
test binary-39.8 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
} {1 {258 385 33281 33154}}
test binary-39.9 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 2164326657}}
test binary-39.10 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
} {1 {16843010 2164326657 25297153 16876033 16843137}}

test binary-40.3 {ScanNumber: NaN} \
    -body {
	catch {unset arg1}
	list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
    } \
    -match glob \
................................................................................
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    catch {unset arg1}
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1}
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1}
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1 arg2}
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1 arg2}
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}

test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
................................................................................
} {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}
test binary-55.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-55.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan t (b)
test binary-55.1 {Tcl_BinaryObjCmd: scan} {
    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}
................................................................................
} {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}
test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan n (s)
test binary-56.1 {Tcl_BinaryObjCmd: scan} {
    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}
................................................................................
} {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}
test binary-57.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
test binary-57.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}

# scan n (b)
test binary-57.1 {Tcl_BinaryObjCmd: scan} {
    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}
................................................................................
} {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}
test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 128 128}

# scan Q/q
test binary-58.1 {Tcl_BinaryObjCmd: scan} {
    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}