diff options
-rw-r--r-- | auto.def | 10 | ||||
-rw-r--r-- | binary.tcl | 254 | ||||
-rw-r--r-- | jim-load-static-exts.c | 6 | ||||
-rw-r--r-- | jim-pack.c | 380 | ||||
-rw-r--r-- | tests/binary-fmt.test | 660 | ||||
-rw-r--r-- | tests/binary-scan.test | 1084 |
6 files changed, 2390 insertions, 4 deletions
@@ -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 |