Hello,
in the attachment there is an implementation of the binary command
based on the sources of Jacl1.2.5:
There are BinaryCmd.java and TclByteArray.java, both are new files
belonging into jacl1.2.5/src/jacl/tcl/lang. The former is the
implementation of the Command for binary, the latter is a new
InternalRep for byte arrays.
Finally there is a patch for jacl1.2.5/src/jacl/tcl/lang/Interp.java,
which announces the new command to the interpreter, and a copy of the
tcl8.2 test file binary.test, which belongs into jacl1.2.5/tests/tcl.
Have fun, Krischan
--
Christian Krone, SQL Datenbanksysteme GmbH
/*
* BinaryCmd.java --
*
* Implements the built-in "binary" Tcl command.
*
* Copyright (c) 1999 Christian Krone.
* 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$
*
*/
package tcl.lang;
import java.text.*;
/*
* This class implements the built-in "binary" command in Tcl.
*/
class BinaryCmd implements Command {
static final private String validCmds[] = {
"format",
"scan",
};
static final private int CMD_FORMAT = 0;
static final private int CMD_SCAN = 1;
// The following constants are used by GetFormatSpec to indicate various
// special conditions in the parsing of a format specifier.
// Use all elements in the argument.
static final private int BINARY_ALL = -1;
// No count was specified in format.
static final private int BINARY_NOCOUNT = -2;
// End of format was found.
static final private char FORMAT_END = ' ';
/*
*----------------------------------------------------------------------
*
* cmdProc --
*
* This procedure is invoked as part of the Command interface to
* process the "binary" Tcl command. See the user documentation
* for details on what it does.
*
* Results:
* None.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
public void
cmdProc(
Interp interp, // Current interpreter.
TclObject[] argv) // Argument list.
throws
TclException // A standard Tcl exception.
{
int arg; // Index of next argument to consume.
char[] format = null; // User specified format string.
char cmd; // Current format character.
int cursor; // Current position within result buffer.
int maxPos; // Greatest position within result buffer that
// cursor has visited.
int value = 0; // Current integer value to be packed.
// Initialized to avoid compiler warning.
int offset, size = 0, length, index;
if (argv.length < 2) {
throw new TclNumArgsException(interp, 1, argv,
"option ?arg arg ...?");
}
int cmdIndex = TclIndex.get(interp, argv[1], validCmds, "option", 0);
switch (cmdIndex) {
case CMD_FORMAT: {
if (argv.length < 3) {
throw new TclNumArgsException(interp, 2, argv,
"formatString ?arg arg ...?");
}
// To avoid copying the data, we format the string in two passes.
// The first pass computes the size of the output buffer. The
// second pass places the formatted data into the buffer.
format = argv[2].toString().toCharArray();
arg = 3;
length = 0;
offset = 0;
ParsePosition parsePos = new ParsePosition(0);
while ((cmd = GetFormatSpec(format, parsePos)) != FORMAT_END) {
int count = GetFormatCount(format, parsePos);
switch (cmd) {
case 'a':
case 'A':
case 'b':
case 'B':
case 'h':
case 'H': {
// For string-type specifiers, the count corresponds
// to the number of bytes in a single argument.
if (arg >= argv.length) {
missingArg(interp);
}
if (count == BINARY_ALL) {
count = TclByteArray.getLength(interp, argv[arg]);
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
arg++;
switch (cmd) {
case 'a': case 'A': offset += count; break;
case 'b': case 'B': offset += (count+7)/8; break;
case 'h': case 'H': offset += (count+1)/2; break;
}
break;
}
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd': {
if (arg >= argv.length) {
missingArg(interp);
}
switch (cmd) {
case 'c': size = 1; break;
case 's': case 'S': size = 2; break;
case 'i': case 'I': size = 4; break;
case 'f': size = 4; break;
case 'd': size = 8; break;
}
// For number-type specifiers, the count corresponds
// to the number of elements in the list stored in
// a single argument. If no count is specified, then
// the argument is taken as a single non-list value.
if (count == BINARY_NOCOUNT) {
arg++;
count = 1;
} else {
int listc = TclList.getLength(interp, argv[arg++]);
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
throw new TclException(interp,
"number of elements in list"
+ " does not match count");
}
}
offset += count*size;
break;
}
case 'x': {
if (count == BINARY_ALL) {
throw new TclException(interp, "cannot use \"*\""
+ " in format string with \"x\"");
}
if (count == BINARY_NOCOUNT) {
count = 1;
}
offset += count;
break;
}
case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if ((count > offset) || (count == BINARY_ALL)) {
count = offset;
}
if (offset > length) {
length = offset;
}
offset -= count;
break;
}
case '@': {
if (offset > length) {
length = offset;
}
if (count == BINARY_ALL) {
offset = length;
} else if (count == BINARY_NOCOUNT) {
alephWithoutCount(interp);
} else {
offset = count;
}
break;
}
default: {
badField(interp, cmd);
}
}
}
if (offset > length) {
length = offset;
}
if (length == 0) {
return;
}
// Prepare the result object by preallocating the calculated
// number of bytes and filling with nulls.
TclObject resultObj = TclByteArray.newInstance();
byte[] resultBytes = TclByteArray.setLength(interp,
resultObj, length);
interp.setResult(resultObj);
// Pack the data into the result object. Note that we can skip
// the error checking during this pass, since we have already
// parsed the string once.
arg = 3;
cursor = 0;
maxPos = cursor;
parsePos.setIndex(0);
while ((cmd = GetFormatSpec(format, parsePos)) != FORMAT_END) {
int count = GetFormatCount(format, parsePos);
if ((count == 0) && (cmd != '@')) {
arg++;
continue;
}
switch (cmd) {
case 'a':
case 'A': {
byte pad = cmd == 'a' ? 0 : (byte) ' ';
byte[] bytes = TclByteArray.getBytes(interp,
argv[arg++]);
length = bytes.length;
if (count == BINARY_ALL) {
count = length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
if (length >= count) {
System.arraycopy(bytes, 0,
resultBytes, cursor, count);
} else {
System.arraycopy(bytes, 0,
resultBytes, cursor, length);
for (int ix = 0; ix < count-length; ix++) {
resultBytes[cursor+length+ix] = pad;
}
}
cursor += count;
break;
}
case 'b':
case 'B': {
char[] str = argv[arg++].toString().toCharArray();
if (count == BINARY_ALL) {
count = str.length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
int last = cursor + ((count + 7) / 8);
if (count > str.length) {
count = str.length;
}
if (cmd == 'B') {
for (offset = 0; offset < count; offset++) {
value <<= 1;
if (str[offset] == '1') {
value |= 1;
} else if (str[offset] != '0') {
expectedButGot(interp, "binary",
new String(str));
}
if (((offset + 1) % 8) == 0) {
resultBytes[cursor++] = (byte) value;
value = 0;
}
}
} else {
for (offset = 0; offset < count; offset++) {
value >>= 1;
if (str[offset] == '1') {
value |= 128;
} else if (str[offset] != '0') {
expectedButGot(interp, "binary",
new String(str));
}
if (((offset + 1) % 8) == 0) {
resultBytes[cursor++] = (byte) value;
value = 0;
}
}
}
if ((offset % 8) != 0) {
if (cmd == 'B') {
value <<= 8 - (offset % 8);
} else {
value >>= 8 - (offset % 8);
}
resultBytes[cursor++] = (byte) value;
}
while (cursor < last) {
resultBytes[cursor++] = 0;
}
break;
}
case 'h':
case 'H': {
char[] str = argv[arg++].toString().toCharArray();
if (count == BINARY_ALL) {
count = str.length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
int last = cursor + ((count + 1) / 2);
if (count > str.length) {
count = str.length;
}
if (cmd == 'H') {
for (offset = 0; offset < count; offset++) {
value <<= 4;
int c = Character.digit(str[offset], 16);
if (c < 0) {
expectedButGot(interp, "hexadecimal",
new String(str));
}
value |= (c & 0xf);
if ((offset % 2) != 0) {
resultBytes[cursor++] = (byte) value;
value = 0;
}
}
} else {
for (offset = 0; offset < count; offset++) {
value >>= 4;
int c = Character.digit(str[offset], 16);
if (c < 0) {
expectedButGot(interp, "hexadecimal",
new String(str));
}
value |= ((c << 4) & 0xf0);
if ((offset % 2) != 0) {
resultBytes[cursor++] = (byte) value;
value = 0;
}
}
}
if ((offset % 2) != 0) {
if (cmd == 'H') {
value <<= 4;
} else {
value >>= 4;
}
resultBytes[cursor++] = (byte) value;
}
while (cursor < last) {
resultBytes[cursor++] = 0;
}
break;
}
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd': {
TclObject[] listv;
if (count == BINARY_NOCOUNT) {
listv = new TclObject[1];
listv[0] = argv[arg++];
count = 1;
} else {
listv = TclList.getElements(interp, argv[arg++]);
if (count == BINARY_ALL) {
count = listv.length;
}
}
for (int ix = 0; ix < count; ix++) {
cursor = FormatNumber(interp, cmd, listv[ix],
resultBytes, cursor);
}
break;
}
case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
for (int ix = 0; ix < count; ix++) {
resultBytes[cursor++] = 0;
}
break;
}
case 'X': {
if (cursor > maxPos) {
maxPos = cursor;
}
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count == BINARY_ALL || count > cursor) {
cursor = 0;
} else {
cursor -= count;
}
break;
}
case '@': {
if (cursor > maxPos) {
maxPos = cursor;
}
if (count == BINARY_ALL) {
cursor = maxPos;
} else {
cursor = count;
}
break;
}
}
}
break;
}
case CMD_SCAN: {
if (argv.length < 4) {
throw new TclNumArgsException(interp, 2, argv,
"value formatString ?varName varName ...?");
}
byte[] src = TclByteArray.getBytes(interp, argv[2]);
length = src.length;
format = argv[3].toString().toCharArray();
arg = 4;
cursor = 0;
offset = 0;
ParsePosition parsePos = new ParsePosition(0);
while ((cmd = GetFormatSpec(format, parsePos)) != FORMAT_END) {
int count = GetFormatCount(format, parsePos);
switch (cmd) {
case 'a':
case 'A': {
if (arg >= argv.length) {
missingArg(interp);
}
if (count == BINARY_ALL) {
count = length - offset;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > length - offset) {
break;
}
}
size = count;
// Trim trailing nulls and spaces, if necessary.
if (cmd == 'A') {
while (size > 0) {
if (src[offset+size-1] != '\0'
&& src[offset+size-1] != ' ') {
break;
}
size--;
}
}
interp.setVar(argv[arg++],
TclByteArray.newInstance(src, offset, size), 0);
offset += count;
break;
}
case 'b':
case 'B': {
if (arg >= argv.length) {
missingArg(interp);
}
if (count == BINARY_ALL) {
count = (length - offset) * 8;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > (length - offset) * 8) {
break;
}
}
StringBuffer s = new StringBuffer(count);
int thisOffset = offset;
if (cmd == 'b') {
for (int ix = 0; ix < count; ix++) {
if ((ix % 8) != 0) {
value >>= 1;
} else {
value = src[thisOffset++];
}
s.append((value & 1) != 0 ? '1' : '0');
}
} else {
for (int ix = 0; ix < count; ix++) {
if ((ix % 8) != 0) {
value <<= 1;
} else {
value = src[thisOffset++];
}
s.append((value & 0x80) != 0 ? '1' : '0');
}
}
interp.setVar(argv[arg++],
TclString.newInstance(s.toString()), 0);
offset += (count + 7 ) / 8;
break;
}
case 'h':
case 'H': {
if (arg >= argv.length) {
missingArg(interp);
}
if (count == BINARY_ALL) {
count = (length - offset)*2;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > (length - offset)*2) {
break;
}
}
StringBuffer s = new StringBuffer(count);
int thisOffset = offset;
if (cmd == 'h') {
for (int ix = 0; ix < count; ix++) {
if ((ix % 2) != 0) {
value >>= 4;
} else {
value = src[thisOffset++];
}
s.append(Character.forDigit(
value & 0xf, 16));
}
} else {
for (int ix = 0; ix < count; ix++) {
if ((ix % 2) != 0) {
value <<= 4;
} else {
value = src[thisOffset++];
}
s.append(Character.forDigit(
value >> 4 & 0xf, 16));
}
}
interp.setVar(argv[arg++],
TclString.newInstance(s.toString()), 0);
offset += (count + 1) / 2;
break;
}
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'f':
case 'd': {
if (arg >= argv.length) {
missingArg(interp);
}
switch (cmd) {
case 'c': size = 1; break;
case 's': case 'S': size = 2; break;
case 'i': case 'I': size = 4; break;
case 'f': size = 4; break;
case 'd': size = 8; break;
}
TclObject valueObj;
if (count == BINARY_NOCOUNT) {
if (length - offset < size) {
break;
}
valueObj = ScanNumber(src, offset, cmd);
offset += size;
} else {
if (count == BINARY_ALL) {
count = (length - offset) / size;
}
if (length - offset < count * size) {
break;
}
valueObj = TclList.newInstance();
int thisOffset = offset;
for (int ix = 0; ix < count; ix++) {
TclList.append(null, valueObj,
ScanNumber(src, thisOffset, cmd));
thisOffset += size;
}
offset += count*size;
}
interp.setVar(argv[arg++], valueObj, 0);
break;
}
case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count == BINARY_ALL || count > length - offset) {
offset = length;
} else {
offset += count;
}
break;
}
case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count == BINARY_ALL || count > offset) {
offset = 0;
} else {
offset -= count;
}
break;
}
case '@': {
if (count == BINARY_NOCOUNT) {
alephWithoutCount(interp);
}
if (count == BINARY_ALL || count > length) {
offset = length;
} else {
offset = count;
}
break;
}
default: {
badField(interp, cmd);
}
}
}
// Set the result to the last position of the cursor.
interp.setResult(arg-4);
}
}
}
/*
*----------------------------------------------------------------------
*
* GetFormatSpec --
*
* This function parses the format strings used in the binary
* format and scan commands.
*
* Results:
* Moves the parsePos to the start of the next command. Returns
* the current command character or FORMAT_END if the string did
* not have a format specifier.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
private char
GetFormatSpec(
char[] format, // Format string.
ParsePosition parsePos) // Current position in input.
{
int ix = parsePos.getIndex();
// Skip any leading blanks.
while (ix < format.length && format[ix] == ' ') {
ix++;
}
// The string was empty, except for whitespace, so fail.
if (ix >= format.length) {
parsePos.setIndex(ix);
return FORMAT_END;
}
// Extract the command character.
parsePos.setIndex(ix+1);
return format[ix++];
}
/*
*----------------------------------------------------------------------
*
* GetFormatCount --
*
* This function parses the format strings used in the binary
* format and scan commands.
*
* Results:
* Moves the formatPtr to the start of the next command. Returns
* the current command count. The count is set to BINARY_ALL if the
* count character was '*' or BINARY_NOCOUNT if no count was
* specified.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
private int
GetFormatCount(
char[] format, // Format string.
ParsePosition parsePos) // Current position in input.
{
int ix = parsePos.getIndex();
// Extract any trailing digits or '*'.
if (ix < format.length && format[ix] == '*') {
parsePos.setIndex(ix+1);
return BINARY_ALL;
} else if (ix < format.length && Character.isDigit(format[ix])) {
int length = 1;
while (ix+length < format.length
&& Character.isDigit(format[ix+length])) {
length++;
}
parsePos.setIndex(ix+length);
return Integer.parseInt(new String(format, ix, length));
} else {
return BINARY_NOCOUNT;
}
}
/**
*----------------------------------------------------------------------
*
* FormatNumber --
*
* This method is called by the binary cmdProc to format a number
* into a location pointed at by cursor.
*
* Results:
* None
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
FormatNumber(
Interp interp, // Current interpreter.
char type, // Type of number to format.
TclObject src, // Number to format.
byte[] resultBytes,
int cursor)
throws
TclException // A standard Tcl exception.
{
if (type == 'd') {
double dvalue = TclDouble.get(interp, src);
long lvalue = Double.doubleToLongBits(dvalue);
for (int ix = 7; ix >= 0; ix--) {
resultBytes[cursor++] = (byte) (lvalue >> ix*8);
}
} else if (type == 'f') {
float fvalue = (float) TclDouble.get(interp, src);
int ivalue = Float.floatToIntBits(fvalue);
for (int ix = 3; ix >= 0; ix--) {
resultBytes[cursor++] = (byte) (ivalue >> ix*8);
}
} else {
int value = TclInteger.get(interp, src);
if (type == 'c') {
resultBytes[cursor++] = (byte) value;
} else if (type == 's') {
resultBytes[cursor++] = (byte) value;
resultBytes[cursor++] = (byte) (value >> 8);
} else if (type == 'S') {
resultBytes[cursor++] = (byte) (value >> 8);
resultBytes[cursor++] = (byte) value;
} else if (type == 'i') {
resultBytes[cursor++] = (byte) value;
resultBytes[cursor++] = (byte) (value >> 8);
resultBytes[cursor++] = (byte) (value >> 16);
resultBytes[cursor++] = (byte) (value >> 24);
} else if (type == 'I') {
resultBytes[cursor++] = (byte) (value >> 24);
resultBytes[cursor++] = (byte) (value >> 16);
resultBytes[cursor++] = (byte) (value >> 8);
resultBytes[cursor++] = (byte) value;
}
}
return cursor;
}
/**
*----------------------------------------------------------------------
*
* ScanNumber --
*
* This routine is called by Tcl_BinaryObjCmd to scan a number
* out of a buffer.
*
* Results:
* Returns a newly created object containing the scanned number.
* This object has a ref count of zero.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
private static TclObject
ScanNumber(
byte[] src, // Buffer to scan number from.
int pos, //
int type) // Format character from "binary scan"
{
switch (type) {
case 'c': {
return TclInteger.newInstance((int) src[pos]);
}
case 's': {
short value = (short)
((src[pos] & 0xff) +
((src[pos+1] & 0xff) << 8));
return TclInteger.newInstance((int) value);
}
case 'S': {
short value = (short)
((src[pos+1] & 0xff) +
((src[pos] & 0xff) << 8));
return TclInteger.newInstance((int) value);
}
case 'i': {
int value = (src[pos] & 0xff) +
((src[pos+1] & 0xff) << 8) +
((src[pos+2] & 0xff) << 16) +
((src[pos+3] & 0xff) << 24);
return TclInteger.newInstance(value);
}
case 'I': {
int value = (src[pos+3] & 0xff) +
((src[pos+2] & 0xff) << 8) +
((src[pos+1] & 0xff) << 16) +
((src[pos] & 0xff) << 24);
return TclInteger.newInstance(value);
}
case 'f': {
int value = (src[pos+3] & 0xff) +
((src[pos+2] & 0xff) << 8) +
((src[pos+1] & 0xff) << 16) +
((src[pos] & 0xff) << 24);
return TclDouble.newInstance(
Float.intBitsToFloat(value));
}
case 'd': {
long value = (src[pos+7] & 0xff) +
((src[pos+6] & 0xff) << 8) +
((src[pos+5] & 0xff) << 16) +
((src[pos+4] & 0xff) << 24) +
((src[pos+3] & 0xff) << 32) +
((src[pos+2] & 0xff) << 40) +
((src[pos+1] & 0xff) << 48) +
((src[pos] & 0xff) << 56);
return TclDouble.newInstance(
Double.longBitsToDouble(value));
}
}
return null;
}
/**
* Called whenever a format specifier was detected
* but there are not enough arguments specified.
*
* @param interp - The TclInterp which called the cmdProc method.
*/
private static void missingArg(
Interp interp) // Current interpreter.
throws
TclException // A standard Tcl exception.
{
throw new TclException(interp,
"not enough arguments for all format specifiers");
}
/**
* Called whenever an invalid format specifier was detected.
*
* @param interp - The TclInterp which called the cmdProc method.
* @param cmd - The invalid field specifier.
*/
private static void badField(
Interp interp, // Current interpreter.
char cmd) // the invalid field specifier.
throws
TclException // A standard Tcl exception.
{
throw new TclException(interp,
"bad field specifier \"" + cmd + "\"");
}
/**
* Called whenever a letter aleph character (@) was detected
* but there was no count specified.
*
* @param interp - The TclInterp which called the cmdProc method.
*/
private static void alephWithoutCount(
Interp interp) // Current interpreter.
throws
TclException // A standard Tcl exception.
{
throw new TclException(interp,
"missing count for \"@\" field specifier");
}
/**
* Called whenever a format was found which restricts the valid range
* of characters in the specified string, but the string contains
* at least one char not in this range.
*
* @param interp - The TclInterp which called the cmdProc method.
*/
private static void expectedButGot(
Interp interp, // Current interpreter.
String expected, // Classification of what was expected.
String str) // Was was found instead.
throws
TclException // A standard Tcl exception.
{
throw new TclException(interp,
"expected " + expected + " string but got \""
+ str + "\" instead");
}
} // end BinaryCmd
/*
* TclByteArray.java
*
* This class contains the implementation of the Jacl binary data object.
*
* Copyright (c) 1999 Christian Krone.
* Copyright (c) 1997 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$
*
*/
package tcl.lang;
import java.io.*;
/**
* This class implements the binary data object type in Tcl.
*/
public class TclByteArray extends InternalRep {
/**
* The number of bytes used in the byte array.
* The following structure is the internal rep for a ByteArray object.
* Keeps track of how much memory has been used. This can be different from
* how much has been allocated for the byte array to enable growing and
* shrinking of the ByteArray object with fewer allocations.
*/
private int used;
/**
* Internal representation of the binary data.
*/
private byte[] bytes;
/**
* Create a new empty Tcl binary data.
*/
private TclByteArray() {
used = 0;
bytes = new byte[0];
}
/**
* Create a new Tcl binary data.
*/
private TclByteArray(byte[] b) {
used = b.length;
bytes = new byte[used];
System.arraycopy(b, 0, bytes, 0, used);
}
/**
* Create a new Tcl binary data.
*/
private TclByteArray(byte[] b, int position, int length) {
used = length;
bytes = new byte[used];
System.arraycopy(b, position, bytes, 0, used);
}
/**
* Create a new Tcl binary data.
*/
private TclByteArray(char[] c) {
used = c.length;
bytes = new byte[used];
for (int ix = 0; ix < used; ix++) {
bytes[ix] = (byte) c[ix];
}
}
/**
* Returns a duplicate of the current object.
*
* @param obj the TclObject that contains this internalRep.
*/
protected InternalRep duplicate() {
return new TclByteArray(bytes, 0, used);
}
/**
* Called to query the string representation of the Tcl object. This
* method is called only by TclObject.toString() when
* TclObject.stringRep is null.
*
* @return the string representation of the Tcl object.
*/
public String toString() {
char[] c = new char[used];
for (int ix = 0; ix < used; ix++) {
c[ix] = (char) bytes[ix];
}
return new String(c);
}
/**
* Creates a new instance of a TclObject with a TclByteArray internal
* rep.
*
* @return the TclObject with the given byte array value.
*/
public static TclObject newInstance(byte[] b, int position, int length) {
return new TclObject(new TclByteArray(b, position, length));
}
/**
* Creates a new instance of a TclObject with a TclByteArray internal
* rep.
*
* @return the TclObject with the given byte array value.
*/
public static TclObject newInstance(byte[] b) {
return new TclObject(new TclByteArray(b));
}
/**
* Creates a new instance of a TclObject with an empty TclByteArray
* internal rep.
*
* @return the TclObject with the empty byte array value.
*/
public static TclObject newInstance() {
return new TclObject(new TclByteArray());
}
/**
* Called to convert the other object's internal rep to a ByteArray.
*
* @param interp current interpreter.
* @param tobj the TclObject to convert to use the ByteArray internal rep.
* @exception TclException if the object doesn't contain a valid ByteArray.
*/
static void setByteArrayFromAny(Interp interp, TclObject tobj)
throws TclException {
InternalRep rep = tobj.getInternalRep();
if (!(rep instanceof TclByteArray)) {
char[] c = tobj.toString().toCharArray();
tobj.setInternalRep(new TclByteArray(c));
}
}
/**
*
* This method changes the length of the byte array for this
* object. Once the caller has set the length of the array, it
* is acceptable to directly modify the bytes in the array up until
* Tcl_GetStringFromObj() has been called on this object.
*
* Results:
* The new byte array of the specified length.
*
* Side effects:
* Allocates enough memory for an array of bytes of the requested
* size. When growing the array, the old array is copied to the
* new array; new bytes are undefined. When shrinking, the
* old array is truncated to the specified length.
*/
public static byte[] setLength(Interp interp, TclObject tobj, int length)
throws TclException {
setByteArrayFromAny(interp, tobj);
TclByteArray tbyteArray = (TclByteArray) tobj.getInternalRep();
if (length > tbyteArray.bytes.length) {
byte[] newBytes = new byte[length];
System.arraycopy(tbyteArray.bytes, 0, newBytes, 0, tbyteArray.used);
tbyteArray.bytes = newBytes;
}
tbyteArray.used = length;
return tbyteArray.bytes;
}
/**
* Queries the length of the byte array. If tobj is not a byte array
* object, an attempt will be made to convert it to a byte array.
*
* @param interp current interpreter.
* @param tobj the TclObject to use as a byte array.
* @return the length of the byte array.
* @exception TclException if tobj is not a valid byte array.
*/
public static final int getLength(Interp interp, TclObject tobj)
throws TclException {
setByteArrayFromAny(interp, tobj);
TclByteArray tbyteArray = (TclByteArray) tobj.getInternalRep();
return tbyteArray.used;
}
/**
* Returns the bytes of a ByteArray object. If tobj is not a ByteArray
* object, an attempt will be made to convert it to a ByteArray. <p>
*
* @param interp the current interpreter.
* @param tobj the byte array object.
* @return a byte array.
* @exception TclException if tobj is not a valid ByteArray.
*/
public static byte[] getBytes(Interp interp, TclObject tobj)
throws TclException {
setByteArrayFromAny(interp, tobj);
TclByteArray tbyteArray = (TclByteArray) tobj.getInternalRep();
return tbyteArray.bytes;
}
}
*** Interp.java.rec Thu Nov 25 15:20:56 1999
--- Interp.java Mon Dec 6 10:50:39 1999
***************
*** 556,561 ****
--- 556,562 ----
Extension.loadOnDemand(this, "after", "tcl.lang.AfterCmd");
Extension.loadOnDemand(this, "append", "tcl.lang.AppendCmd");
Extension.loadOnDemand(this, "array", "tcl.lang.ArrayCmd");
+ Extension.loadOnDemand(this, "binary", "tcl.lang.BinaryCmd");
Extension.loadOnDemand(this, "break", "tcl.lang.BreakCmd");
Extension.loadOnDemand(this, "case", "tcl.lang.CaseCmd");
Extension.loadOnDemand(this, "catch", "tcl.lang.CatchCmd");
# This file tests the tclBinary.c file and the "binary" Tcl command.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# 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.6 1999/06/28 23:49:31 redman Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
#if {[lsearch [namespace children] ::tcltest] == -1} {
# package require tcltest
# namespace import ::tcltest::*
#}
test binary-2.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
set buf hellomatt
set data $hdr
append data $buf
string length $data
} 11
test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
list [catch {binary} msg] $msg
} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
list [catch {binary foo} msg] $msg
} {1 {bad option "foo": must be format, or scan}}
test binary-1.3 {Tcl_BinaryObjCmd: format error} {
list [catch {binary f} msg] $msg
} {1 {wrong # args: should be "binary format formatString ?arg arg ...?"}}
test binary-1.4 {Tcl_BinaryObjCmd: format} {
binary format ""
} {}
test binary-2.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format a } msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-2.2 {Tcl_BinaryObjCmd: format} {
binary format a0 foo
} {}
test binary-2.3 {Tcl_BinaryObjCmd: format} {
binary format a f
} {f}
test binary-2.4 {Tcl_BinaryObjCmd: format} {
binary format a foo
} {f}
test binary-2.5 {Tcl_BinaryObjCmd: format} {
binary format a3 foo
} {foo}
test binary-2.6 {Tcl_BinaryObjCmd: format} {
binary format a5 foo
} foo\x00\x00
test binary-2.7 {Tcl_BinaryObjCmd: format} {
binary format a*a3 foobarbaz blat
} foobarbazbla
test binary-2.8 {Tcl_BinaryObjCmd: format} {
binary format a*X3a2 foobar x
} foox\x00r
test binary-3.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format A} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-3.2 {Tcl_BinaryObjCmd: format} {
binary format A0 f
} {}
test binary-3.3 {Tcl_BinaryObjCmd: format} {
binary format A f
} {f}
test binary-3.4 {Tcl_BinaryObjCmd: format} {
binary format A foo
} {f}
test binary-3.5 {Tcl_BinaryObjCmd: format} {
binary format A3 foo
} {foo}
test binary-3.6 {Tcl_BinaryObjCmd: format} {
binary format A5 foo
} {foo }
test binary-3.7 {Tcl_BinaryObjCmd: format} {
binary format A*A3 foobarbaz blat
} foobarbazbla
test binary-3.8 {Tcl_BinaryObjCmd: format} {
binary format A*X3A2 foobar x
} {foox r}
test binary-4.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format B} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-4.2 {Tcl_BinaryObjCmd: format} {
binary format B0 1
} {}
test binary-4.3 {Tcl_BinaryObjCmd: format} {
binary format B 1
} \x80
test binary-4.4 {Tcl_BinaryObjCmd: format} {
binary format B* 010011
} \x4c
test binary-4.5 {Tcl_BinaryObjCmd: format} {
binary format B8 01001101
} \x4d
test binary-4.6 {Tcl_BinaryObjCmd: format} {
binary format A2X2B9 oo 01001101
} \x4d\x00
test binary-4.7 {Tcl_BinaryObjCmd: format} {
binary format B9 010011011010
} \x4d\x80
test binary-4.8 {Tcl_BinaryObjCmd: format} {
binary format B2B3 10 010
} \x80\x40
test binary-4.9 {Tcl_BinaryObjCmd: format} {
list [catch {binary format B1B5 1 foo} msg] $msg
} {1 {expected binary string but got "foo" instead}}
test binary-5.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format b} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-5.2 {Tcl_BinaryObjCmd: format} {
binary format b0 1
} {}
test binary-5.3 {Tcl_BinaryObjCmd: format} {
binary format b 1
} \x01
test binary-5.4 {Tcl_BinaryObjCmd: format} {
binary format b* 010011
} 2
test binary-5.5 {Tcl_BinaryObjCmd: format} {
binary format b8 01001101
} \xb2
test binary-5.6 {Tcl_BinaryObjCmd: format} {
binary format A2X2b9 oo 01001101
} \xb2\x00
test binary-5.7 {Tcl_BinaryObjCmd: format} {
binary format b9 010011011010
} \xb2\x01
test binary-5.8 {Tcl_BinaryObjCmd: format} {
binary format b17 1
} \x01\00\00
test binary-5.9 {Tcl_BinaryObjCmd: format} {
binary format b2b3 10 010
} \x01\x02
test binary-5.10 {Tcl_BinaryObjCmd: format} {
list [catch {binary format b1b5 1 foo} msg] $msg
} {1 {expected binary string but got "foo" instead}}
test binary-6.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format h} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
binary format h0 1
} {}
test binary-6.3 {Tcl_BinaryObjCmd: format} {
binary format h 1
} \x01
test binary-6.4 {Tcl_BinaryObjCmd: format} {
binary format h c
} \x0c
test binary-6.5 {Tcl_BinaryObjCmd: format} {
binary format h* baadf00d
} \xab\xda\x0f\xd0
test binary-6.6 {Tcl_BinaryObjCmd: format} {
binary format h4 c410
} \x4c\x01
test binary-6.7 {Tcl_BinaryObjCmd: format} {
binary format h6 c4102
} \x4c\x01\x02
test binary-6.8 {Tcl_BinaryObjCmd: format} {
binary format h5 c41020304
} \x4c\x01\x02
test binary-6.9 {Tcl_BinaryObjCmd: format} {
binary format a3X3h5 foo 2
} \x02\x00\x00
test binary-6.10 {Tcl_BinaryObjCmd: format} {
binary format h2h3 23 456
} \x32\x54\x06
test binary-6.11 {Tcl_BinaryObjCmd: format} {
list [catch {binary format h2 foo} msg] $msg
} {1 {expected hexadecimal string but got "foo" instead}}
test binary-7.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format H} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-7.2 {Tcl_BinaryObjCmd: format} {
binary format H0 1
} {}
test binary-7.3 {Tcl_BinaryObjCmd: format} {
binary format H 1
} \x10
test binary-7.4 {Tcl_BinaryObjCmd: format} {
binary format H c
} \xc0
test binary-7.5 {Tcl_BinaryObjCmd: format} {
binary format H* baadf00d
} \xba\xad\xf0\x0d
test binary-7.6 {Tcl_BinaryObjCmd: format} {
binary format H4 c410
} \xc4\x10
test binary-7.7 {Tcl_BinaryObjCmd: format} {
binary format H6 c4102
} \xc4\x10\x20
test binary-7.8 {Tcl_BinaryObjCmd: format} {
binary format H5 c41023304
} \xc4\x10\x20
test binary-7.9 {Tcl_BinaryObjCmd: format} {
binary format a3X3H5 foo 2
} \x20\x00\x00
test binary-7.10 {Tcl_BinaryObjCmd: format} {
binary format H2H3 23 456
} \x23\x45\x60
test binary-7.11 {Tcl_BinaryObjCmd: format} {
list [catch {binary format H2 foo} msg] $msg
} {1 {expected hexadecimal string but got "foo" instead}}
test binary-8.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format c} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-8.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format c blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-8.3 {Tcl_BinaryObjCmd: format} {
binary format c0 0x50
} {}
test binary-8.4 {Tcl_BinaryObjCmd: format} {
binary format c 0x50
} P
test binary-8.5 {Tcl_BinaryObjCmd: format} {
binary format c 0x5052
} R
test binary-8.6 {Tcl_BinaryObjCmd: format} {
binary format c2 {0x50 0x52}
} PR
test binary-8.7 {Tcl_BinaryObjCmd: format} {
binary format c2 {0x50 0x52 0x53}
} PR
test binary-8.8 {Tcl_BinaryObjCmd: format} {
binary format c* {0x50 0x52}
} PR
test binary-8.9 {Tcl_BinaryObjCmd: format} {
list [catch {binary format c2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-8.10 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
list [catch {binary format c $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-8.11 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format c1 $a
} P
test binary-9.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format s} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-9.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format s blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-9.3 {Tcl_BinaryObjCmd: format} {
binary format s0 0x50
} {}
test binary-9.4 {Tcl_BinaryObjCmd: format} {
binary format s 0x50
} P\x00
test binary-9.5 {Tcl_BinaryObjCmd: format} {
binary format s 0x5052
} RP
test binary-9.6 {Tcl_BinaryObjCmd: format} {
binary format s 0x505251 0x53
} QR
test binary-9.7 {Tcl_BinaryObjCmd: format} {
binary format s2 {0x50 0x52}
} P\x00R\x00
test binary-9.8 {Tcl_BinaryObjCmd: format} {
binary format s* {0x5051 0x52}
} QPR\x00
test binary-9.9 {Tcl_BinaryObjCmd: format} {
binary format s2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
test binary-9.10 {Tcl_BinaryObjCmd: format} {
list [catch {binary format s2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-9.11 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
list [catch {binary format s $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-9.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format s1 $a
} P\x00
test binary-10.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format S} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-10.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format S blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-10.3 {Tcl_BinaryObjCmd: format} {
binary format S0 0x50
} {}
test binary-10.4 {Tcl_BinaryObjCmd: format} {
binary format S 0x50
} \x00P
test binary-10.5 {Tcl_BinaryObjCmd: format} {
binary format S 0x5052
} PR
test binary-10.6 {Tcl_BinaryObjCmd: format} {
binary format S 0x505251 0x53
} RQ
test binary-10.7 {Tcl_BinaryObjCmd: format} {
binary format S2 {0x50 0x52}
} \x00P\x00R
test binary-10.8 {Tcl_BinaryObjCmd: format} {
binary format S* {0x5051 0x52}
} PQ\x00R
test binary-10.9 {Tcl_BinaryObjCmd: format} {
binary format S2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
test binary-10.10 {Tcl_BinaryObjCmd: format} {
list [catch {binary format S2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-10.11 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
list [catch {binary format S $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-10.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format S1 $a
} \x00P
test binary-11.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format i} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-11.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format i blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-11.3 {Tcl_BinaryObjCmd: format} {
binary format i0 0x50
} {}
test binary-11.4 {Tcl_BinaryObjCmd: format} {
binary format i 0x50
} P\x00\x00\x00
test binary-11.5 {Tcl_BinaryObjCmd: format} {
binary format i 0x5052
} RP\x00\x00
test binary-11.6 {Tcl_BinaryObjCmd: format} {
binary format i 0x505251 0x53
} QRP\x00
test binary-11.7 {Tcl_BinaryObjCmd: format} {
binary format i1 {0x505251 0x53}
} QRP\x00
test binary-11.8 {Tcl_BinaryObjCmd: format} {
binary format i 0x53525150
} PQRS
test binary-11.9 {Tcl_BinaryObjCmd: format} {
binary format i2 {0x50 0x52}
} P\x00\x00\x00R\x00\x00\x00
test binary-11.10 {Tcl_BinaryObjCmd: format} {
binary format i* {0x50515253 0x52}
} SRQPR\x00\x00\x00
test binary-11.11 {Tcl_BinaryObjCmd: format} {
list [catch {binary format i2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-11.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
list [catch {binary format i $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-11.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format i1 $a
} P\x00\x00\x00
test binary-12.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format I} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-12.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format I blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-12.3 {Tcl_BinaryObjCmd: format} {
binary format I0 0x50
} {}
test binary-12.4 {Tcl_BinaryObjCmd: format} {
binary format I 0x50
} \x00\x00\x00P
test binary-12.5 {Tcl_BinaryObjCmd: format} {
binary format I 0x5052
} \x00\x00PR
test binary-12.6 {Tcl_BinaryObjCmd: format} {
binary format I 0x505251 0x53
} \x00PRQ
test binary-12.7 {Tcl_BinaryObjCmd: format} {
binary format I1 {0x505251 0x53}
} \x00PRQ
test binary-12.8 {Tcl_BinaryObjCmd: format} {
binary format I 0x53525150
} SRQP
test binary-12.9 {Tcl_BinaryObjCmd: format} {
binary format I2 {0x50 0x52}
} \x00\x00\x00P\x00\x00\x00R
test binary-12.10 {Tcl_BinaryObjCmd: format} {
binary format I* {0x50515253 0x52}
} PQRS\x00\x00\x00R
test binary-12.11 {Tcl_BinaryObjCmd: format} {
list [catch {binary format i2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-12.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
list [catch {binary format I $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-12.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format I1 $a
} \x00\x00\x00P
test binary-13.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format f} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-13.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format f blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
test binary-13.4 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
binary format f 1.6
} \x3f\xcc\xcc\xcd
test binary-13.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
binary format f 1.6
} \xcd\xcc\xcc\x3f
test binary-13.6 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
binary format f* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.7 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
binary format f* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.8 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
binary format f2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.9 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
binary format f2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.10 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
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} {
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 macOrUnix} {
binary format f -3.402825e+38
} \xff\x7f\xff\xff
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable pcOnly} {
binary format f -3.402825e+38
} \xff\xff\x7f\xff
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} {nonPortable macOrUnix} {
binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} {nonPortable pcOnly} {
binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} {
list [catch {binary format f2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
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 macOrUnix} {
set a {1.6 3.4}
binary format f1 $a
} \x3f\xcc\xcc\xcd
test binary-13.19 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
set a {1.6 3.4}
binary format f1 $a
} \xcd\xcc\xcc\x3f
test binary-14.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format d} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-14.2 {Tcl_BinaryObjCmd: format} {
list [catch {binary format d blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
binary format d0 1.6
} {}
test binary-14.4 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
binary format d 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-14.5 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} {
binary format d 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-14.6 {Tcl_BinaryObjCmd: format} {nonPortable macOrUnix} {
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} {
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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} {
binary format d NaN
} \x7f\xff\xff\xff\xff\xff\xff\xff
test binary-14.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable macOnly} {
binary format d NaN
} \x7f\xf8\x02\xa0\x00\x00\x00\x00
test binary-14.14 {Tcl_BinaryObjCmd: format} {
list [catch {binary format d2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
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 macOrUnix} {
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} {
set a {1.6 3.4}
binary format d1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-15.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format ax*a "y" "z"} msg] $msg
} {1 {cannot use "*" in format string with "x"}}
test binary-15.2 {Tcl_BinaryObjCmd: format} {
binary format axa "y" "z"
} y\x00z
test binary-15.3 {Tcl_BinaryObjCmd: format} {
binary format ax3a "y" "z"
} y\x00\x00\x00z
test binary-15.4 {Tcl_BinaryObjCmd: format} {
binary format a*X3x3a* "foo" "z"
} \x00\x00\x00z
test binary-16.1 {Tcl_BinaryObjCmd: format} {
binary format a*X*a "foo" "z"
} zoo
test binary-16.2 {Tcl_BinaryObjCmd: format} {
binary format aX3a "y" "z"
} z
test binary-16.3 {Tcl_BinaryObjCmd: format} {
binary format a*Xa* "foo" "zy"
} fozy
test binary-16.4 {Tcl_BinaryObjCmd: format} {
binary format a*X3a "foobar" "z"
} foozar
test binary-16.5 {Tcl_BinaryObjCmd: format} {
binary format a*X3aX2a "foobar" "z" "b"
} fobzar
test binary-17.1 {Tcl_BinaryObjCmd: format} {
binary format @1
} \x00
test binary-17.2 {Tcl_BinaryObjCmd: format} {
binary format @5a2 "ab"
} \x00\x00\x00\x00\x00\x61\x62
test binary-17.3 {Tcl_BinaryObjCmd: format} {
binary format {a* @0 a2 @* a*} "foobar" "ab" "blat"
} abobarblat
test binary-18.1 {Tcl_BinaryObjCmd: format} {
list [catch {binary format u0a3 abc abd} msg] $msg
} {1 {bad field specifier "u"}}
test binary-19.1 {Tcl_BinaryObjCmd: errors} {
list [catch {binary s} msg] $msg
} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
test binary-19.2 {Tcl_BinaryObjCmd: errors} {
list [catch {binary scan foo} msg] $msg
} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
binary scan {} {}
} 0
test binary-20.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc a} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-20.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan abc a arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-20.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 abc
list [binary scan abc a0 arg1] $arg1
} {1 {}}
test binary-20.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc a* arg1] $arg1
} {1 abc}
test binary-20.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc a5 arg1] [info exist arg1]
} {0 0}
test binary-20.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc a2 arg1] $arg1
} {1 ab}
test binary-20.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
} {2 ab cd}
test binary-20.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc a2 arg1(a)] $arg1(a)
} {1 ab}
test binary-20.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc a arg1(a)] $arg1(a)
} {1 a}
test binary-21.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc A} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-21.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan abc A arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-21.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 abc
list [binary scan abc A0 arg1] $arg1
} {1 {}}
test binary-21.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc A* arg1] $arg1
} {1 abc}
test binary-21.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc A5 arg1] [info exist arg1]
} {0 0}
test binary-21.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc A2 arg1] $arg1
} {1 ab}
test binary-21.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
} {2 ab cd}
test binary-21.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc A2 arg1(a)] $arg1(a)
} {1 ab}
test binary-21.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc A2 arg1(a)] $arg1(a)
} {1 ab}
test binary-21.10 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc A arg1(a)] $arg1(a)
} {1 a}
test binary-21.11 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan "abc def \x00 " A* arg1] $arg1
} {1 {abc def}}
test binary-21.12 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan "abc def \x00ghi " A* arg1] $arg1
} [list 1 "abc def \x00ghi"]
test binary-22.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc b} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-22.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 b* arg1] $arg1
} {1 0100101011001010}
test binary-22.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 b arg1] $arg1
} {1 0}
test binary-22.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 b1 arg1] $arg1
} {1 0}
test binary-22.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 b0 arg1] $arg1
} {1 {}}
test binary-22.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 b5 arg1] $arg1
} {1 01001}
test binary-22.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 b8 arg1] $arg1
} {1 01001010}
test binary-22.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 b14 arg1] $arg1
} {1 01001010110010}
test binary-22.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
test binary-22.10 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-22.11 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
} {2 11100 1110000110100000}
test binary-23.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc B} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-23.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 B* arg1] $arg1
} {1 0101001001010011}
test binary-23.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 B arg1] $arg1
} {1 1}
test binary-23.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 B1 arg1] $arg1
} {1 1}
test binary-23.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 B0 arg1] $arg1
} {1 {}}
test binary-23.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 B5 arg1] $arg1
} {1 01010}
test binary-23.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 B8 arg1] $arg1
} {1 01010010}
test binary-23.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 B14 arg1] $arg1
} {1 01010010010100}
test binary-23.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
test binary-23.10 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-23.11 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
} {2 01110 1000011100000101}
test binary-24.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc h} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \xc2\xa3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \xf2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
test binary-24.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-24.10 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
} {2 07 7850}
test binary-25.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc H} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \xc2\xa3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \xf2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
test binary-25.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}
test binary-26.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abc c} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \xff c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
test binary-26.9 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-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 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
test binary-27.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
} {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 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
test binary-28.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
} {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 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
test binary-29.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
} {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 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
test binary-30.8 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 1
list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
} {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} {nonPortable macOrUnix} {
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} {
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.60000002384}
test binary-31.8 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
catch {unset arg1}
list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} {nonPortable pcOnly} {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} {nonPortable macOrUnix} {
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} {
catch {unset arg1}
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.60000002384 3.40000009537}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
test binary-31.13 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
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 macOrUnix} {
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} {
catch {unset arg1 arg2}
set arg1 foo
set arg2 bar
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.60000002384 3.40000009537} 5}
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
set arg1 foo
list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
test binary-32.13 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
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 macOrUnix} {
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} {
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 d2c* arg1 arg2]
$arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-33.1 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
test binary-33.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x1a1 arg1] $arg1
} {1 b}
test binary-33.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x5a1 arg1] $arg1
} {1 f}
test binary-33.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x0a1 arg1] $arg1
} {1 a}
test binary-34.1 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
} {2 ab bcd}
test binary-34.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abc X20a3 arg1] $arg1
} {1 abc}
test binary-34.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x*X1a1 arg1] $arg1
} {1 f}
test binary-34.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x*X5a1 arg1] $arg1
} {1 b}
test binary-34.7 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x3X0a1 arg1] $arg1
} {1 d}
test binary-35.1 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
} {1 {missing count for "@" field specifier}}
test binary-35.2 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.3 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
catch {unset arg2}
set arg2 foo
list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.4 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef @2a3 arg1] $arg1
} {1 cde}
test binary-35.5 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x*@1a1 arg1] $arg1
} {1 b}
test binary-35.6 {Tcl_BinaryObjCmd: scan} {
catch {unset arg1}
list [binary scan abcdef x*@0a1 arg1] $arg1
} {1 a}
test binary-36.1 {Tcl_BinaryObjCmd: scan} {
list [catch {binary scan abcdef u0a3} msg] $msg
} {1 {bad field specifier "u"}}
# GetFormatSpec is pretty thoroughly tested above, but there are a few
# cases we should text explicitly
test binary-37.1 {GetFormatSpec: whitespace} {
binary format "a3 a5 a3" foo barblat baz
} foobarblbaz
test binary-37.2 {GetFormatSpec: whitespace} {
binary format " " foo
} {}
test binary-37.3 {GetFormatSpec: whitespace} {
binary format " a3" foo
} foo
test binary-37.4 {GetFormatSpec: whitespace} {
binary format "" foo
} {}
test binary-37.5 {GetFormatSpec: whitespace} {
binary format "" foo
} {}
test binary-37.6 {GetFormatSpec: whitespace} {
binary format " a3 " foo
} foo
test binary-37.7 {GetFormatSpec: numbers} {
list [catch {binary scan abcdef "x-1" foo} msg] $msg
} {1 {bad field specifier "-"}}
test binary-37.8 {GetFormatSpec: numbers} {
catch {unset arg1}
set arg1 foo
list [binary scan abcdef "a0x3" arg1] $arg1
} {1 {}}
test binary-37.9 {GetFormatSpec: numbers} {
# test format of neg numbers
# bug report/fix provided by Harald Kirsch
set x [binary format f* {1 -1 2 -2 0}]
binary scan $x f* bla
set bla
} {1.0 -1.0 2.0 -2.0 0.0}
test binary-38.1 {FormatNumber: word alignment} {
set x [binary format c1s1 1 1]
} \x01\x01\x00
test binary-38.2 {FormatNumber: word alignment} {
set x [binary format c1S1 1 1]
} \x01\x00\x01
test binary-38.3 {FormatNumber: word alignment} {
set x [binary format c1i1 1 1]
} \x01\x01\x00\x00\x00
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 macOrUnix} {
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} {
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 macOrUnix} {
set x [binary format c1f1 1 1.6]
} \x01\x3f\xcc\xcc\xcd
test binary-38.8 {FormatNumber: word alignment} {nonPortable pcOnly} {
set x [binary format c1f1 1 1.6]
} \x01\xcd\xcc\xcc\x3f
test binary-39.1 {ScanNumber: sign extension} {
catch {unset arg1}
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
catch {unset arg1}
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
catch {unset arg1}
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {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 {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.1 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
} {1 -NaN}
test binary-40.2 {ScanNumber: floating point overflow} {nonPortable macOnly} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
} {1 -NAN(255)}
test binary-40.3 {ScanNumber: floating point overflow} {nonPortable 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)} {
lappend result success
} else {
lappend result failure
}
} {1 success}
test binary-40.4 {ScanNumber: floating point overflow} {nonPortable unixOnly} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
} {1 -NaN}
test binary-40.5 {ScanNumber: floating point overflow} {nonPortable macOnly} {
catch {unset arg1}
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
} {1 -NAN(255)}
test binary-40.6 {ScanNumber: floating point overflow} {nonPortable 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)} {
lappend result success
} else {
lappend result failure
}
} {1 success}
test binary-41.1 {ScanNumber: word alignment} {
catch {unset arg1; unset arg2}
list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.2 {ScanNumber: word alignment} {
catch {unset arg1; unset arg2}
list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.3 {ScanNumber: word alignment} {
catch {unset arg1; unset arg2}
list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
} {2 1 1}
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 macOrUnix} {
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} {
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 macOrUnix} {
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} {
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}
test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
catch {binary ""} result
set result
} {bad option "": must be format, or scan}
# cleanup
#::tcltest::cleanupTests
return
