aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--auto.def10
-rw-r--r--binary.tcl254
-rw-r--r--jim-load-static-exts.c6
-rw-r--r--jim-pack.c380
-rw-r--r--tests/binary-fmt.test660
-rw-r--r--tests/binary-scan.test1084
6 files changed, 2390 insertions, 4 deletions
diff --git a/auto.def b/auto.def
index ae1ff8d..e9751c9 100644
--- a/auto.def
+++ b/auto.def
@@ -38,6 +38,7 @@ options {
nvp - Name-value pairs C-only API
oo - Jim OO extension
tree - OO tree structure, similar to tcllib ::struct::tree
+ binary - Tcl-compatible 'binary' command
readline - Interface to libreadline
rlprompt - Tcl wrapper around the readline extension
sqlite - Interface to sqlite
@@ -126,14 +127,14 @@ set withext [join [opt-val {with-ext with-jim-ext}]]
set withmod [join [opt-val {with-mod with-jim-extmod}]]
# Tcl extensions
-set ext_tcl "stdlib glob tclcompat tree rlprompt oo"
+set ext_tcl "stdlib glob tclcompat tree rlprompt oo binary"
# C extensions
-set ext_c "load package readdir array clock exec file posix regexp signal aio eventloop syslog nvp readline sqlite sqlite3 win32"
+set ext_c "load package readdir array clock exec file posix regexp signal aio eventloop pack syslog nvp readline sqlite sqlite3 win32"
# Tcl extensions which can be modules
-set ext_tcl_mod "glob tree rlprompt oo"
+set ext_tcl_mod "glob tree rlprompt oo binary"
# C extensions which can be modules
-set ext_c_mod "readdir array clock file posix regexp syslog readline sqlite sqlite3 win32"
+set ext_c_mod "readdir array clock file posix regexp syslog readline pack sqlite sqlite3 win32"
# All extensions
set ext_all [concat $ext_c $ext_tcl]
@@ -158,6 +159,7 @@ foreach i [concat $withext $without $withmod] {
set dep(glob) readdir
set dep(rlprompt) readline
set dep(tree) oo
+set dep(binary) pack
set needs(aio) {expr {[cc-check-function-in-lib socket socket] || 1}}
set needs(exec) {expr {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]}}
diff --git a/binary.tcl b/binary.tcl
new file mode 100644
index 0000000..5e9ae3f
--- /dev/null
+++ b/binary.tcl
@@ -0,0 +1,254 @@
+# Implements the 'binary scan' and 'binary format' commands.
+#
+# (c) 2010 Steve Bennett <steveb@workware.net.au>
+#
+# See LICENCE in this directory for licensing.
+
+package require pack
+package require regexp
+
+proc binary {cmd args} {
+ tailcall "binary $cmd" {*}$args
+}
+
+proc "binary format" {formatString args} {
+ set bitoffset 0
+ set result {}
+ foreach {conv t u n} [regexp -all -inline {([a-zA-Z@])(u)?([*0-9]*)} $formatString] {
+ if {$t in {a A}} {
+ set value [binary.nextarg args]
+ set sn [string bytelength $value]
+ if {$n ne "*"} {
+ if {$n eq ""} {
+ set n 1
+ }
+ if {$n > $sn} {
+ # Need to pad the string with spaces or nulls
+ append value [string repeat [dict get {A " " a \x00} $t] $($n - $sn)]
+ }
+ } else {
+ set n $sn
+ }
+ if {$n} {
+ set bitoffset [pack result $value -str $(8 * $n) $bitoffset]
+ }
+ } elseif {[binary.intinfo $t] ne ""} {
+ # An integer type
+ lassign [binary.intinfo $t] type endian size prefix
+ set value [binary.nextarg args]
+
+ if {$type ne "int"} {
+ set value [split $value {}]
+ }
+ set vn [llength $value]
+ if {$n eq "*"} {
+ set n $vn
+ } elseif {$n eq ""} {
+ set n 1
+ set value [list $value]
+ } elseif {$vn < $n} {
+ if {$type eq "int"} {
+ return -code error "number of elements in list does not match count"
+ } else {
+ # Need to pad the list with zeros
+ lappend value {*}[lrepeat $($n - $vn) 0]
+ }
+ } elseif {$vn > $n} {
+ # Need to truncate the list
+ set value [lrange $value 0 $n-1]
+ }
+
+ if {$endian eq "host"} {
+ set endian $($::tcl_platform(byteOrder) eq "bigEndian" ? "be" : "le")
+ }
+ foreach v $value {
+ set bitoffset [pack result $prefix$v -int$endian $size $bitoffset]
+ }
+ # Now pad out with zeros to the end of the current byte
+ if {$bitoffset % 8} {
+ set bitoffset [pack result 0 -int$endian $(8 - $bitoffset % 8) $bitoffset]
+ }
+ } elseif {$t eq "x"} {
+ if {$n eq "*"} {
+ return -code error {cannot use "*" in format string with "x"}
+ }
+ if {$n eq ""} {
+ set n 1
+ }
+ loop i 0 $n {
+ set bitoffset [pack result 0 -intbe 8 $bitoffset]
+ }
+ } elseif {$t eq "@"} {
+ if {$n eq ""} {
+ return -code error {missing count for "@" field specifier}
+ }
+ if {$n eq "*"} {
+ set bitoffset $(8 * [string bytelength $result])
+ } else {
+ # May need to pad it out
+ set max [string bytelength $result]
+ while {$n > $max} {
+ append result \x00
+ incr max
+ }
+ set bitoffset $(8 * $n)
+ }
+ } elseif {$t eq "X"} {
+ if {$n eq "*"} {
+ set bitoffset 0
+ } elseif {$n eq ""} {
+ incr bitoffset -8
+ } else {
+ incr bitoffset $($n * -8)
+ }
+ if {$bitoffset < 0} {
+ set bitoffset 0
+ }
+ } else {
+ return -code error "bad field specifier \"$t\""
+ }
+ }
+ return $result
+}
+
+proc "binary scan" {value formatString {args varName}} {
+ # Pops the next arg from the front of the list and returns it.
+ # Throws an error if no more args
+ set bitoffset 0
+ set count 0
+ foreach {conv t u n} [regexp -all -inline {([a-zA-Z@])(u)?([*0-9]*)} $formatString] {
+ set rembytes $([string bytelength $value] - $bitoffset / 8)
+ if {$t in {a A}} {
+ if {$n eq "*"} {
+ set n $rembytes
+ } elseif {$n eq ""} {
+ set n 1
+ }
+ if {$n > $rembytes} {
+ continue
+ }
+
+ set var [binary.nextarg varName]
+
+ set result [unpack $value -str $bitoffset $($n * 8)]
+ incr bitoffset $([string bytelength $result] * 8)
+ if {$t eq "A"} {
+ set result [string trimright $result]
+ }
+ } elseif {[binary.intinfo $t] ne ""} {
+ # An integer type
+ lassign [binary.intinfo $t] type endian size prefix
+ set var [binary.nextarg varName]
+
+ if {$n eq "*"} {
+ set n $($rembytes * 8 / $size)
+ } else {
+ if {$n eq ""} {
+ set n 1
+ }
+ }
+ if {$n * $size > $rembytes * 8} {
+ continue
+ }
+
+ if {$type ne "int"} {
+ set u u
+ }
+ if {$endian eq "host"} {
+ set endian $($::tcl_platform(byteOrder) eq "bigEndian" ? "be" : "le")
+ }
+
+ set result {}
+ loop i 0 $n {
+ set v [unpack $value -${u}int$endian $bitoffset $size]
+ if {$type eq "int"} {
+ lappend result $v
+ } else {
+ append result [lindex {0 1 2 3 4 5 6 7 8 9 a b c d e f} $v]
+ }
+ incr bitoffset $size
+ }
+ # Now skip to the end of the current byte
+ if {$bitoffset % 8} {
+ incr bitoffset $(8 - ($bitoffset % 8))
+ }
+ } elseif {$t eq "x"} {
+ # Skip bytes
+ if {$n eq "*"} {
+ set n $rembytes
+ } elseif {$n eq ""} {
+ set n 1
+ }
+ if {$n > $rembytes} {
+ set n $rembytes
+ }
+ incr bitoffset $($n * 8)
+ continue
+ } elseif {$t eq "X"} {
+ # Back up bytes
+ if {$n eq "*"} {
+ set bitoffset 0
+ continue
+ }
+ if {$n eq ""} {
+ set n 1
+ }
+ if {$n * 8 > $bitoffset} {
+ set bitoffset 0
+ continue
+ }
+ incr bitoffset -$($n * 8)
+ continue
+ } elseif {$t eq "@"} {
+ if {$n eq ""} {
+ return -code error {missing count for "@" field specifier}
+ }
+ if {$n eq "*" || $n > $rembytes + $bitoffset / 8} {
+ incr bitoffset $($rembytes * 8)
+ } elseif {$n < 0} {
+ set bitoffset 0
+ } else {
+ set bitoffset $($n * 8)
+ }
+ continue
+ } else {
+ return -code error "bad field specifier \"$t\""
+ }
+ uplevel 1 [list set $var $result]
+ incr count
+ }
+ return $count
+}
+
+# Pops the next arg from the front of the list and returns it.
+# Throws an error if no more args
+proc binary.nextarg {&arglist} {
+ if {[llength $arglist] == 0} {
+ return -level 2 -code error "not enough arguments for all format specifiers"
+ }
+ set arglist [lassign $arglist arg]
+ return $arg
+}
+
+proc binary.intinfo {type} {
+ set info {
+ c {int be 8}
+ s {int le 16}
+ t {int host 16}
+ S {int be 16}
+ i {int le 32}
+ I {int be 32}
+ n {int host 32}
+ w {int le 64}
+ W {int be 64}
+ m {int host 64}
+ h {hex le 4 0x}
+ H {hex be 4 0x}
+ b {bin le 1}
+ B {bin be 1}
+ }
+ if {[exists info($type)]} {
+ return $info($type)
+ }
+ return ""
+}
diff --git a/jim-load-static-exts.c b/jim-load-static-exts.c
index 568c291..efa0303 100644
--- a/jim-load-static-exts.c
+++ b/jim-load-static-exts.c
@@ -61,5 +61,11 @@ int Jim_InitStaticExtensions(Jim_Interp *interp)
#ifdef jim_ext_tree
LOAD_EXT(tree);
#endif
+#ifdef jim_ext_pack
+ LOAD_EXT(pack);
+#endif
+#ifdef jim_ext_binary
+ LOAD_EXT(binary);
+#endif
return JIM_OK;
}
diff --git a/jim-pack.c b/jim-pack.c
new file mode 100644
index 0000000..f517a92
--- /dev/null
+++ b/jim-pack.c
@@ -0,0 +1,380 @@
+#include <string.h>
+#include <jim.h>
+
+/* Provides the [pack] and [unpack] commands to pack and unpack
+ * a binary string to/from arbitrary width integers and strings.
+ *
+ * This may be used to implement the [binary] command.
+ */
+
+/**
+ * Big endian bit test.
+ *
+ * Considers 'bitvect' as a big endian bit stream and returns
+ * bit 'b' as zero or non-zero.
+ */
+static int JimTestBitBigEndian(const unsigned char *bitvec, int b)
+{
+ div_t pos = div(b, 8);
+ return bitvec[pos.quot] & (1 << (7 - pos.rem));
+}
+
+/**
+ * Little endian bit test.
+ *
+ * Considers 'bitvect' as a little endian bit stream and returns
+ * bit 'b' as zero or non-zero.
+ */
+static int JimTestBitLittleEndian(const unsigned char *bitvec, int b)
+{
+ div_t pos = div(b, 8);
+ return bitvec[pos.quot] & (1 << pos.rem);
+}
+
+/**
+ * Sign extends the given value, 'n' of width 'width' bits.
+ *
+ * For example, sign extending 0x80 with a width of 8, produces -128
+ */
+static jim_wide JimSignExtend(jim_wide n, int width)
+{
+ if (width == sizeof(jim_wide) * 8) {
+ /* Can't sign extend the maximum size integer */
+ return n;
+ }
+ if (n & ((jim_wide)1 << (width - 1))) {
+ /* Need to extend */
+ n -= ((jim_wide)1 << width);
+ }
+
+ return n;
+}
+
+/**
+ * Big endian integer extraction.
+ *
+ * Considers 'bitvect' as a big endian bit stream.
+ * Returns an integer of the given width (in bits)
+ * starting at the given position (in bits).
+ *
+ * The pos/width must represent bits inside bitvec,
+ * and the width be no more than the width of jim_wide.
+ */
+static jim_wide JimBitIntBigEndian(const unsigned char *bitvec, int pos, int width)
+{
+ jim_wide result = 0;
+ int i;
+
+ /* Aligned, byte extraction */
+ if (pos % 8 == 0 && width % 8 == 0) {
+ for (i = 0; i < width; i += 8) {
+ result = (result << 8) + bitvec[(pos + i) / 8];
+ }
+ return result;
+ }
+
+ /* Unaligned */
+ for (i = 0; i < width; i++) {
+ if (JimTestBitBigEndian(bitvec, pos + width - i - 1)) {
+ result |= ((jim_wide)1 << i);
+ }
+ }
+
+ return result;
+}
+
+/**
+ * Little endian integer extraction.
+ *
+ * Like JimBitIntBigEndian() but considers 'bitvect' as a little endian bit stream.
+ */
+static jim_wide JimBitIntLittleEndian(const unsigned char *bitvec, int pos, int width)
+{
+ jim_wide result = 0;
+ int i;
+
+ /* Aligned, byte extraction */
+ if (pos % 8 == 0 && width % 8 == 0) {
+ for (i = 0; i < width; i += 8) {
+ result += (jim_wide)bitvec[(pos + i) / 8] << i;
+ }
+ return result;
+ }
+
+ /* Unaligned */
+ for (i = 0; i < width; i++) {
+ if (JimTestBitLittleEndian(bitvec, pos + i)) {
+ result |= ((jim_wide)1 << i);
+ }
+ }
+
+ return result;
+}
+
+/**
+ * Big endian bit set.
+ *
+ * Considers 'bitvect' as a big endian bit stream and sets
+ * bit 'b' to 'bit'
+ */
+static void JimSetBitBigEndian(unsigned char *bitvec, int b, int bit)
+{
+ div_t pos = div(b, 8);
+ if (bit) {
+ bitvec[pos.quot] |= (1 << (7 - pos.rem));
+ }
+ else {
+ bitvec[pos.quot] &= ~(1 << (7 - pos.rem));
+ }
+}
+
+/**
+ * Little endian bit set.
+ *
+ * Considers 'bitvect' as a little endian bit stream and sets
+ * bit 'b' to 'bit'
+ */
+static void JimSetBitLittleEndian(unsigned char *bitvec, int b, int bit)
+{
+ div_t pos = div(b, 8);
+ if (bit) {
+ bitvec[pos.quot] |= (1 << pos.rem);
+ }
+ else {
+ bitvec[pos.quot] &= ~(1 << pos.rem);
+ }
+}
+
+/**
+ * Big endian integer packing.
+ *
+ * Considers 'bitvect' as a big endian bit stream.
+ * Packs integer 'value' of the given width (in bits)
+ * starting at the given position (in bits).
+ *
+ * The pos/width must represent bits inside bitvec,
+ * and the width be no more than the width of jim_wide.
+ */
+static void JimSetBitsIntBigEndian(unsigned char *bitvec, jim_wide value, int pos, int width)
+{
+ int i;
+
+ /* Common fast option */
+ if (pos % 8 == 0 && width == 8) {
+ bitvec[pos / 8] = value;
+ return;
+ }
+
+ for (i = 0; i < width; i++) {
+ int bit = !!(value & ((jim_wide)1 << i));
+ JimSetBitBigEndian(bitvec, pos + width - i - 1, bit);
+ }
+}
+
+/**
+ * Little endian version of JimSetBitsIntBigEndian()
+ */
+static void JimSetBitsIntLittleEndian(unsigned char *bitvec, jim_wide value, int pos, int width)
+{
+ int i;
+
+ /* Common fast option */
+ if (pos % 8 == 0 && width == 8) {
+ bitvec[pos / 8] = value;
+ return;
+ }
+
+ for (i = 0; i < width; i++) {
+ int bit = !!(value & ((jim_wide)1 << i));
+ JimSetBitLittleEndian(bitvec, pos + i, bit);
+ }
+}
+
+/**
+ * [unpack]
+ *
+ * Usage: unpack binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth
+ *
+ * Unpacks bits from $binvalue at bit position $bitpos and with $bitwidth.
+ * Interprets the value according to the type and returns it.
+ */
+static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ int option;
+ static const char const *options[] = { "-intbe", "-intle", "-uintbe", "-uintle", "-str", NULL };
+ enum { OPT_INTBE, OPT_INTLE, OPT_UINTBE, OPT_UINTLE, OPT_STR, };
+ jim_wide pos;
+ jim_wide width;
+
+ if (argc != 5) {
+ Jim_WrongNumArgs(interp, 1, argv, "binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth");
+ return JIM_ERR;
+ }
+ if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
+ return JIM_ERR;
+ }
+
+ if (Jim_GetWide(interp, argv[3], &pos) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
+ return JIM_ERR;
+ }
+
+ if (option == OPT_STR) {
+ int len;
+ const char *str = Jim_GetString(argv[1], &len);
+
+ if (width % 8 || pos % 8) {
+ Jim_SetResultString(interp, "string field is not on a byte boundary", -1);
+ return JIM_ERR;
+ }
+
+ if (pos >= 0 && width > 0 && pos < len * 8) {
+ if (pos + width > len * 8) {
+ width = len * 8 - pos;
+ }
+ Jim_SetResultString(interp, str + pos / 8, width / 8);
+ }
+ return JIM_OK;
+ }
+ else {
+ int len;
+ const unsigned char *str = (const unsigned char *)Jim_GetString(argv[1], &len);
+ jim_wide result = 0;
+
+ if (width > sizeof(jim_wide) * 8) {
+ Jim_SetResultFormatted(interp, "int field is too wide: %#s", argv[4]);
+ return JIM_ERR;
+ }
+
+ if (pos >= 0 && width > 0 && pos < len * 8) {
+ if (pos + width > len * 8) {
+ width = len * 8 - pos;
+ }
+ if (option == OPT_INTBE || option == OPT_UINTBE) {
+ result = JimBitIntBigEndian(str, pos, width);
+ }
+ else {
+ result = JimBitIntLittleEndian(str, pos, width);
+ }
+ if (option == OPT_INTBE || option == OPT_INTLE) {
+ result = JimSignExtend(result, width);
+ }
+ }
+ Jim_SetResultInt(interp, result);
+ return JIM_OK;
+ }
+}
+
+/**
+ * [pack]
+ *
+ * Usage: pack varname value -intle|-intbe|-str width ?bitoffset?
+ *
+ * Packs the binary representation of 'value' into the variable of the given name.
+ * The value is packed according to the given type, width and bitoffset.
+ * The variable is created if necessary (like [append])
+ * Ihe variable is expanded if necessary
+ */
+static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
+{
+ int option;
+ static const char const *options[] = { "-intle", "-intbe", "-str", NULL };
+ enum { OPT_LE, OPT_BE, OPT_STR };
+ jim_wide pos = 0;
+ jim_wide width;
+ jim_wide value;
+ Jim_Obj *stringObjPtr;
+ int len;
+ int freeobj = 0;
+
+ if (argc != 5 && argc != 6) {
+ Jim_WrongNumArgs(interp, 1, argv, "varName value -intle|-intbe|-str bitwidth ?bitoffset?");
+ return JIM_ERR;
+ }
+ if (Jim_GetEnum(interp, argv[3], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (option != OPT_STR && Jim_GetWide(interp, argv[2], &value) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (width <= 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8)) {
+ Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[5]);
+ return JIM_ERR;
+ }
+ if (argc == 6) {
+ if (Jim_GetWide(interp, argv[5], &pos) != JIM_OK) {
+ return JIM_ERR;
+ }
+ if (pos < 0 || (option == OPT_STR && pos % 8)) {
+ Jim_SetResultFormatted(interp, "bad bitoffset: %#s", argv[5]);
+ return JIM_ERR;
+ }
+ }
+
+ stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
+ if (!stringObjPtr) {
+ /* Create the string if it doesn't exist */
+ stringObjPtr = Jim_NewEmptyStringObj(interp);
+ freeobj = 1;
+ }
+ else if (Jim_IsShared(stringObjPtr)) {
+ freeobj = 1;
+ stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
+ }
+
+ len = Jim_Length(stringObjPtr) * 8;
+
+ /* Extend the string as necessary first */
+ while (len < pos + width) {
+ Jim_AppendString(interp, stringObjPtr, "", 1);
+ len += 8;
+ }
+
+ Jim_SetResultInt(interp, pos + width);
+
+ /* Now set the bits. Note that the the string *must* have no non-string rep
+ * since we are writing the bytes directly.
+ */
+ Jim_AppendString(interp, stringObjPtr, "", 0);
+
+ if (option == OPT_BE) {
+ JimSetBitsIntBigEndian((unsigned char *)stringObjPtr->bytes, value, pos, width);
+ }
+ else if (option == OPT_LE) {
+ JimSetBitsIntLittleEndian((unsigned char *)stringObjPtr->bytes, value, pos, width);
+ }
+ else {
+ pos /= 8;
+ width /= 8;
+
+ if (width > Jim_Length(argv[2])) {
+ width = Jim_Length(argv[2]);
+ }
+ memcpy(stringObjPtr->bytes + pos, Jim_GetString(argv[2], NULL), width);
+ /* No padding is needed since the string is already extended */
+ }
+
+ if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
+ if (freeobj) {
+ Jim_FreeNewObj(interp, stringObjPtr);
+ return JIM_ERR;
+ }
+ }
+ return JIM_OK;
+}
+
+int Jim_packInit(Jim_Interp *interp)
+{
+ if (Jim_PackageProvide(interp, "pack", "1.0", JIM_ERRMSG)) {
+ return JIM_ERR;
+ }
+
+ Jim_CreateCommand(interp, "unpack", Jim_UnpackCmd, NULL, NULL);
+ Jim_CreateCommand(interp, "pack", Jim_PackCmd, NULL, NULL);
+ return JIM_OK;
+}
diff --git a/tests/binary-fmt.test b/tests/binary-fmt.test
new file mode 100644
index 0000000..6e0df7a
--- /dev/null
+++ b/tests/binary-fmt.test
@@ -0,0 +1,660 @@
+# 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.38 2008/12/15 17:11:34 ferrieux Exp $
+
+source [file dirname [info script]]/testing.tcl
+
+needs cmd binary
+testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+
+# ----------------------------------------------------------------------
+
+test binary-0.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} -body {
+ binary
+} -returnCodes error -match glob -result {wrong # args: *}
+test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body {
+ binary foo
+} -match glob -result {*}
+test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body {
+ binary f
+} -match glob -result {*}
+test binary-1.4 {Tcl_BinaryObjCmd: format} -body {
+ binary format ""
+} -result {}
+
+test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format a
+} -result {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} -returnCodes error -body {
+ binary format A
+} -result {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} -returnCodes error -body {
+ binary format B
+} -result {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} -returnCodes error -body {
+ binary format B1B5 1 foo
+} -match glob -result {expected *}
+
+test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format b
+} -result {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} -returnCodes error -body {
+ binary format b1b5 1 foo
+} -match glob -result {expected *}
+
+test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format h
+} -result {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} -returnCodes error -body {
+ binary format h2 foo
+} -match glob -result {expected *}
+
+test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format H
+} -result {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} -returnCodes error -body {
+ binary format H2 foo
+} -match glob -result {expected *}
+
+test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c
+} -result {not enough arguments for all format specifiers}
+test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c blat
+} -match glob -result {expected *}
+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} -returnCodes error -body {
+ binary format c2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format c $a
+} -result "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} -returnCodes error -body {
+ binary format s
+} -result {not enough arguments for all format specifiers}
+test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s blat
+} -result {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} -returnCodes error -body {
+ binary format s2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format s $a
+} -result "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} -returnCodes error -body {
+ binary format S
+} -result {not enough arguments for all format specifiers}
+test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S blat
+} -result {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} -returnCodes error -body {
+ binary format S2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format S $a
+} -result "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} -returnCodes error -body {
+ binary format i
+} -result {not enough arguments for all format specifiers}
+test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i blat
+} -result {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} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format i $a
+} -result "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} -returnCodes error -body {
+ binary format I
+} -result {not enough arguments for all format specifiers}
+test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format I blat
+} -result {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} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format I $a
+} -result "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-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format ax*a "y" "z"
+} -result {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-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x0s 1
+} \x01\x00
+test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x0ss 1 1
+} \x01\x00\x01\x00
+test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x1s 1
+} \x00\x01\x00
+test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} {
+ binary format x1ss 1 1
+} \x00\x01\x00\x01\x00
+
+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} -returnCodes error -body {
+ binary format u0a3 abc abd
+} -result {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-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
+
+# Wide int (guaranteed at least 64-bit) handling
+test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
+ binary format w 7810179016327718216
+} HelloTcl
+test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
+ binary format W 7810179016327718216
+} lcTolleH
+
+### TIP#129: endian specifiers ----
+
+# format t
+test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t
+} -result {not enough arguments for all format specifiers}
+test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t blat
+} -result {expected integer but got "blat"}
+test binary-48.3 {Tcl_BinaryObjCmd: format} {
+ binary format S0 0x50
+} {}
+test binary-48.4 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t 0x50
+} \x00P
+test binary-48.5 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t 0x50
+} P\x00
+test binary-48.6 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t 0x5052
+} PR
+test binary-48.7 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t 0x5052
+} RP
+test binary-48.8 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t 0x505251 0x53
+} RQ
+test binary-48.9 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t 0x505251 0x53
+} QR
+test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t2 {0x50 0x52}
+} \x00P\x00R
+test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t2 {0x50 0x52}
+} P\x00R\x00
+test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t* {0x5051 0x52}
+} PQ\x00R
+test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t* {0x5051 0x52}
+} QPR\x00
+test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format t2 {0x50 0x52 0x53} 0x54
+} \x00P\x00R
+test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format t2 {0x50 0x52 0x53} 0x54
+} P\x00R\x00
+test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format t $a
+} -result "expected integer but got \"0x50 0x51\""
+test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
+ set a {0x50 0x51}
+ binary format t1 $a
+} \x00P
+test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
+ set a {0x50 0x51}
+ binary format t1 $a
+} P\x00
+
+# format n
+test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n
+} -result {not enough arguments for all format specifiers}
+test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n blat
+} -result {expected integer but got "blat"}
+test binary-49.3 {Tcl_BinaryObjCmd: format} {
+ binary format n0 0x50
+} {}
+test binary-49.4 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n 0x50
+} P\x00\x00\x00
+test binary-49.5 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n 0x5052
+} RP\x00\x00
+test binary-49.6 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n 0x505251 0x53
+} QRP\x00
+test binary-49.7 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format i1 {0x505251 0x53}
+} QRP\x00
+test binary-49.8 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n 0x53525150
+} PQRS
+test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n2 {0x50 0x52}
+} P\x00\x00\x00R\x00\x00\x00
+test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
+ binary format n* {0x50515253 0x52}
+} SRQPR\x00\x00\x00
+test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ set a {0x50 0x51}
+ binary format n $a
+} -result "expected integer but got \"0x50 0x51\""
+test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
+ set a {0x50 0x51}
+ binary format n1 $a
+} P\x00\x00\x00
+test binary-49.14 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n 0x50
+} \x00\x00\x00P
+test binary-49.15 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n 0x5052
+} \x00\x00PR
+test binary-49.16 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n 0x505251 0x53
+} \x00PRQ
+test binary-49.17 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format i1 {0x505251 0x53}
+} QRP\x00
+test binary-49.18 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n 0x53525150
+} SRQP
+test binary-49.19 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n2 {0x50 0x52}
+} \x00\x00\x00P\x00\x00\x00R
+test binary-49.20 {Tcl_BinaryObjCmd: format} bigEndian {
+ binary format n* {0x50515253 0x52}
+} PQRS\x00\x00\x00R
+
+# format m
+test binary-50.1 {Tcl_BinaryObjCmd: format wide int} littleEndian {
+ binary format m 7810179016327718216
+} HelloTcl
+test binary-50.2 {Tcl_BinaryObjCmd: format wide int} bigEndian {
+ binary format m 7810179016327718216
+} lcTolleH
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/binary-scan.test b/tests/binary-scan.test
new file mode 100644
index 0000000..c758f05
--- /dev/null
+++ b/tests/binary-scan.test
@@ -0,0 +1,1084 @@
+# 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.38 2008/12/15 17:11:34 ferrieux Exp $
+
+source [file dirname [info script]]/testing.tcl
+
+needs cmd binary
+testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+
+test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary s
+} -match glob -result {*}
+test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary scan foo
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
+test binary-19.3 {Tcl_BinaryObjCmd: scan} {
+ binary scan {} {}
+} 0
+
+test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc a
+} -result {not enough arguments for all format specifiers}
+test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan abc a arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ set arg1 abc
+ list [binary scan abc a0 arg1] $arg1
+} -result {1 {}}
+test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc a* arg1] $arg1
+} -result {1 abc}
+test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc a5 arg1] [info exists arg1]
+} -result {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} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
+ list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
+} -result {2 ab cd}
+test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc a2 arg1(a)] $arg1(a)
+} -result {1 ab}
+test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc a arg1(a)] $arg1(a)
+} -result {1 a}
+
+test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc A
+} -result {not enough arguments for all format specifiers}
+test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan abc A arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ set arg1 abc
+ list [binary scan abc A0 arg1] $arg1
+} -result {1 {}}
+test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc A* arg1] $arg1
+} -result {1 abc}
+test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc A5 arg1] [info exists arg1]
+} -result {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} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
+ list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
+} -result {2 ab cd}
+test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc A2 arg1(a)] $arg1(a)
+} -result {1 ab}
+test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc A2 arg1(a)] $arg1(a)
+} -result {1 ab}
+test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan abc A arg1(a)] $arg1(a)
+} -result {1 a}
+test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan "abc def \x00 " A* arg1] $arg1
+} -result {1 {abc def}}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
+ list [binary scan "abc def \x00ghi " A* arg1] $arg1
+} -result [list 1 "abc def \x00ghi"]
+
+test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc b
+} -result {not enough arguments for all format specifiers}
+test binary-22.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 b* arg1] $arg1
+} {1 0100101011001010}
+test binary-22.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 b arg1] $arg1
+} {1 0}
+test binary-22.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 b1 arg1] $arg1
+} {1 0}
+test binary-22.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 b0 arg1] $arg1
+} {1 {}}
+test binary-22.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 b5 arg1] $arg1
+} {1 01001}
+test binary-22.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 b8 arg1] $arg1
+} {1 01001010}
+test binary-22.8 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 b14 arg1] $arg1
+} {1 01001010110010}
+test binary-22.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 b14 arg1] $arg1
+} {0 foo}
+test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 b1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
+} -result {2 11100 1110000110100000}
+
+test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc B
+} -result {not enough arguments for all format specifiers}
+test binary-23.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 B* arg1] $arg1
+} {1 0101001001010011}
+test binary-23.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 B arg1] $arg1
+} {1 1}
+test binary-23.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 B1 arg1] $arg1
+} {1 1}
+test binary-23.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 B0 arg1] $arg1
+} {1 {}}
+test binary-23.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 B5 arg1] $arg1
+} {1 01010}
+test binary-23.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 B8 arg1] $arg1
+} {1 01010010}
+test binary-23.8 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 B14 arg1] $arg1
+} {1 01010010010100}
+test binary-23.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 B14 arg1] $arg1
+} {0 foo}
+test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 B1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
+} -result {2 01110 1000011100000101}
+
+test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc h
+} -result {not enough arguments for all format specifiers}
+test binary-24.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 h* arg1] $arg1
+} {1 253a}
+test binary-24.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xc2\xa3 h arg1] $arg1
+} {1 2}
+test binary-24.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 h1 arg1] $arg1
+} {1 2}
+test binary-24.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 h0 arg1] $arg1
+} {1 {}}
+test binary-24.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xf2\x53 h2 arg1] $arg1
+} {1 2f}
+test binary-24.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 h3 arg1] $arg1
+} {1 253}
+test binary-24.8 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 h3 arg1] $arg1
+} {0 foo}
+test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 h1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
+ set arg1 foo
+ set arg2 bar
+ list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
+} -result {2 07 7850}
+
+test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc H
+} -result {not enough arguments for all format specifiers}
+test binary-25.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 H* arg1] $arg1
+} {1 52a3}
+test binary-25.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xc2\xa3 H arg1] $arg1
+} {1 c}
+test binary-25.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x82\x53 H1 arg1] $arg1
+} {1 8}
+test binary-25.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 H0 arg1] $arg1
+} {1 {}}
+test binary-25.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xf2\x53 H2 arg1] $arg1
+} {1 f2}
+test binary-25.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\x53 H3 arg1] $arg1
+} {1 525}
+test binary-25.8 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 H3 arg1] $arg1
+} {0 foo}
+test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 H1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-25.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc c
+} -result {not enough arguments for all format specifiers}
+test binary-26.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c* arg1] $arg1
+} {1 {82 -93}}
+test binary-26.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c arg1] $arg1
+} {1 82}
+test binary-26.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c1 arg1] $arg1
+} {1 82}
+test binary-26.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c0 arg1] $arg1
+} {1 {}}
+test binary-26.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c2 arg1] $arg1
+} {1 {82 -93}}
+test binary-26.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xff c arg1] $arg1
+} {1 -1}
+test binary-26.8 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 c3 arg1] $arg1
+} {0 foo}
+test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 c1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-26.10 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu* arg1] $arg1
+} {1 {82 163}}
+test binary-26.12 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu arg1] $arg1
+} {1 82}
+test binary-26.13 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xff cu arg1] $arg1
+} {1 255}
+test binary-26.14 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc s
+} -result {not enough arguments for all format specifiers}
+test binary-27.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
+} {1 {-23726 21587}}
+test binary-27.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
+} {1 -23726}
+test binary-27.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 s1 arg1] $arg1
+} {1 -23726}
+test binary-27.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 s0 arg1] $arg1
+} {1 {}}
+test binary-27.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
+} {1 {-23726 21587}}
+test binary-27.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 s1 arg1] $arg1
+} {0 foo}
+test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 s1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-27.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
+} {1 {41810 21587}}
+test binary-27.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc S
+} -result {not enough arguments for all format specifiers}
+test binary-28.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
+} {1 21155}
+test binary-28.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 S1 arg1] $arg1
+} {1 21155}
+test binary-28.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 S0 arg1] $arg1
+} {1 {}}
+test binary-28.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 S1 arg1] $arg1
+} {0 foo}
+test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 S1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-28.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.11 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
+} {1 {41810 21587}}
+
+test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc i
+} -result {not enough arguments for all format specifiers}
+test binary-29.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
+} {1 1414767442}
+test binary-29.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
+} {1 1414767442}
+test binary-29.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53 i0 arg1] $arg1
+} {1 {}}
+test binary-29.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 i1 arg1] $arg1
+} {0 foo}
+test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53\x53\x54 i1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-29.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc I
+} -result {not enough arguments for all format specifiers}
+test binary-30.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
+} {1 1386435412}
+test binary-30.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
+} {1 1386435412}
+test binary-30.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53 I0 arg1] $arg1
+} {1 {}}
+test binary-30.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 I1 arg1] $arg1
+} {0 foo}
+test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53\x53\x54 I1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-30.9 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1 arg2
+ list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
+} {2 2147483648 128}
+
+test binary-33.1 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
+} {2 ab def}
+test binary-33.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-33.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x1a1 arg1] $arg1
+} {1 b}
+test binary-33.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x5a1 arg1] $arg1
+} {1 f}
+test binary-33.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x0a1 arg1] $arg1
+} {1 a}
+
+test binary-34.1 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
+} {2 ab bcd}
+test binary-34.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
+} {2 abc abc}
+test binary-34.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
+} {2 abc abc}
+test binary-34.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abc X20a3 arg1] $arg1
+} {1 abc}
+test binary-34.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x*X1a1 arg1] $arg1
+} {1 f}
+test binary-34.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x*X5a1 arg1] $arg1
+} {1 b}
+test binary-34.7 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x3X0a1 arg1] $arg1
+} {1 d}
+
+test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -returnCodes error -body {
+ binary scan abcdefg a2@a3 arg1 arg2
+} -result {missing count for "@" field specifier}
+test binary-35.2 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-35.3 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+ set arg2 foo
+ list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
+} {1 abc foo}
+test binary-35.4 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef @2a3 arg1] $arg1
+} {1 cde}
+test binary-35.5 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x*@1a1 arg1] $arg1
+} {1 b}
+test binary-35.6 {Tcl_BinaryObjCmd: scan} {
+ unset -nocomplain arg1
+ list [binary scan abcdef x*@0a1 arg1] $arg1
+} {1 a}
+
+test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abcdef u0a3
+} -result {bad field specifier "u"}
+# Jim doesn't bother to throw errors on extra chars in the format spec
+test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -constraints tcl -body {
+ binary scan abcdef "x-1" foo
+} -result {bad field specifier "-"}
+test binary-37.8 {GetFormatSpec: numbers} {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan abcdef "a0x3" arg1] $arg1
+} {1 {}}
+
+test binary-39.1 {ScanNumber: sign extension} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 c2 arg1] $arg1
+} {1 {82 -93}}
+test binary-39.2 {ScanNumber: sign extension} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 cu2 arg1] $arg1
+} {1 {82 163}}
+test binary-39.7 {ScanNumber: no sign extension} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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} {
+ unset -nocomplain 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-41.1 {ScanNumber: word alignment} {
+ unset -nocomplain arg1; unset arg2
+ list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.2 {ScanNumber: word alignment} {
+ unset -nocomplain arg1; unset arg2
+ list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+test binary-41.3 {ScanNumber: word alignment} {
+ unset -nocomplain 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} {
+ unset -nocomplain arg1; unset arg2
+ list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
+} {2 1 1}
+
+test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
+ binary ?
+} -returnCodes error -match glob -result {*}
+
+test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
+ binary scan HelloTcl W x
+ set x
+} 5216694956358656876
+test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
+ binary scan lcTolleH w x
+ set x
+} 5216694956358656876
+test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
+ binary scan [binary format w [expr {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 {3 << 31}]] W x
+ set x
+} 6442450944
+test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
+ unset -nocomplain arg1
+ list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
+} {1 -9223372036854775808}
+# Note that Jim doesn't have unsigned 64 bit ints
+test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {tcl} {
+ unset -nocomplain arg1
+ list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {tcl} {
+ unset -nocomplain arg1
+ list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {tcl} {
+ unset -nocomplain 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} {tcl} {
+ unset -nocomplain 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
+ set x
+} {66 64 0 0 0 0 127 -1 -1 -1 65 76}
+
+test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
+ # This test is only reliable when memory debugging is turned on, but
+ # without even memory debugging it should still generate the expected
+ # answers and might therefore still pick up memory corruption caused by
+ # [Bug 851747].
+ list [binary scan aba ccc x x x] $x
+} {3 97}
+
+test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
+ binary scan [binary format m [expr {3 << 31}]] w x
+ set x
+} 6442450944
+test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
+ binary scan [binary format m [expr {3 << 31}]] W x
+ set x
+} 6442450944
+
+# scan t (s)
+test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
+test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
+} {1 {-23726 21587}}
+test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
+} {1 -23726}
+test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 t1 arg1] $arg1
+} {1 -23726}
+test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 t0 arg1] $arg1
+} {1 {}}
+test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
+} {1 {-23726 21587}}
+test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 t1 arg1] $arg1
+} {0 foo}
+test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
+test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
+} {1 {21155 21332}}
+test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
+} {1 21155}
+test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 t1 arg1] $arg1
+} {1 21155}
+test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3 t0 arg1] $arg1
+} {1 {}}
+test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
+} {1 {21155 21332}}
+test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 t1 arg1] $arg1
+} {0 foo}
+test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain 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 {
+ unset -nocomplain 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 {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
+test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
+} {1 1414767442}
+test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
+} {1 1414767442}
+test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53 n0 arg1] $arg1
+} {1 {}}
+test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
+} {1 {1414767442 67305985}}
+test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 n1 arg1] $arg1
+} {0 foo}
+test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain 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} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
+test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
+} {1 1386435412}
+test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
+} {1 1386435412}
+test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53 n0 arg1] $arg1
+} {1 {}}
+test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
+} {1 {1386435412 16909060}}
+test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
+ set arg1 foo
+ list [binary scan \x52 n1 arg1] $arg1
+} {0 foo}
+test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
+ set arg1 1
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain 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 {
+ unset -nocomplain 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 {
+ unset -nocomplain 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 m
+test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian {
+ binary scan HelloTcl m x
+ set x
+} 5216694956358656876
+test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
+ binary scan lcTolleH m x
+ set x
+} 5216694956358656876
+test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
+ binary scan [binary format w [expr {3 << 31}]] m x
+ set x
+} 6442450944
+test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
+ binary scan [binary format W [expr {3 << 31}]] m x
+ set x
+} 6442450944
+
+testreport
generated by cgit v1.1 at 2024-07-16 17:59:06 +0000