1# This file tests the "binary" Tcl command. 2# 3# This file contains a collection of tests for one or more of the Tcl built-in 4# commands. Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright (c) 1997 by Sun Microsystems, Inc. 8# Copyright (c) 1998-1999 by Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution of 11# this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13source [file dirname [info script]]/testing.tcl 14 15needs cmd binary 16if {[testConstraint jim]} { 17 needs cmd pack 18} 19testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] 20testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] 21testConstraint maxCompatibility 0 22testConstraint notImplemented 0 23 24# ---------------------------------------------------------------------- 25 26test binary-0.1 {DupByteArrayInternalRep} { 27 set hdr [binary format cc 0 0316] 28 set buf hellomatt 29 set data $hdr 30 append data $buf 31 string length $data 32} 11 33 34test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body { 35 binary 36} -returnCodes error -match glob -result {wrong # args: *} 37test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body { 38 binary foo 39} -match glob -result {*} 40test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body { 41 binary f 42} -match glob -result {*} 43test binary-1.4 {Tcl_BinaryObjCmd: format} -body { 44 binary format "" 45} -result {} 46 47test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 48 binary format a 49} -result {not enough arguments for all format specifiers} 50test binary-2.2 {Tcl_BinaryObjCmd: format} { 51 binary format a0 foo 52} {} 53test binary-2.3 {Tcl_BinaryObjCmd: format} { 54 binary format a f 55} {f} 56test binary-2.4 {Tcl_BinaryObjCmd: format} { 57 binary format a foo 58} {f} 59test binary-2.5 {Tcl_BinaryObjCmd: format} { 60 binary format a3 foo 61} {foo} 62test binary-2.6 {Tcl_BinaryObjCmd: format} { 63 binary format a5 foo 64} foo\x00\x00 65test binary-2.7 {Tcl_BinaryObjCmd: format} { 66 binary format a*a3 foobarbaz blat 67} foobarbazbla 68test binary-2.8 {Tcl_BinaryObjCmd: format} { 69 binary format a*X3a2 foobar x 70} foox\x00r 71 72test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 73 binary format A 74} -result {not enough arguments for all format specifiers} 75test binary-3.2 {Tcl_BinaryObjCmd: format} { 76 binary format A0 f 77} {} 78test binary-3.3 {Tcl_BinaryObjCmd: format} { 79 binary format A f 80} {f} 81test binary-3.4 {Tcl_BinaryObjCmd: format} { 82 binary format A foo 83} {f} 84test binary-3.5 {Tcl_BinaryObjCmd: format} { 85 binary format A3 foo 86} {foo} 87test binary-3.6 {Tcl_BinaryObjCmd: format} { 88 binary format A5 foo 89} {foo } 90test binary-3.7 {Tcl_BinaryObjCmd: format} { 91 binary format A*A3 foobarbaz blat 92} foobarbazbla 93test binary-3.8 {Tcl_BinaryObjCmd: format} { 94 binary format A*X3A2 foobar x 95} {foox r} 96 97test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 98 binary format B 99} -result {not enough arguments for all format specifiers} 100test binary-4.2 {Tcl_BinaryObjCmd: format} { 101 binary format B0 1 102} {} 103test binary-4.3 {Tcl_BinaryObjCmd: format} { 104 binary format B 1 105} \x80 106test binary-4.4 {Tcl_BinaryObjCmd: format} { 107 binary format B* 010011 108} \x4c 109test binary-4.5 {Tcl_BinaryObjCmd: format} { 110 binary format B8 01001101 111} \x4d 112test binary-4.6 {Tcl_BinaryObjCmd: format} { 113 binary format A2X2B9 oo 01001101 114} \x4d\x00 115test binary-4.7 {Tcl_BinaryObjCmd: format} { 116 binary format B9 010011011010 117} \x4d\x80 118test binary-4.8 {Tcl_BinaryObjCmd: format} { 119 binary format B2B3 10 010 120} \x80\x40 121test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 122 binary format B1B5 1 foo 123} -match glob -result {expected *} 124 125test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 126 binary format b 127} -result {not enough arguments for all format specifiers} 128test binary-5.2 {Tcl_BinaryObjCmd: format} { 129 binary format b0 1 130} {} 131test binary-5.3 {Tcl_BinaryObjCmd: format} { 132 binary format b 1 133} \x01 134test binary-5.4 {Tcl_BinaryObjCmd: format} { 135 binary format b* 010011 136} 2 137test binary-5.5 {Tcl_BinaryObjCmd: format} { 138 binary format b8 01001101 139} \xb2 140test binary-5.6 {Tcl_BinaryObjCmd: format} { 141 binary format A2X2b9 oo 01001101 142} \xb2\x00 143test binary-5.7 {Tcl_BinaryObjCmd: format} { 144 binary format b9 010011011010 145} \xb2\x01 146test binary-5.8 {Tcl_BinaryObjCmd: format} { 147 binary format b17 1 148} \x01\00\00 149test binary-5.9 {Tcl_BinaryObjCmd: format} { 150 binary format b2b3 10 010 151} \x01\x02 152test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 153 binary format b1b5 1 foo 154} -match glob -result {expected *} 155 156test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 157 binary format h 158} -result {not enough arguments for all format specifiers} 159test binary-6.2 {Tcl_BinaryObjCmd: format} { 160 binary format h0 1 161} {} 162test binary-6.3 {Tcl_BinaryObjCmd: format} { 163 binary format h 1 164} \x01 165test binary-6.4 {Tcl_BinaryObjCmd: format} { 166 binary format h c 167} \x0c 168test binary-6.5 {Tcl_BinaryObjCmd: format} { 169 binary format h* baadf00d 170} \xab\xda\x0f\xd0 171test binary-6.6 {Tcl_BinaryObjCmd: format} { 172 binary format h4 c410 173} \x4c\x01 174test binary-6.7 {Tcl_BinaryObjCmd: format} { 175 binary format h6 c4102 176} \x4c\x01\x02 177test binary-6.8 {Tcl_BinaryObjCmd: format} { 178 binary format h5 c41020304 179} \x4c\x01\x02 180test binary-6.9 {Tcl_BinaryObjCmd: format} { 181 binary format a3X3h5 foo 2 182} \x02\x00\x00 183test binary-6.10 {Tcl_BinaryObjCmd: format} { 184 binary format h2h3 23 456 185} \x32\x54\x06 186test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 187 binary format h2 foo 188} -match glob -result {expected *} 189 190test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 191 binary format H 192} -result {not enough arguments for all format specifiers} 193test binary-7.2 {Tcl_BinaryObjCmd: format} { 194 binary format H0 1 195} {} 196test binary-7.3 {Tcl_BinaryObjCmd: format} { 197 binary format H 1 198} \x10 199test binary-7.4 {Tcl_BinaryObjCmd: format} { 200 binary format H c 201} \xc0 202test binary-7.5 {Tcl_BinaryObjCmd: format} { 203 binary format H* baadf00d 204} \xba\xad\xf0\x0d 205test binary-7.6 {Tcl_BinaryObjCmd: format} { 206 binary format H4 c410 207} \xc4\x10 208test binary-7.7 {Tcl_BinaryObjCmd: format} { 209 binary format H6 c4102 210} \xc4\x10\x20 211test binary-7.8 {Tcl_BinaryObjCmd: format} { 212 binary format H5 c41023304 213} \xc4\x10\x20 214test binary-7.9 {Tcl_BinaryObjCmd: format} { 215 binary format a3X3H5 foo 2 216} \x20\x00\x00 217test binary-7.10 {Tcl_BinaryObjCmd: format} { 218 binary format H2H3 23 456 219} \x23\x45\x60 220test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 221 binary format H2 foo 222} -match glob -result {expected *} 223 224test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 225 binary format c 226} -result {not enough arguments for all format specifiers} 227test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 228 binary format c blat 229} -match glob -result {expected *} 230test binary-8.3 {Tcl_BinaryObjCmd: format} { 231 binary format c0 0x50 232} {} 233test binary-8.4 {Tcl_BinaryObjCmd: format} { 234 binary format c 0x50 235} P 236test binary-8.5 {Tcl_BinaryObjCmd: format} { 237 binary format c 0x5052 238} R 239test binary-8.6 {Tcl_BinaryObjCmd: format} { 240 binary format c2 {0x50 0x52} 241} PR 242test binary-8.7 {Tcl_BinaryObjCmd: format} { 243 binary format c2 {0x50 0x52 0x53} 244} PR 245test binary-8.8 {Tcl_BinaryObjCmd: format} { 246 binary format c* {0x50 0x52} 247} PR 248test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 249 binary format c2 {0x50} 250} -result {number of elements in list does not match count} 251test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 252 set a {0x50 0x51} 253 binary format c $a 254} -match glob -result "expected integer *but got \"0x50 0x51\"" 255test binary-8.11 {Tcl_BinaryObjCmd: format} { 256 set a {0x50 0x51} 257 binary format c1 $a 258} P 259 260test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 261 binary format s 262} -result {not enough arguments for all format specifiers} 263test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 264 binary format s blat 265} -match glob -result {expected integer *but got "blat"} 266test binary-9.3 {Tcl_BinaryObjCmd: format} { 267 binary format s0 0x50 268} {} 269test binary-9.4 {Tcl_BinaryObjCmd: format} { 270 binary format s 0x50 271} P\x00 272test binary-9.5 {Tcl_BinaryObjCmd: format} { 273 binary format s 0x5052 274} RP 275test binary-9.6 {Tcl_BinaryObjCmd: format} { 276 binary format s 0x505251 0x53 277} QR 278test binary-9.7 {Tcl_BinaryObjCmd: format} { 279 binary format s2 {0x50 0x52} 280} P\x00R\x00 281test binary-9.8 {Tcl_BinaryObjCmd: format} { 282 binary format s* {0x5051 0x52} 283} QPR\x00 284test binary-9.9 {Tcl_BinaryObjCmd: format} { 285 binary format s2 {0x50 0x52 0x53} 0x54 286} P\x00R\x00 287test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 288 binary format s2 {0x50} 289} -result {number of elements in list does not match count} 290test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 291 set a {0x50 0x51} 292 binary format s $a 293} -match glob -result "expected integer *but got \"0x50 0x51\"" 294test binary-9.12 {Tcl_BinaryObjCmd: format} { 295 set a {0x50 0x51} 296 binary format s1 $a 297} P\x00 298 299test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 300 binary format S 301} -result {not enough arguments for all format specifiers} 302test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 303 binary format S blat 304} -match glob -result {expected integer *but got "blat"} 305test binary-10.3 {Tcl_BinaryObjCmd: format} { 306 binary format S0 0x50 307} {} 308test binary-10.4 {Tcl_BinaryObjCmd: format} { 309 binary format S 0x50 310} \x00P 311test binary-10.5 {Tcl_BinaryObjCmd: format} { 312 binary format S 0x5052 313} PR 314test binary-10.6 {Tcl_BinaryObjCmd: format} { 315 binary format S 0x505251 0x53 316} RQ 317test binary-10.7 {Tcl_BinaryObjCmd: format} { 318 binary format S2 {0x50 0x52} 319} \x00P\x00R 320test binary-10.8 {Tcl_BinaryObjCmd: format} { 321 binary format S* {0x5051 0x52} 322} PQ\x00R 323test binary-10.9 {Tcl_BinaryObjCmd: format} { 324 binary format S2 {0x50 0x52 0x53} 0x54 325} \x00P\x00R 326test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 327 binary format S2 {0x50} 328} -result {number of elements in list does not match count} 329test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 330 set a {0x50 0x51} 331 binary format S $a 332} -match glob -result "expected integer *but got \"0x50 0x51\"" 333test binary-10.12 {Tcl_BinaryObjCmd: format} { 334 set a {0x50 0x51} 335 binary format S1 $a 336} \x00P 337 338test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 339 binary format i 340} -result {not enough arguments for all format specifiers} 341test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 342 binary format i blat 343} -match glob -result {expected integer *but got "blat"} 344test binary-11.3 {Tcl_BinaryObjCmd: format} { 345 binary format i0 0x50 346} {} 347test binary-11.4 {Tcl_BinaryObjCmd: format} { 348 binary format i 0x50 349} P\x00\x00\x00 350test binary-11.5 {Tcl_BinaryObjCmd: format} { 351 binary format i 0x5052 352} RP\x00\x00 353test binary-11.6 {Tcl_BinaryObjCmd: format} { 354 binary format i 0x505251 0x53 355} QRP\x00 356test binary-11.7 {Tcl_BinaryObjCmd: format} { 357 binary format i1 {0x505251 0x53} 358} QRP\x00 359test binary-11.8 {Tcl_BinaryObjCmd: format} { 360 binary format i 0x53525150 361} PQRS 362test binary-11.9 {Tcl_BinaryObjCmd: format} { 363 binary format i2 {0x50 0x52} 364} P\x00\x00\x00R\x00\x00\x00 365test binary-11.10 {Tcl_BinaryObjCmd: format} { 366 binary format i* {0x50515253 0x52} 367} SRQPR\x00\x00\x00 368test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 369 binary format i2 {0x50} 370} -result {number of elements in list does not match count} 371test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 372 set a {0x50 0x51} 373 binary format i $a 374} -match glob -result "expected integer *but got \"0x50 0x51\"" 375test binary-11.13 {Tcl_BinaryObjCmd: format} { 376 set a {0x50 0x51} 377 binary format i1 $a 378} P\x00\x00\x00 379 380test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 381 binary format I 382} -result {not enough arguments for all format specifiers} 383test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 384 binary format I blat 385} -match glob -result {expected integer *but got "blat"} 386test binary-12.3 {Tcl_BinaryObjCmd: format} { 387 binary format I0 0x50 388} {} 389test binary-12.4 {Tcl_BinaryObjCmd: format} { 390 binary format I 0x50 391} \x00\x00\x00P 392test binary-12.5 {Tcl_BinaryObjCmd: format} { 393 binary format I 0x5052 394} \x00\x00PR 395test binary-12.6 {Tcl_BinaryObjCmd: format} { 396 binary format I 0x505251 0x53 397} \x00PRQ 398test binary-12.7 {Tcl_BinaryObjCmd: format} { 399 binary format I1 {0x505251 0x53} 400} \x00PRQ 401test binary-12.8 {Tcl_BinaryObjCmd: format} { 402 binary format I 0x53525150 403} SRQP 404test binary-12.9 {Tcl_BinaryObjCmd: format} { 405 binary format I2 {0x50 0x52} 406} \x00\x00\x00P\x00\x00\x00R 407test binary-12.10 {Tcl_BinaryObjCmd: format} { 408 binary format I* {0x50515253 0x52} 409} PQRS\x00\x00\x00R 410test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 411 binary format i2 {0x50} 412} -result {number of elements in list does not match count} 413test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 414 set a {0x50 0x51} 415 binary format I $a 416} -match glob -result "expected integer *but got \"0x50 0x51\"" 417test binary-12.13 {Tcl_BinaryObjCmd: format} { 418 set a {0x50 0x51} 419 binary format I1 $a 420} \x00\x00\x00P 421 422test binary-13.1 {Tcl_BinaryObjCmd: format} { 423 list [catch {binary format f} msg] $msg 424} {1 {not enough arguments for all format specifiers}} 425test binary-13.2 {Tcl_BinaryObjCmd: format} { 426 list [catch {binary format f blat} msg] $msg 427} {1 {expected floating-point number but got "blat"}} 428test binary-13.3 {Tcl_BinaryObjCmd: format} { 429 binary format f0 1.6 430} {} 431test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian { 432 binary format f 1.6 433} \x3f\xcc\xcc\xcd 434test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian { 435 binary format f 1.6 436} \xcd\xcc\xcc\x3f 437test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian { 438 binary format f* {1.6 3.4} 439} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 440test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian { 441 binary format f* {1.6 3.4} 442} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 443test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian { 444 binary format f2 {1.6 3.4} 445} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 446test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian { 447 binary format f2 {1.6 3.4} 448} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 449test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian { 450 binary format f2 {1.6 3.4 5.6} 451} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 452test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian { 453 binary format f2 {1.6 3.4 5.6} 454} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 455test binary-13.12 {Tcl_BinaryObjCmd: float overflow} {bigEndian maxCompatibility} { 456 binary format f -3.402825e+38 457} \xff\x7f\xff\xff 458test binary-13.13 {Tcl_BinaryObjCmd: float overflow} {littleEndian maxCompatibility} { 459 binary format f -3.402825e+38 460} \xff\xff\x7f\xff 461test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian { 462 binary format f -3.402825e-100 463} \x80\x00\x00\x00 464test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian { 465 binary format f -3.402825e-100 466} \x00\x00\x00\x80 467test binary-13.16 {Tcl_BinaryObjCmd: format} { 468 list [catch {binary format f2 {1.6}} msg] $msg 469} {1 {number of elements in list does not match count}} 470test binary-13.17 {Tcl_BinaryObjCmd: format} { 471 set a {1.6 3.4} 472 list [catch {binary format f $a} msg] $msg 473} [list 1 "expected floating-point number but got \"1.6 3.4\""] 474test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian { 475 set a {1.6 3.4} 476 binary format f1 $a 477} \x3f\xcc\xcc\xcd 478test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian { 479 set a {1.6 3.4} 480 binary format f1 $a 481} \xcd\xcc\xcc\x3f 482 483test binary-14.1 {Tcl_BinaryObjCmd: format} { 484 list [catch {binary format d} msg] $msg 485} {1 {not enough arguments for all format specifiers}} 486test binary-14.2 {Tcl_BinaryObjCmd: format} { 487 list [catch {binary format d blat} msg] $msg 488} {1 {expected floating-point number but got "blat"}} 489test binary-14.3 {Tcl_BinaryObjCmd: format} { 490 binary format d0 1.6 491} {} 492test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian { 493 binary format d 1.6 494} \x3f\xf9\x99\x99\x99\x99\x99\x9a 495test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian { 496 binary format d 1.6 497} \x9a\x99\x99\x99\x99\x99\xf9\x3f 498test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian { 499 binary format d* {1.6 3.4} 500} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 501test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian { 502 binary format d* {1.6 3.4} 503} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 504test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian { 505 binary format d2 {1.6 3.4} 506} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 507test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian { 508 binary format d2 {1.6 3.4} 509} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 510test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian { 511 binary format d2 {1.6 3.4 5.6} 512} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 513test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian { 514 binary format d2 {1.6 3.4 5.6} 515} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 516test binary-14.14 {Tcl_BinaryObjCmd: format} { 517 list [catch {binary format d2 {1.6}} msg] $msg 518} {1 {number of elements in list does not match count}} 519test binary-14.15 {Tcl_BinaryObjCmd: format} { 520 set a {1.6 3.4} 521 list [catch {binary format d $a} msg] $msg 522} [list 1 "expected floating-point number but got \"1.6 3.4\""] 523test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian { 524 set a {1.6 3.4} 525 binary format d1 $a 526} \x3f\xf9\x99\x99\x99\x99\x99\x9a 527test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian { 528 set a {1.6 3.4} 529 binary format d1 $a 530} \x9a\x99\x99\x99\x99\x99\xf9\x3f 531test binary-14.18 {FormatNumber: Bug 1116542} { 532 binary scan [binary format d 1.25] d w 533 set w 534} 1.25 535 536test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 537 binary format ax*a "y" "z" 538} -result {cannot use "*" in format string with "x"} 539test binary-15.2 {Tcl_BinaryObjCmd: format} { 540 binary format axa "y" "z" 541} y\x00z 542test binary-15.3 {Tcl_BinaryObjCmd: format} { 543 binary format ax3a "y" "z" 544} y\x00\x00\x00z 545test binary-15.4 {Tcl_BinaryObjCmd: format} { 546 binary format a*X3x3a* "foo" "z" 547} \x00\x00\x00z 548test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} { 549 binary format x0s 1 550} \x01\x00 551test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} { 552 binary format x0ss 1 1 553} \x01\x00\x01\x00 554test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} { 555 binary format x1s 1 556} \x00\x01\x00 557test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} { 558 binary format x1ss 1 1 559} \x00\x01\x00\x01\x00 560 561test binary-16.1 {Tcl_BinaryObjCmd: format} { 562 binary format a*X*a "foo" "z" 563} zoo 564test binary-16.2 {Tcl_BinaryObjCmd: format} { 565 binary format aX3a "y" "z" 566} z 567test binary-16.3 {Tcl_BinaryObjCmd: format} { 568 binary format a*Xa* "foo" "zy" 569} fozy 570test binary-16.4 {Tcl_BinaryObjCmd: format} { 571 binary format a*X3a "foobar" "z" 572} foozar 573test binary-16.5 {Tcl_BinaryObjCmd: format} { 574 binary format a*X3aX2a "foobar" "z" "b" 575} fobzar 576 577test binary-17.1 {Tcl_BinaryObjCmd: format} { 578 binary format @1 579} \x00 580test binary-17.2 {Tcl_BinaryObjCmd: format} { 581 binary format @5a2 "ab" 582} \x00\x00\x00\x00\x00\x61\x62 583test binary-17.3 {Tcl_BinaryObjCmd: format} { 584 binary format {a* @0 a2 @* a*} "foobar" "ab" "blat" 585} abobarblat 586 587test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 588 binary format u0a3 abc abd 589} -result {bad field specifier "u"} 590 591test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body { 592 binary s 593} -match glob -result {*} 594test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body { 595 binary scan foo 596} -result {wrong # args: should be "binary scan value formatString ?varName ...?"} 597test binary-19.3 {Tcl_BinaryObjCmd: scan} { 598 binary scan {} {} 599} 0 600 601test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 602 binary scan abc a 603} -result {not enough arguments for all format specifiers} 604test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup { 605 unset -nocomplain arg1 606} -returnCodes error -body { 607 set arg1 1 608 binary scan abc a arg1(a) 609} -result {can't set "arg1(a)": variable isn't array} 610test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup { 611 unset -nocomplain arg1 612} -body { 613 set arg1 abc 614 list [binary scan abc a0 arg1] $arg1 615} -result {1 {}} 616test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup { 617 unset -nocomplain arg1 618} -body { 619 list [binary scan abc a* arg1] $arg1 620} -result {1 abc} 621test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup { 622 unset -nocomplain arg1 623} -body { 624 list [binary scan abc a5 arg1] [info exists arg1] 625} -result {0 0} 626test binary-20.6 {Tcl_BinaryObjCmd: scan} { 627 set arg1 foo 628 list [binary scan abc a2 arg1] $arg1 629} {1 ab} 630test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup { 631 unset -nocomplain arg1 632 unset -nocomplain arg2 633} -body { 634 list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2 635} -result {2 ab cd} 636test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup { 637 unset -nocomplain arg1 638} -body { 639 list [binary scan abc a2 arg1(a)] $arg1(a) 640} -result {1 ab} 641test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup { 642 unset -nocomplain arg1 643} -body { 644 list [binary scan abc a arg1(a)] $arg1(a) 645} -result {1 a} 646 647# As soon as a conversion runs out of bytes, scan should stop 648test binary-20.10 {Tcl_BinaryObjCmd: scan, too few bytes} -setup { 649 unset -nocomplain arg1 arg2 650} -body { 651 list [binary scan abc a5a2 arg1 arg2] [info exists arg1] [info exists arg2] 652} -result {0 0 0} 653 654test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 655 binary scan abc A 656} -result {not enough arguments for all format specifiers} 657test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup { 658 unset -nocomplain arg1 659} -returnCodes error -body { 660 set arg1 1 661 binary scan abc A arg1(a) 662} -result {can't set "arg1(a)": variable isn't array} 663test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup { 664 unset -nocomplain arg1 665} -body { 666 set arg1 abc 667 list [binary scan abc A0 arg1] $arg1 668} -result {1 {}} 669test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup { 670 unset -nocomplain arg1 671} -body { 672 list [binary scan abc A* arg1] $arg1 673} -result {1 abc} 674test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup { 675 unset -nocomplain arg1 676} -body { 677 list [binary scan abc A5 arg1] [info exists arg1] 678} -result {0 0} 679test binary-21.6 {Tcl_BinaryObjCmd: scan} { 680 set arg1 foo 681 list [binary scan abc A2 arg1] $arg1 682} {1 ab} 683test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup { 684 unset -nocomplain arg1 685 unset -nocomplain arg2 686} -body { 687 list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2 688} -result {2 ab cd} 689test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup { 690 unset -nocomplain arg1 691} -body { 692 list [binary scan abc A2 arg1(a)] $arg1(a) 693} -result {1 ab} 694test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup { 695 unset -nocomplain arg1 696} -body { 697 list [binary scan abc A2 arg1(a)] $arg1(a) 698} -result {1 ab} 699test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup { 700 unset -nocomplain arg1 701} -body { 702 list [binary scan abc A arg1(a)] $arg1(a) 703} -result {1 a} 704test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup { 705 unset -nocomplain arg1 706} -body { 707 list [binary scan "abc def \x00 " A* arg1] $arg1 708} -result {1 {abc def}} 709test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { 710 unset -nocomplain arg1 711} -body { 712 list [binary scan "abc def \x00ghi " A* arg1] $arg1 713} -result [list 1 "abc def \x00ghi"] 714 715test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 716 binary scan abc b 717} -result {not enough arguments for all format specifiers} 718test binary-22.2 {Tcl_BinaryObjCmd: scan} { 719 unset -nocomplain arg1 720 list [binary scan \x52\x53 b* arg1] $arg1 721} {1 0100101011001010} 722test binary-22.3 {Tcl_BinaryObjCmd: scan} { 723 unset -nocomplain arg1 724 list [binary scan \x82\x53 b arg1] $arg1 725} {1 0} 726test binary-22.4 {Tcl_BinaryObjCmd: scan} { 727 unset -nocomplain arg1 728 list [binary scan \x82\x53 b1 arg1] $arg1 729} {1 0} 730test binary-22.5 {Tcl_BinaryObjCmd: scan} { 731 unset -nocomplain arg1 732 list [binary scan \x82\x53 b0 arg1] $arg1 733} {1 {}} 734test binary-22.6 {Tcl_BinaryObjCmd: scan} { 735 unset -nocomplain arg1 736 list [binary scan \x52\x53 b5 arg1] $arg1 737} {1 01001} 738test binary-22.7 {Tcl_BinaryObjCmd: scan} { 739 unset -nocomplain arg1 740 list [binary scan \x52\x53 b8 arg1] $arg1 741} {1 01001010} 742test binary-22.8 {Tcl_BinaryObjCmd: scan} { 743 unset -nocomplain arg1 744 list [binary scan \x52\x53 b14 arg1] $arg1 745} {1 01001010110010} 746test binary-22.9 {Tcl_BinaryObjCmd: scan} { 747 unset -nocomplain arg1 748 set arg1 foo 749 list [binary scan \x52 b14 arg1] $arg1 750} {0 foo} 751test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup { 752 unset -nocomplain arg1 753} -returnCodes error -body { 754 set arg1 1 755 binary scan \x52\x53 b1 arg1(a) 756} -result {can't set "arg1(a)": variable isn't array} 757test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup { 758 unset -nocomplain arg1 arg2 759} -body { 760 set arg1 foo 761 set arg2 bar 762 list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2 763} -result {2 11100 1110000110100000} 764 765# As soon as a conversion runs out of bytes, scan should stop 766test binary-20.12 {Tcl_BinaryObjCmd: scan, too few bytes} { 767 unset -nocomplain arg1 arg2 768 set arg1 foo 769 set arg2 bar 770 list [binary scan \x52 b14b8 arg1 arg2] $arg1 $arg2 771} {0 foo bar} 772 773test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 774 binary scan abc B 775} -result {not enough arguments for all format specifiers} 776test binary-23.2 {Tcl_BinaryObjCmd: scan} { 777 unset -nocomplain arg1 778 list [binary scan \x52\x53 B* arg1] $arg1 779} {1 0101001001010011} 780test binary-23.3 {Tcl_BinaryObjCmd: scan} { 781 unset -nocomplain arg1 782 list [binary scan \x82\x53 B arg1] $arg1 783} {1 1} 784test binary-23.4 {Tcl_BinaryObjCmd: scan} { 785 unset -nocomplain arg1 786 list [binary scan \x82\x53 B1 arg1] $arg1 787} {1 1} 788test binary-23.5 {Tcl_BinaryObjCmd: scan} { 789 unset -nocomplain arg1 790 list [binary scan \x52\x53 B0 arg1] $arg1 791} {1 {}} 792test binary-23.6 {Tcl_BinaryObjCmd: scan} { 793 unset -nocomplain arg1 794 list [binary scan \x52\x53 B5 arg1] $arg1 795} {1 01010} 796test binary-23.7 {Tcl_BinaryObjCmd: scan} { 797 unset -nocomplain arg1 798 list [binary scan \x52\x53 B8 arg1] $arg1 799} {1 01010010} 800test binary-23.8 {Tcl_BinaryObjCmd: scan} { 801 unset -nocomplain arg1 802 list [binary scan \x52\x53 B14 arg1] $arg1 803} {1 01010010010100} 804test binary-23.9 {Tcl_BinaryObjCmd: scan} { 805 unset -nocomplain arg1 806 set arg1 foo 807 list [binary scan \x52 B14 arg1] $arg1 808} {0 foo} 809test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup { 810 unset -nocomplain arg1 811} -returnCodes error -body { 812 set arg1 1 813 binary scan \x52\x53 B1 arg1(a) 814} -result {can't set "arg1(a)": variable isn't array} 815test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup { 816 unset -nocomplain arg1 arg2 817} -body { 818 set arg1 foo 819 set arg2 bar 820 list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2 821} -result {2 01110 1000011100000101} 822 823test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 824 binary scan abc h 825} -result {not enough arguments for all format specifiers} 826test binary-24.2 {Tcl_BinaryObjCmd: scan} { 827 unset -nocomplain arg1 828 list [binary scan \x52\xa3 h* arg1] $arg1 829} {1 253a} 830test binary-24.3 {Tcl_BinaryObjCmd: scan} { 831 unset -nocomplain arg1 832 list [binary scan \xc2\xa3 h arg1] $arg1 833} {1 2} 834test binary-24.4 {Tcl_BinaryObjCmd: scan} { 835 unset -nocomplain arg1 836 list [binary scan \x82\x53 h1 arg1] $arg1 837} {1 2} 838test binary-24.5 {Tcl_BinaryObjCmd: scan} { 839 unset -nocomplain arg1 840 list [binary scan \x52\x53 h0 arg1] $arg1 841} {1 {}} 842test binary-24.6 {Tcl_BinaryObjCmd: scan} { 843 unset -nocomplain arg1 844 list [binary scan \xf2\x53 h2 arg1] $arg1 845} {1 2f} 846test binary-24.7 {Tcl_BinaryObjCmd: scan} { 847 unset -nocomplain arg1 848 list [binary scan \x52\x53 h3 arg1] $arg1 849} {1 253} 850test binary-24.8 {Tcl_BinaryObjCmd: scan} { 851 unset -nocomplain arg1 852 set arg1 foo 853 list [binary scan \x52 h3 arg1] $arg1 854} {0 foo} 855test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup { 856 unset -nocomplain arg1 857} -returnCodes error -body { 858 set arg1 1 859 binary scan \x52\x53 h1 arg1(a) 860} -result {can't set "arg1(a)": variable isn't array} 861test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup { 862 unset -nocomplain arg1 arg2 863} -body { 864 set arg1 foo 865 set arg2 bar 866 list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2 867} -result {2 07 7850} 868 869test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 870 binary scan abc H 871} -result {not enough arguments for all format specifiers} 872test binary-25.2 {Tcl_BinaryObjCmd: scan} { 873 unset -nocomplain arg1 874 list [binary scan \x52\xa3 H* arg1] $arg1 875} {1 52a3} 876test binary-25.3 {Tcl_BinaryObjCmd: scan} { 877 unset -nocomplain arg1 878 list [binary scan \xc2\xa3 H arg1] $arg1 879} {1 c} 880test binary-25.4 {Tcl_BinaryObjCmd: scan} { 881 unset -nocomplain arg1 882 list [binary scan \x82\x53 H1 arg1] $arg1 883} {1 8} 884test binary-25.5 {Tcl_BinaryObjCmd: scan} { 885 unset -nocomplain arg1 886 list [binary scan \x52\x53 H0 arg1] $arg1 887} {1 {}} 888test binary-25.6 {Tcl_BinaryObjCmd: scan} { 889 unset -nocomplain arg1 890 list [binary scan \xf2\x53 H2 arg1] $arg1 891} {1 f2} 892test binary-25.7 {Tcl_BinaryObjCmd: scan} { 893 unset -nocomplain arg1 894 list [binary scan \x52\x53 H3 arg1] $arg1 895} {1 525} 896test binary-25.8 {Tcl_BinaryObjCmd: scan} { 897 unset -nocomplain arg1 898 set arg1 foo 899 list [binary scan \x52 H3 arg1] $arg1 900} {0 foo} 901test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup { 902 unset -nocomplain arg1 903} -returnCodes error -body { 904 set arg1 1 905 binary scan \x52\x53 H1 arg1(a) 906} -result {can't set "arg1(a)": variable isn't array} 907test binary-25.10 {Tcl_BinaryObjCmd: scan} { 908 unset -nocomplain arg1 arg2 909 set arg1 foo 910 set arg2 bar 911 list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2 912} {2 70 8705} 913 914test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 915 binary scan abc c 916} -result {not enough arguments for all format specifiers} 917test binary-26.2 {Tcl_BinaryObjCmd: scan} { 918 unset -nocomplain arg1 919 list [binary scan \x52\xa3 c* arg1] $arg1 920} {1 {82 -93}} 921test binary-26.3 {Tcl_BinaryObjCmd: scan} { 922 unset -nocomplain arg1 923 list [binary scan \x52\xa3 c arg1] $arg1 924} {1 82} 925test binary-26.4 {Tcl_BinaryObjCmd: scan} { 926 unset -nocomplain arg1 927 list [binary scan \x52\xa3 c1 arg1] $arg1 928} {1 82} 929test binary-26.5 {Tcl_BinaryObjCmd: scan} { 930 unset -nocomplain arg1 931 list [binary scan \x52\xa3 c0 arg1] $arg1 932} {1 {}} 933test binary-26.6 {Tcl_BinaryObjCmd: scan} { 934 unset -nocomplain arg1 935 list [binary scan \x52\xa3 c2 arg1] $arg1 936} {1 {82 -93}} 937test binary-26.7 {Tcl_BinaryObjCmd: scan} { 938 unset -nocomplain arg1 939 list [binary scan \xff c arg1] $arg1 940} {1 -1} 941test binary-26.8 {Tcl_BinaryObjCmd: scan} { 942 unset -nocomplain arg1 943 set arg1 foo 944 list [binary scan \x52 c3 arg1] $arg1 945} {0 foo} 946test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup { 947 unset -nocomplain arg1 948} -returnCodes error -body { 949 set arg1 1 950 binary scan \x52\x53 c1 arg1(a) 951} -result {can't set "arg1(a)": variable isn't array} 952test binary-26.10 {Tcl_BinaryObjCmd: scan} { 953 unset -nocomplain arg1 arg2 954 set arg1 foo 955 set arg2 bar 956 list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2 957} {2 {112 -121} 5} 958test binary-26.11 {Tcl_BinaryObjCmd: scan} { 959 unset -nocomplain arg1 960 list [binary scan \x52\xa3 cu* arg1] $arg1 961} {1 {82 163}} 962test binary-26.12 {Tcl_BinaryObjCmd: scan} { 963 unset -nocomplain arg1 964 list [binary scan \x52\xa3 cu arg1] $arg1 965} {1 82} 966test binary-26.13 {Tcl_BinaryObjCmd: scan} { 967 unset -nocomplain arg1 968 list [binary scan \xff cu arg1] $arg1 969} {1 255} 970test binary-26.14 {Tcl_BinaryObjCmd: scan} { 971 unset -nocomplain arg1 arg2 972 set arg1 foo 973 set arg2 bar 974 list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2 975} {2 128 -128} 976test binary-26.15 {Tcl_BinaryObjCmd: scan} { 977 unset -nocomplain arg1 arg2 978 set arg1 foo 979 set arg2 bar 980 list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2 981} {2 -128 128} 982 983test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 984 binary scan abc s 985} -result {not enough arguments for all format specifiers} 986test binary-27.2 {Tcl_BinaryObjCmd: scan} { 987 unset -nocomplain arg1 988 list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1 989} {1 {-23726 21587}} 990test binary-27.3 {Tcl_BinaryObjCmd: scan} { 991 unset -nocomplain arg1 992 list [binary scan \x52\xa3\x53\x54 s arg1] $arg1 993} {1 -23726} 994test binary-27.4 {Tcl_BinaryObjCmd: scan} { 995 unset -nocomplain arg1 996 list [binary scan \x52\xa3 s1 arg1] $arg1 997} {1 -23726} 998test binary-27.5 {Tcl_BinaryObjCmd: scan} { 999 unset -nocomplain arg1 1000 list [binary scan \x52\xa3 s0 arg1] $arg1 1001} {1 {}} 1002test binary-27.6 {Tcl_BinaryObjCmd: scan} { 1003 unset -nocomplain arg1 1004 list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1 1005} {1 {-23726 21587}} 1006test binary-27.7 {Tcl_BinaryObjCmd: scan} { 1007 unset -nocomplain arg1 1008 set arg1 foo 1009 list [binary scan \x52 s1 arg1] $arg1 1010} {0 foo} 1011test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup { 1012 unset -nocomplain arg1 1013} -returnCodes error -body { 1014 set arg1 1 1015 binary scan \x52\x53 s1 arg1(a) 1016} -result {can't set "arg1(a)": variable isn't array} 1017test binary-27.9 {Tcl_BinaryObjCmd: scan} { 1018 unset -nocomplain arg1 arg2 1019 set arg1 foo 1020 set arg2 bar 1021 list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2 1022} {2 {-23726 21587} 5} 1023test binary-27.10 {Tcl_BinaryObjCmd: scan} { 1024 unset -nocomplain arg1 1025 list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1 1026} {1 {41810 21587}} 1027test binary-27.11 {Tcl_BinaryObjCmd: scan} { 1028 unset -nocomplain arg1 arg2 1029 set arg1 foo 1030 set arg2 bar 1031 list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2 1032} {2 65535 -1} 1033test binary-27.12 {Tcl_BinaryObjCmd: scan} { 1034 unset -nocomplain arg1 arg2 1035 set arg1 foo 1036 set arg2 bar 1037 list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2 1038} {2 -1 65535} 1039 1040test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1041 binary scan abc S 1042} -result {not enough arguments for all format specifiers} 1043test binary-28.2 {Tcl_BinaryObjCmd: scan} { 1044 unset -nocomplain arg1 1045 list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1 1046} {1 {21155 21332}} 1047test binary-28.3 {Tcl_BinaryObjCmd: scan} { 1048 unset -nocomplain arg1 1049 list [binary scan \x52\xa3\x53\x54 S arg1] $arg1 1050} {1 21155} 1051test binary-28.4 {Tcl_BinaryObjCmd: scan} { 1052 unset -nocomplain arg1 1053 list [binary scan \x52\xa3 S1 arg1] $arg1 1054} {1 21155} 1055test binary-28.5 {Tcl_BinaryObjCmd: scan} { 1056 unset -nocomplain arg1 1057 list [binary scan \x52\xa3 S0 arg1] $arg1 1058} {1 {}} 1059test binary-28.6 {Tcl_BinaryObjCmd: scan} { 1060 unset -nocomplain arg1 1061 list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1 1062} {1 {21155 21332}} 1063test binary-28.7 {Tcl_BinaryObjCmd: scan} { 1064 unset -nocomplain arg1 1065 set arg1 foo 1066 list [binary scan \x52 S1 arg1] $arg1 1067} {0 foo} 1068test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup { 1069 unset -nocomplain arg1 1070} -returnCodes error -body { 1071 set arg1 1 1072 binary scan \x52\x53 S1 arg1(a) 1073} -result {can't set "arg1(a)": variable isn't array} 1074test binary-28.9 {Tcl_BinaryObjCmd: scan} { 1075 unset -nocomplain arg1 arg2 1076 set arg1 foo 1077 set arg2 bar 1078 list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2 1079} {2 {21155 21332} 5} 1080test binary-28.10 {Tcl_BinaryObjCmd: scan} { 1081 unset -nocomplain arg1 1082 list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1 1083} {1 {21155 21332}} 1084test binary-28.11 {Tcl_BinaryObjCmd: scan} { 1085 unset -nocomplain arg1 1086 list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1 1087} {1 {41810 21587}} 1088 1089test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1090 binary scan abc i 1091} -result {not enough arguments for all format specifiers} 1092test binary-29.2 {Tcl_BinaryObjCmd: scan} { 1093 unset -nocomplain arg1 1094 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1 1095} {1 {1414767442 67305985}} 1096test binary-29.3 {Tcl_BinaryObjCmd: scan} { 1097 unset -nocomplain arg1 1098 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1 1099} {1 1414767442} 1100test binary-29.4 {Tcl_BinaryObjCmd: scan} { 1101 unset -nocomplain arg1 1102 list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1 1103} {1 1414767442} 1104test binary-29.5 {Tcl_BinaryObjCmd: scan} { 1105 unset -nocomplain arg1 1106 list [binary scan \x52\xa3\x53 i0 arg1] $arg1 1107} {1 {}} 1108test binary-29.6 {Tcl_BinaryObjCmd: scan} { 1109 unset -nocomplain arg1 1110 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1 1111} {1 {1414767442 67305985}} 1112test binary-29.7 {Tcl_BinaryObjCmd: scan} { 1113 unset -nocomplain arg1 1114 set arg1 foo 1115 list [binary scan \x52 i1 arg1] $arg1 1116} {0 foo} 1117test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup { 1118 unset -nocomplain arg1 1119} -returnCodes error -body { 1120 set arg1 1 1121 binary scan \x52\x53\x53\x54 i1 arg1(a) 1122} -result {can't set "arg1(a)": variable isn't array} 1123test binary-29.9 {Tcl_BinaryObjCmd: scan} { 1124 unset -nocomplain arg1 arg2 1125 set arg1 foo 1126 set arg2 bar 1127 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2 1128} {2 {1414767442 67305985} 5} 1129test binary-29.10 {Tcl_BinaryObjCmd: scan} { 1130 unset -nocomplain arg1 arg2 1131 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2 1132} {2 4294967295 -1} 1133test binary-29.11 {Tcl_BinaryObjCmd: scan} { 1134 unset -nocomplain arg1 arg2 1135 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2 1136} {2 -1 4294967295} 1137test binary-29.12 {Tcl_BinaryObjCmd: scan} { 1138 unset -nocomplain arg1 arg2 1139 list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2 1140} {2 128 2147483648} 1141 1142test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1143 binary scan abc I 1144} -result {not enough arguments for all format specifiers} 1145test binary-30.2 {Tcl_BinaryObjCmd: scan} { 1146 unset -nocomplain arg1 1147 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1 1148} {1 {1386435412 16909060}} 1149test binary-30.3 {Tcl_BinaryObjCmd: scan} { 1150 unset -nocomplain arg1 1151 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1 1152} {1 1386435412} 1153test binary-30.4 {Tcl_BinaryObjCmd: scan} { 1154 unset -nocomplain arg1 1155 list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1 1156} {1 1386435412} 1157test binary-30.5 {Tcl_BinaryObjCmd: scan} { 1158 unset -nocomplain arg1 1159 list [binary scan \x52\xa3\x53 I0 arg1] $arg1 1160} {1 {}} 1161test binary-30.6 {Tcl_BinaryObjCmd: scan} { 1162 unset -nocomplain arg1 1163 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1 1164} {1 {1386435412 16909060}} 1165test binary-30.7 {Tcl_BinaryObjCmd: scan} { 1166 unset -nocomplain arg1 1167 set arg1 foo 1168 list [binary scan \x52 I1 arg1] $arg1 1169} {0 foo} 1170test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup { 1171 unset -nocomplain arg1 1172} -returnCodes error -body { 1173 set arg1 1 1174 binary scan \x52\x53\x53\x54 I1 arg1(a) 1175} -result {can't set "arg1(a)": variable isn't array} 1176test binary-30.9 {Tcl_BinaryObjCmd: scan} { 1177 unset -nocomplain arg1 arg2 1178 set arg1 foo 1179 set arg2 bar 1180 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2 1181} {2 {1386435412 16909060} 5} 1182test binary-30.10 {Tcl_BinaryObjCmd: scan} { 1183 unset -nocomplain arg1 arg2 1184 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2 1185} {2 4294967295 -1} 1186test binary-30.11 {Tcl_BinaryObjCmd: scan} { 1187 unset -nocomplain arg1 arg2 1188 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2 1189} {2 -1 4294967295} 1190test binary-30.12 {Tcl_BinaryObjCmd: scan} { 1191 unset -nocomplain arg1 arg2 1192 list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2 1193} {2 2147483648 128} 1194 1195test binary-31.1 {Tcl_BinaryObjCmd: scan} { 1196 list [catch {binary scan abc f} msg] $msg 1197} {1 {not enough arguments for all format specifiers}} 1198# NB: format %.12g in Jim_DoubleToString 1199# tests fixed: 31.2/3, 31.4/5, 31.6/7, 31.10/11, 31.14/15, 41.5/6, 59.2-7, 59.11-15 1200test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian { 1201 catch {unset arg1} 1202 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1 1203} {1 {1.60000002384 3.40000009537}} 1204test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian { 1205 catch {unset arg1} 1206 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1 1207} {1 {1.60000002384 3.40000009537}} 1208test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian { 1209 catch {unset arg1} 1210 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1 1211} {1 1.60000002384} 1212test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian { 1213 catch {unset arg1} 1214 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1 1215} {1 1.60000002384} 1216test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian { 1217 catch {unset arg1} 1218 list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1 1219} {1 1.60000002384} 1220test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian { 1221 catch {unset arg1} 1222 list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1 1223} {1 1.60000002384} 1224test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian { 1225 catch {unset arg1} 1226 list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1 1227} {1 {}} 1228test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian { 1229 catch {unset arg1} 1230 list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1 1231} {1 {}} 1232test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian { 1233 catch {unset arg1} 1234 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1 1235} {1 {1.60000002384 3.40000009537}} 1236test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian { 1237 catch {unset arg1} 1238 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1 1239} {1 {1.60000002384 3.40000009537}} 1240test binary-31.12 {Tcl_BinaryObjCmd: scan} { 1241 catch {unset arg1} 1242 set arg1 foo 1243 list [binary scan \x52 f1 arg1] $arg1 1244} {0 foo} 1245test binary-31.13 {Tcl_BinaryObjCmd: scan} { 1246 catch {unset arg1} 1247 set arg1 1 1248 list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg 1249} {1 {can't set "arg1(a)": variable isn't array}} 1250test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian { 1251 catch {unset arg1 arg2} 1252 set arg1 foo 1253 set arg2 bar 1254 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2 1255} {2 {1.60000002384 3.40000009537} 5} 1256test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian { 1257 catch {unset arg1 arg2} 1258 set arg1 foo 1259 set arg2 bar 1260 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2 1261} {2 {1.60000002384 3.40000009537} 5} 1262 1263test binary-32.1 {Tcl_BinaryObjCmd: scan} { 1264 list [catch {binary scan abc d} msg] $msg 1265} {1 {not enough arguments for all format specifiers}} 1266test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian { 1267 catch {unset arg1} 1268 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1 1269} {1 {1.6 3.4}} 1270test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian { 1271 catch {unset arg1} 1272 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1 1273} {1 {1.6 3.4}} 1274test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian { 1275 catch {unset arg1} 1276 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1 1277} {1 1.6} 1278test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian { 1279 catch {unset arg1} 1280 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1 1281} {1 1.6} 1282test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian { 1283 catch {unset arg1} 1284 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1 1285} {1 1.6} 1286test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian { 1287 catch {unset arg1} 1288 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1 1289} {1 1.6} 1290test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian { 1291 catch {unset arg1} 1292 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1 1293} {1 {}} 1294test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian { 1295 catch {unset arg1} 1296 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1 1297} {1 {}} 1298test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian { 1299 catch {unset arg1} 1300 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1 1301} {1 {1.6 3.4}} 1302test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian { 1303 catch {unset arg1} 1304 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1 1305} {1 {1.6 3.4}} 1306test binary-32.12 {Tcl_BinaryObjCmd: scan} { 1307 catch {unset arg1} 1308 set arg1 foo 1309 list [binary scan \x52 d1 arg1] $arg1 1310} {0 foo} 1311test binary-32.13 {Tcl_BinaryObjCmd: scan} { 1312 catch {unset arg1} 1313 set arg1 1 1314 list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg 1315} {1 {can't set "arg1(a)": variable isn't array}} 1316test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian { 1317 catch {unset arg1 arg2} 1318 set arg1 foo 1319 set arg2 bar 1320 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2 1321} {2 {1.6 3.4} 5} 1322test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian { 1323 catch {unset arg1 arg2} 1324 set arg1 foo 1325 set arg2 bar 1326 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2 1327} {2 {1.6 3.4} 5} 1328 1329test binary-33.1 {Tcl_BinaryObjCmd: scan} { 1330 unset -nocomplain arg1 1331 unset -nocomplain arg2 1332 list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2 1333} {2 ab def} 1334test binary-33.2 {Tcl_BinaryObjCmd: scan} { 1335 unset -nocomplain arg1 1336 unset -nocomplain arg2 1337 set arg2 foo 1338 list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2 1339} {1 abc foo} 1340test binary-33.3 {Tcl_BinaryObjCmd: scan} { 1341 unset -nocomplain arg1 1342 unset -nocomplain arg2 1343 set arg2 foo 1344 list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2 1345} {1 abc foo} 1346test binary-33.4 {Tcl_BinaryObjCmd: scan} { 1347 unset -nocomplain arg1 1348 unset -nocomplain arg2 1349 set arg2 foo 1350 list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2 1351} {1 abc foo} 1352test binary-33.5 {Tcl_BinaryObjCmd: scan} { 1353 unset -nocomplain arg1 1354 list [binary scan abcdef x1a1 arg1] $arg1 1355} {1 b} 1356test binary-33.6 {Tcl_BinaryObjCmd: scan} { 1357 unset -nocomplain arg1 1358 list [binary scan abcdef x5a1 arg1] $arg1 1359} {1 f} 1360test binary-33.7 {Tcl_BinaryObjCmd: scan} { 1361 unset -nocomplain arg1 1362 list [binary scan abcdef x0a1 arg1] $arg1 1363} {1 a} 1364 1365test binary-34.1 {Tcl_BinaryObjCmd: scan} { 1366 unset -nocomplain arg1 1367 unset -nocomplain arg2 1368 list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2 1369} {2 ab bcd} 1370test binary-34.2 {Tcl_BinaryObjCmd: scan} { 1371 unset -nocomplain arg1 1372 unset -nocomplain arg2 1373 set arg2 foo 1374 list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2 1375} {2 abc abc} 1376test binary-34.3 {Tcl_BinaryObjCmd: scan} { 1377 unset -nocomplain arg1 1378 unset -nocomplain arg2 1379 set arg2 foo 1380 list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2 1381} {2 abc abc} 1382test binary-34.4 {Tcl_BinaryObjCmd: scan} { 1383 unset -nocomplain arg1 1384 list [binary scan abc X20a3 arg1] $arg1 1385} {1 abc} 1386test binary-34.5 {Tcl_BinaryObjCmd: scan} { 1387 unset -nocomplain arg1 1388 list [binary scan abcdef x*X1a1 arg1] $arg1 1389} {1 f} 1390test binary-34.6 {Tcl_BinaryObjCmd: scan} { 1391 unset -nocomplain arg1 1392 list [binary scan abcdef x*X5a1 arg1] $arg1 1393} {1 b} 1394test binary-34.7 {Tcl_BinaryObjCmd: scan} { 1395 unset -nocomplain arg1 1396 list [binary scan abcdef x3X0a1 arg1] $arg1 1397} {1 d} 1398 1399test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup { 1400 unset -nocomplain arg1 1401 unset -nocomplain arg2 1402} -returnCodes error -body { 1403 binary scan abcdefg a2@a3 arg1 arg2 1404} -result {missing count for "@" field specifier} 1405test binary-35.2 {Tcl_BinaryObjCmd: scan} { 1406 unset -nocomplain arg1 1407 unset -nocomplain arg2 1408 set arg2 foo 1409 list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2 1410} {1 abc foo} 1411test binary-35.3 {Tcl_BinaryObjCmd: scan} { 1412 unset -nocomplain arg1 1413 unset -nocomplain arg2 1414 set arg2 foo 1415 list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2 1416} {1 abc foo} 1417test binary-35.4 {Tcl_BinaryObjCmd: scan} { 1418 unset -nocomplain arg1 1419 list [binary scan abcdef @2a3 arg1] $arg1 1420} {1 cde} 1421test binary-35.5 {Tcl_BinaryObjCmd: scan} { 1422 unset -nocomplain arg1 1423 list [binary scan abcdef x*@1a1 arg1] $arg1 1424} {1 b} 1425test binary-35.6 {Tcl_BinaryObjCmd: scan} { 1426 unset -nocomplain arg1 1427 list [binary scan abcdef x*@0a1 arg1] $arg1 1428} {1 a} 1429 1430test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1431 binary scan abcdef u0a3 1432} -result {bad field specifier "u"} 1433 1434 1435# GetFormatSpec is pretty thoroughly tested above, but there are a few cases 1436# we should text explicitly 1437 1438test binary-37.1 {GetFormatSpec: whitespace} { 1439 binary format "a3 a5 a3" foo barblat baz 1440} foobarblbaz 1441test binary-37.2 {GetFormatSpec: whitespace} { 1442 binary format " " foo 1443} {} 1444test binary-37.3 {GetFormatSpec: whitespace} { 1445 binary format " a3" foo 1446} foo 1447test binary-37.4 {GetFormatSpec: whitespace} { 1448 binary format "" foo 1449} {} 1450test binary-37.5 {GetFormatSpec: whitespace} { 1451 binary format "" foo 1452} {} 1453test binary-37.6 {GetFormatSpec: whitespace} { 1454 binary format " a3 " foo 1455} foo 1456test binary-37.7 {GetFormatSpec: numbers} { 1457 list [catch {binary scan abcdef "x-1" foo} msg] $msg 1458} {1 {bad field specifier "-"}} 1459test binary-37.8 {GetFormatSpec: numbers} { 1460 catch {unset arg1} 1461 set arg1 foo 1462 list [binary scan abcdef "a0x3" arg1] $arg1 1463} {1 {}} 1464test binary-37.9 {GetFormatSpec: numbers} { 1465 # test format of neg numbers 1466 # bug report/fix provided by Harald Kirsch 1467 set x [binary format f* {1 -1 2 -2 0}] 1468 binary scan $x f* bla 1469 set bla 1470} {1.0 -1.0 2.0 -2.0 0.0} 1471 1472test binary-38.1 {FormatNumber: word alignment} { 1473 set x [binary format c1s1 1 1] 1474} \x01\x01\x00 1475test binary-38.2 {FormatNumber: word alignment} { 1476 set x [binary format c1S1 1 1] 1477} \x01\x00\x01 1478test binary-38.3 {FormatNumber: word alignment} { 1479 set x [binary format c1i1 1 1] 1480} \x01\x01\x00\x00\x00 1481test binary-38.4 {FormatNumber: word alignment} { 1482 set x [binary format c1I1 1 1] 1483} \x01\x00\x00\x00\x01 1484test binary-38.5 {FormatNumber: word alignment} bigEndian { 1485 set x [binary format c1d1 1 1.6] 1486} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a 1487test binary-38.6 {FormatNumber: word alignment} littleEndian { 1488 set x [binary format c1d1 1 1.6] 1489} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f 1490test binary-38.7 {FormatNumber: word alignment} bigEndian { 1491 set x [binary format c1f1 1 1.6] 1492} \x01\x3f\xcc\xcc\xcd 1493test binary-38.8 {FormatNumber: word alignment} littleEndian { 1494 set x [binary format c1f1 1 1.6] 1495} \x01\xcd\xcc\xcc\x3f 1496 1497test binary-39.1 {ScanNumber: sign extension} { 1498 catch {unset arg1} 1499 list [binary scan \x52\xa3 c2 arg1] $arg1 1500} {1 {82 -93}} 1501test binary-39.2 {ScanNumber: sign extension} { 1502 catch {unset arg1} 1503 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1 1504} {1 {513 -32511 386 -32127}} 1505test binary-39.3 {ScanNumber: sign extension} { 1506 catch {unset arg1} 1507 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1 1508} {1 {258 385 -32255 -32382}} 1509test binary-39.4 {ScanNumber: sign extension} { 1510 catch {unset arg1} 1511 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 1512} {1 {33620225 16843137 16876033 25297153 -2130640639}} 1513test binary-39.5 {ScanNumber: sign extension} { 1514 catch {unset arg1} 1515 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 1516} {1 {16843010 -2130640639 25297153 16876033 16843137}} 1517test binary-39.6 {ScanNumber: no sign extension} { 1518 catch {unset arg1} 1519 list [binary scan \x52\xa3 cu2 arg1] $arg1 1520} {1 {82 163}} 1521test binary-39.7 {ScanNumber: no sign extension} { 1522 catch {unset arg1} 1523 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1 1524} {1 {513 33025 386 33409}} 1525test binary-39.8 {ScanNumber: no sign extension} { 1526 catch {unset arg1} 1527 list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1 1528} {1 {258 385 33281 33154}} 1529test binary-39.9 {ScanNumber: no sign extension} { 1530 catch {unset arg1} 1531 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 1532} {1 {33620225 16843137 16876033 25297153 2164326657}} 1533test binary-39.10 {ScanNumber: no sign extension} { 1534 catch {unset arg1} 1535 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 1536} {1 {16843010 2164326657 25297153 16876033 16843137}} 1537 1538test binary-40.3 {ScanNumber: NaN} -constraints {maxCompatibility} \ 1539 -body { 1540 catch {unset arg1} 1541 list [binary scan \xff\xff\xff\xff f1 arg1] $arg1 1542 } \ 1543 -match glob \ 1544 -result {1 -NaN*} 1545 1546test binary-40.4 {ScanNumber: NaN} -constraints {maxCompatibility} \ 1547 -body { 1548 catch {unset arg1} 1549 list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1 1550 } \ 1551 -match glob \ 1552 -result {1 -NaN*} 1553 1554test binary-41.1 {ScanNumber: word alignment} { 1555 catch {unset arg1; unset arg2} 1556 list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2 1557} {2 1 1} 1558test binary-41.2 {ScanNumber: word alignment} { 1559 catch {unset arg1; unset arg2} 1560 list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2 1561} {2 1 1} 1562test binary-41.3 {ScanNumber: word alignment} { 1563 catch {unset arg1; unset arg2} 1564 list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2 1565} {2 1 1} 1566test binary-41.4 {ScanNumber: word alignment} { 1567 catch {unset arg1; unset arg2} 1568 list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2 1569} {2 1 1} 1570test binary-41.5 {ScanNumber: word alignment} bigEndian { 1571 catch {unset arg1; unset arg2} 1572 list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2 1573} {2 1 1.60000002384} 1574test binary-41.6 {ScanNumber: word alignment} littleEndian { 1575 catch {unset arg1; unset arg2} 1576 list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2 1577} {2 1 1.60000002384} 1578test binary-41.7 {ScanNumber: word alignment} bigEndian { 1579 catch {unset arg1; unset arg2} 1580 list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2 1581} {2 1 1.6} 1582test binary-41.8 {ScanNumber: word alignment} littleEndian { 1583 catch {unset arg1; unset arg2} 1584 list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2 1585} {2 1 1.6} 1586 1587# Test changed in Jim's fashion 1588test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -returnCodes error -body { 1589 binary ? 1590} -match glob -result {*} 1591 1592# Wide int (guaranteed at least 64-bit) handling 1593test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} { 1594 binary format w 7810179016327718216 1595} HelloTcl 1596test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} { 1597 binary format W 7810179016327718216 1598} lcTolleH 1599 1600test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} { 1601 binary scan HelloTcl W x 1602 set x 1603} 5216694956358656876 1604test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} { 1605 binary scan lcTolleH w x 1606 set x 1607} 5216694956358656876 1608# Changed 44.3, 44.4 as Jim doesn't have 'wide' function 1609test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { 1610 binary scan [binary format w [expr {int(3) << 31}]] w x 1611 set x 1612} 6442450944 1613test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} { 1614 binary scan [binary format W [expr {int(3) << 31}]] W x 1615 set x 1616} 6442450944 1617test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} { 1618 catch {unset arg1} 1619 list [binary scan \x80[string repeat \x00 7] W arg1] $arg1 1620} {1 -9223372036854775808} 1621# Tests binary-43.6-9 excluded as they transcend Jim's integer range. 1622test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {notImplemented} { 1623 catch {unset arg1} 1624 list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1 1625} {1 9223372036854775808} 1626test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {notImplemented} { 1627 catch {unset arg1} 1628 list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1 1629} {1 9223372036854775808} 1630test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {notImplemented} { 1631 catch {unset arg1 arg2} 1632 list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2 1633} {2 9223372036854775808 -9223372036854775808} 1634test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {notImplemented} { 1635 catch {unset arg1 arg2} 1636 list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2 1637} {2 9223372036854775808 -9223372036854775808} 1638 1639test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} { 1640 binary scan [binary format sws 16450 -1 19521] c* x 1641 set x 1642} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76} 1643test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} { 1644 binary scan [binary format sWs 16450 0x7fffffff 19521] c* x 1645 set x 1646} {66 64 0 0 0 0 127 -1 -1 -1 65 76} 1647 1648# NB: tests binary-46.* fail as Jim Tcl doesn't truncate Unicode chars to ISO-8859-1. 1649 1650test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} { 1651 # This test is only reliable when memory debugging is turned on, 1652 # but without even memory debugging it should still generate the 1653 # expected answers and might therefore still pick up memory corruption 1654 # caused by [Bug 851747]. 1655 list [binary scan aba ccc x x x] $x 1656} {3 97} 1657 1658 1659### TIP#129: endian specifiers ---- 1660 1661# format t 1662test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1663 binary format t 1664} -result {not enough arguments for all format specifiers} 1665test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1666 binary format t blat 1667} -match glob -result {expected integer *but got "blat"} 1668test binary-48.3 {Tcl_BinaryObjCmd: format} { 1669 binary format S0 0x50 1670} {} 1671test binary-48.4 {Tcl_BinaryObjCmd: format} bigEndian { 1672 binary format t 0x50 1673} \x00P 1674test binary-48.5 {Tcl_BinaryObjCmd: format} littleEndian { 1675 binary format t 0x50 1676} P\x00 1677test binary-48.6 {Tcl_BinaryObjCmd: format} bigEndian { 1678 binary format t 0x5052 1679} PR 1680test binary-48.7 {Tcl_BinaryObjCmd: format} littleEndian { 1681 binary format t 0x5052 1682} RP 1683test binary-48.8 {Tcl_BinaryObjCmd: format} bigEndian { 1684 binary format t 0x505251 0x53 1685} RQ 1686test binary-48.9 {Tcl_BinaryObjCmd: format} littleEndian { 1687 binary format t 0x505251 0x53 1688} QR 1689test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian { 1690 binary format t2 {0x50 0x52} 1691} \x00P\x00R 1692test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian { 1693 binary format t2 {0x50 0x52} 1694} P\x00R\x00 1695test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian { 1696 binary format t* {0x5051 0x52} 1697} PQ\x00R 1698test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian { 1699 binary format t* {0x5051 0x52} 1700} QPR\x00 1701test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian { 1702 binary format t2 {0x50 0x52 0x53} 0x54 1703} \x00P\x00R 1704test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian { 1705 binary format t2 {0x50 0x52 0x53} 0x54 1706} P\x00R\x00 1707test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1708 binary format t2 {0x50} 1709} -result {number of elements in list does not match count} 1710test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1711 set a {0x50 0x51} 1712 binary format t $a 1713} -match glob -result "expected integer *but got \"0x50 0x51\"" 1714test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian { 1715 set a {0x50 0x51} 1716 binary format t1 $a 1717} \x00P 1718test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian { 1719 set a {0x50 0x51} 1720 binary format t1 $a 1721} P\x00 1722 1723# format n 1724test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1725 binary format n 1726} -result {not enough arguments for all format specifiers} 1727test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1728 binary format n blat 1729} -match glob -result {expected integer *but got "blat"} 1730test binary-49.3 {Tcl_BinaryObjCmd: format} { 1731 binary format n0 0x50 1732} {} 1733test binary-49.4 {Tcl_BinaryObjCmd: format} littleEndian { 1734 binary format n 0x50 1735} P\x00\x00\x00 1736test binary-49.5 {Tcl_BinaryObjCmd: format} littleEndian { 1737 binary format n 0x5052 1738} RP\x00\x00 1739test binary-49.6 {Tcl_BinaryObjCmd: format} littleEndian { 1740 binary format n 0x505251 0x53 1741} QRP\x00 1742test binary-49.7 {Tcl_BinaryObjCmd: format} littleEndian { 1743 binary format i1 {0x505251 0x53} 1744} QRP\x00 1745test binary-49.8 {Tcl_BinaryObjCmd: format} littleEndian { 1746 binary format n 0x53525150 1747} PQRS 1748test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian { 1749 binary format n2 {0x50 0x52} 1750} P\x00\x00\x00R\x00\x00\x00 1751test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian { 1752 binary format n* {0x50515253 0x52} 1753} SRQPR\x00\x00\x00 1754test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1755 binary format n2 {0x50} 1756} -result {number of elements in list does not match count} 1757test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body { 1758 set a {0x50 0x51} 1759 binary format n $a 1760} -match glob -result "expected integer *but got \"0x50 0x51\"" 1761test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian { 1762 set a {0x50 0x51} 1763 binary format n1 $a 1764} P\x00\x00\x00 1765test binary-49.14 {Tcl_BinaryObjCmd: format} bigEndian { 1766 binary format n 0x50 1767} \x00\x00\x00P 1768test binary-49.15 {Tcl_BinaryObjCmd: format} bigEndian { 1769 binary format n 0x5052 1770} \x00\x00PR 1771test binary-49.16 {Tcl_BinaryObjCmd: format} bigEndian { 1772 binary format n 0x505251 0x53 1773} \x00PRQ 1774test binary-49.17 {Tcl_BinaryObjCmd: format} bigEndian { 1775 binary format i1 {0x505251 0x53} 1776} QRP\x00 1777test binary-49.18 {Tcl_BinaryObjCmd: format} bigEndian { 1778 binary format n 0x53525150 1779} SRQP 1780test binary-49.19 {Tcl_BinaryObjCmd: format} bigEndian { 1781 binary format n2 {0x50 0x52} 1782} \x00\x00\x00P\x00\x00\x00R 1783test binary-49.20 {Tcl_BinaryObjCmd: format} bigEndian { 1784 binary format n* {0x50515253 0x52} 1785} PQRS\x00\x00\x00R 1786 1787# format m 1788test binary-50.1 {Tcl_BinaryObjCmd: format wide int} littleEndian { 1789 binary format m 7810179016327718216 1790} HelloTcl 1791test binary-50.2 {Tcl_BinaryObjCmd: format wide int} bigEndian { 1792 binary format m 7810179016327718216 1793} lcTolleH 1794 1795# Changed 50.3, 50.4 as Jim doesn't have 'wide' function 1796test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { 1797 binary scan [binary format m [expr {int(3) << 31}]] w x 1798 set x 1799} 6442450944 1800test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { 1801 binary scan [binary format m [expr {int(3) << 31}]] W x 1802 set x 1803} 6442450944 1804 1805 1806# format Q/q 1807test binary-51.1 {Tcl_BinaryObjCmd: format} { 1808 list [catch {binary format Q} msg] $msg 1809} {1 {not enough arguments for all format specifiers}} 1810test binary-51.2 {Tcl_BinaryObjCmd: format} { 1811 list [catch {binary format q blat} msg] $msg 1812} {1 {expected floating-point number but got "blat"}} 1813test binary-51.3 {Tcl_BinaryObjCmd: format} { 1814 binary format q0 1.6 1815} {} 1816test binary-51.4 {Tcl_BinaryObjCmd: format} {} { 1817 binary format Q 1.6 1818} \x3f\xf9\x99\x99\x99\x99\x99\x9a 1819test binary-51.5 {Tcl_BinaryObjCmd: format} {} { 1820 binary format q 1.6 1821} \x9a\x99\x99\x99\x99\x99\xf9\x3f 1822test binary-51.6 {Tcl_BinaryObjCmd: format} {} { 1823 binary format Q* {1.6 3.4} 1824} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 1825test binary-51.7 {Tcl_BinaryObjCmd: format} {} { 1826 binary format q* {1.6 3.4} 1827} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 1828test binary-51.8 {Tcl_BinaryObjCmd: format} {} { 1829 binary format Q2 {1.6 3.4} 1830} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 1831test binary-51.9 {Tcl_BinaryObjCmd: format} {} { 1832 binary format q2 {1.6 3.4} 1833} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 1834test binary-51.10 {Tcl_BinaryObjCmd: format} {} { 1835 binary format Q2 {1.6 3.4 5.6} 1836} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 1837test binary-51.11 {Tcl_BinaryObjCmd: format} {} { 1838 binary format q2 {1.6 3.4 5.6} 1839} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 1840test binary-51.14 {Tcl_BinaryObjCmd: format} { 1841 list [catch {binary format q2 {1.6}} msg] $msg 1842} {1 {number of elements in list does not match count}} 1843test binary-51.15 {Tcl_BinaryObjCmd: format} { 1844 set a {1.6 3.4} 1845 list [catch {binary format q $a} msg] $msg 1846} [list 1 "expected floating-point number but got \"1.6 3.4\""] 1847test binary-51.16 {Tcl_BinaryObjCmd: format} {} { 1848 set a {1.6 3.4} 1849 binary format Q1 $a 1850} \x3f\xf9\x99\x99\x99\x99\x99\x9a 1851test binary-51.17 {Tcl_BinaryObjCmd: format} {} { 1852 set a {1.6 3.4} 1853 binary format q1 $a 1854} \x9a\x99\x99\x99\x99\x99\xf9\x3f 1855 1856# format R/r 1857test binary-53.1 {Tcl_BinaryObjCmd: format} { 1858 list [catch {binary format r} msg] $msg 1859} {1 {not enough arguments for all format specifiers}} 1860test binary-53.2 {Tcl_BinaryObjCmd: format} { 1861 list [catch {binary format r blat} msg] $msg 1862} {1 {expected floating-point number but got "blat"}} 1863test binary-53.3 {Tcl_BinaryObjCmd: format} { 1864 binary format f0 1.6 1865} {} 1866test binary-53.4 {Tcl_BinaryObjCmd: format} {} { 1867 binary format R 1.6 1868} \x3f\xcc\xcc\xcd 1869test binary-53.5 {Tcl_BinaryObjCmd: format} {} { 1870 binary format r 1.6 1871} \xcd\xcc\xcc\x3f 1872test binary-53.6 {Tcl_BinaryObjCmd: format} {} { 1873 binary format R* {1.6 3.4} 1874} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 1875test binary-53.7 {Tcl_BinaryObjCmd: format} {} { 1876 binary format r* {1.6 3.4} 1877} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 1878test binary-53.8 {Tcl_BinaryObjCmd: format} {} { 1879 binary format R2 {1.6 3.4} 1880} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 1881test binary-53.9 {Tcl_BinaryObjCmd: format} {} { 1882 binary format r2 {1.6 3.4} 1883} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 1884test binary-53.10 {Tcl_BinaryObjCmd: format} {} { 1885 binary format R2 {1.6 3.4 5.6} 1886} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a 1887test binary-53.11 {Tcl_BinaryObjCmd: format} {} { 1888 binary format r2 {1.6 3.4 5.6} 1889} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 1890test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {maxCompatibility} { 1891 binary format R -3.402825e+38 1892} \xff\x7f\xff\xff 1893test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {maxCompatibility} { 1894 binary format r -3.402825e+38 1895} \xff\xff\x7f\xff 1896test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} { 1897 binary format R -3.402825e-100 1898} \x80\x00\x00\x00 1899test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} { 1900 binary format r -3.402825e-100 1901} \x00\x00\x00\x80 1902test binary-53.16 {Tcl_BinaryObjCmd: format} { 1903 list [catch {binary format r2 {1.6}} msg] $msg 1904} {1 {number of elements in list does not match count}} 1905test binary-53.17 {Tcl_BinaryObjCmd: format} { 1906 set a {1.6 3.4} 1907 list [catch {binary format r $a} msg] $msg 1908} [list 1 "expected floating-point number but got \"1.6 3.4\""] 1909test binary-53.18 {Tcl_BinaryObjCmd: format} {} { 1910 set a {1.6 3.4} 1911 binary format R1 $a 1912} \x3f\xcc\xcc\xcd 1913test binary-53.19 {Tcl_BinaryObjCmd: format} {} { 1914 set a {1.6 3.4} 1915 binary format r1 $a 1916} \xcd\xcc\xcc\x3f 1917 1918# scan t (s) 1919test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1920 binary scan abc t 1921} -result {not enough arguments for all format specifiers} 1922test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian { 1923 unset -nocomplain arg1 1924 list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 1925} {1 {-23726 21587}} 1926test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian { 1927 unset -nocomplain arg1 1928 list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 1929} {1 -23726} 1930test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian { 1931 unset -nocomplain arg1 1932 list [binary scan \x52\xa3 t1 arg1] $arg1 1933} {1 -23726} 1934test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian { 1935 unset -nocomplain arg1 1936 list [binary scan \x52\xa3 t0 arg1] $arg1 1937} {1 {}} 1938test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian { 1939 unset -nocomplain arg1 1940 list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 1941} {1 {-23726 21587}} 1942test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian { 1943 unset -nocomplain arg1 1944 set arg1 foo 1945 list [binary scan \x52 t1 arg1] $arg1 1946} {0 foo} 1947test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup { 1948 unset -nocomplain arg1 1949} -returnCodes error -body { 1950 set arg1 1 1951 binary scan \x52\x53 t1 arg1(a) 1952} -result {can't set "arg1(a)": variable isn't array} 1953test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian { 1954 unset -nocomplain arg1 arg2 1955 set arg1 foo 1956 set arg2 bar 1957 list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 1958} {2 {-23726 21587} 5} 1959test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian { 1960 unset -nocomplain arg1 arg2 1961 set arg1 foo 1962 set arg2 bar 1963 list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2 1964} {2 32768 -32768} 1965test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian { 1966 unset -nocomplain arg1 arg2 1967 set arg1 foo 1968 set arg2 bar 1969 list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2 1970} {2 -32768 32768} 1971 1972# scan t (b) 1973test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 1974 binary scan abc t 1975} -result {not enough arguments for all format specifiers} 1976test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian { 1977 unset -nocomplain arg1 1978 list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1 1979} {1 {21155 21332}} 1980test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian { 1981 unset -nocomplain arg1 1982 list [binary scan \x52\xa3\x53\x54 t arg1] $arg1 1983} {1 21155} 1984test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian { 1985 unset -nocomplain arg1 1986 list [binary scan \x52\xa3 t1 arg1] $arg1 1987} {1 21155} 1988test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian { 1989 unset -nocomplain arg1 1990 list [binary scan \x52\xa3 t0 arg1] $arg1 1991} {1 {}} 1992test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian { 1993 unset -nocomplain arg1 1994 list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1 1995} {1 {21155 21332}} 1996test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian { 1997 unset -nocomplain arg1 1998 set arg1 foo 1999 list [binary scan \x52 t1 arg1] $arg1 2000} {0 foo} 2001test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup { 2002 unset -nocomplain arg1 2003} -returnCodes error -body { 2004 set arg1 1 2005 binary scan \x52\x53 t1 arg1(a) 2006} -result {can't set "arg1(a)": variable isn't array} 2007test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian { 2008 unset -nocomplain arg1 arg2 2009 set arg1 foo 2010 set arg2 bar 2011 list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2 2012} {2 {21155 21332} 5} 2013test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian { 2014 unset -nocomplain arg1 arg2 2015 set arg1 foo 2016 set arg2 bar 2017 list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2 2018} {2 32768 -32768} 2019test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian { 2020 unset -nocomplain arg1 arg2 2021 set arg1 foo 2022 set arg2 bar 2023 list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2 2024} {2 -32768 32768} 2025 2026# scan n (s) 2027test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 2028 binary scan abc n 2029} -result {not enough arguments for all format specifiers} 2030test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian { 2031 unset -nocomplain arg1 2032 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 2033} {1 {1414767442 67305985}} 2034test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian { 2035 unset -nocomplain arg1 2036 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 2037} {1 1414767442} 2038test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian { 2039 unset -nocomplain arg1 2040 list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 2041} {1 1414767442} 2042test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian { 2043 unset -nocomplain arg1 2044 list [binary scan \x52\xa3\x53 n0 arg1] $arg1 2045} {1 {}} 2046test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian { 2047 unset -nocomplain arg1 2048 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 2049} {1 {1414767442 67305985}} 2050test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian { 2051 unset -nocomplain arg1 2052 set arg1 foo 2053 list [binary scan \x52 n1 arg1] $arg1 2054} {0 foo} 2055test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup { 2056 unset -nocomplain arg1 2057} -returnCodes error -body { 2058 set arg1 1 2059 binary scan \x52\x53\x53\x54 n1 arg1(a) 2060} -result {can't set "arg1(a)": variable isn't array} 2061test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian { 2062 unset -nocomplain arg1 arg2 2063 set arg1 foo 2064 set arg2 bar 2065 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 2066} {2 {1414767442 67305985} 5} 2067test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian { 2068 unset -nocomplain arg1 arg2 2069 set arg1 foo 2070 set arg2 bar 2071 list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2 2072} {2 128 128} 2073test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian { 2074 unset -nocomplain arg1 arg2 2075 set arg1 foo 2076 set arg2 bar 2077 list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2 2078} {2 2147483648 -2147483648} 2079 2080# scan n (b) 2081test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { 2082 binary scan abc n 2083} -result {not enough arguments for all format specifiers} 2084test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian { 2085 unset -nocomplain arg1 2086 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1 2087} {1 {1386435412 16909060}} 2088test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian { 2089 unset -nocomplain arg1 2090 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1 2091} {1 1386435412} 2092test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian { 2093 unset -nocomplain arg1 2094 list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1 2095} {1 1386435412} 2096test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian { 2097 unset -nocomplain arg1 2098 list [binary scan \x52\xa3\x53 n0 arg1] $arg1 2099} {1 {}} 2100test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian { 2101 unset -nocomplain arg1 2102 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1 2103} {1 {1386435412 16909060}} 2104test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian { 2105 unset -nocomplain arg1 2106 set arg1 foo 2107 list [binary scan \x52 n1 arg1] $arg1 2108} {0 foo} 2109test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup { 2110 unset -nocomplain arg1 2111} -returnCodes error -body { 2112 set arg1 1 2113 binary scan \x52\x53\x53\x54 n1 arg1(a) 2114} -result {can't set "arg1(a)": variable isn't array} 2115test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian { 2116 unset -nocomplain arg1 arg2 2117 set arg1 foo 2118 set arg2 bar 2119 list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2 2120} {2 {1386435412 16909060} 5} 2121test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian { 2122 unset -nocomplain arg1 arg2 2123 set arg1 foo 2124 set arg2 bar 2125 list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2 2126} {2 2147483648 -2147483648} 2127test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian { 2128 unset -nocomplain arg1 arg2 2129 set arg1 foo 2130 set arg2 bar 2131 list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2 2132} {2 128 128} 2133 2134# scan Q/q 2135test binary-58.1 {Tcl_BinaryObjCmd: scan} { 2136 list [catch {binary scan abc q} msg] $msg 2137} {1 {not enough arguments for all format specifiers}} 2138test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian { 2139 catch {unset arg1} 2140 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1 2141} {1 {1.6 3.4}} 2142test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian { 2143 catch {unset arg1} 2144 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1 2145} {1 {1.6 3.4}} 2146test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian { 2147 catch {unset arg1} 2148 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1 2149} {1 1.6} 2150test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian { 2151 catch {unset arg1} 2152 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1 2153} {1 1.6} 2154test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian { 2155 catch {unset arg1} 2156 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1 2157} {1 1.6} 2158test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian { 2159 catch {unset arg1} 2160 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1 2161} {1 1.6} 2162test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian { 2163 catch {unset arg1} 2164 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1 2165} {1 {}} 2166test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian { 2167 catch {unset arg1} 2168 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1 2169} {1 {}} 2170test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian { 2171 catch {unset arg1} 2172 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1 2173} {1 {1.6 3.4}} 2174test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian { 2175 catch {unset arg1} 2176 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1 2177} {1 {1.6 3.4}} 2178test binary-58.12 {Tcl_BinaryObjCmd: scan} { 2179 catch {unset arg1} 2180 set arg1 foo 2181 list [binary scan \x52 q1 arg1] $arg1 2182} {0 foo} 2183test binary-58.13 {Tcl_BinaryObjCmd: scan} { 2184 catch {unset arg1} 2185 set arg1 1 2186 list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg 2187} {1 {can't set "arg1(a)": variable isn't array}} 2188test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian { 2189 catch {unset arg1 arg2} 2190 set arg1 foo 2191 set arg2 bar 2192 list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2 2193} {2 {1.6 3.4} 5} 2194test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian { 2195 catch {unset arg1 arg2} 2196 set arg1 foo 2197 set arg2 bar 2198 list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2 2199} {2 {1.6 3.4} 5} 2200 2201# scan R/r 2202test binary-59.1 {Tcl_BinaryObjCmd: scan} { 2203 list [catch {binary scan abc r} msg] $msg 2204} {1 {not enough arguments for all format specifiers}} 2205test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian { 2206 catch {unset arg1} 2207 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1 2208} {1 {1.60000002384 3.40000009537}} 2209test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian { 2210 catch {unset arg1} 2211 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1 2212} {1 {1.60000002384 3.40000009537}} 2213test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian { 2214 catch {unset arg1} 2215 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1 2216} {1 1.60000002384} 2217test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian { 2218 catch {unset arg1} 2219 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1 2220} {1 1.60000002384} 2221test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian { 2222 catch {unset arg1} 2223 list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1 2224} {1 1.60000002384} 2225test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian { 2226 catch {unset arg1} 2227 list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1 2228} {1 1.60000002384} 2229test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian { 2230 catch {unset arg1} 2231 list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1 2232} {1 {}} 2233test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian { 2234 catch {unset arg1} 2235 list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1 2236} {1 {}} 2237test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian { 2238 catch {unset arg1} 2239 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1 2240} {1 {1.60000002384 3.40000009537}} 2241test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian { 2242 catch {unset arg1} 2243 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1 2244} {1 {1.60000002384 3.40000009537}} 2245test binary-59.12 {Tcl_BinaryObjCmd: scan} { 2246 catch {unset arg1} 2247 set arg1 foo 2248 list [binary scan \x52 r1 arg1] $arg1 2249} {0 foo} 2250test binary-59.13 {Tcl_BinaryObjCmd: scan} { 2251 catch {unset arg1} 2252 set arg1 1 2253 list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg 2254} {1 {can't set "arg1(a)": variable isn't array}} 2255test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian { 2256 catch {unset arg1 arg2} 2257 set arg1 foo 2258 set arg2 bar 2259 list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2 2260} {2 {1.60000002384 3.40000009537} 5} 2261test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian { 2262 catch {unset arg1 arg2} 2263 set arg1 foo 2264 set arg2 bar 2265 list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2 2266} {2 {1.60000002384 3.40000009537} 5} 2267 2268test binary-60.1 {[binary format] with NaN} -body { 2269 binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \ 2270 v1 v2 v3 v4 v5 v6 2271 list $v1 $v2 $v3 $v4 $v5 $v6 2272} -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?} 2273 2274# scan m 2275test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian { 2276 binary scan HelloTcl m x 2277 set x 2278} 5216694956358656876 2279test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian { 2280 binary scan lcTolleH m x 2281 set x 2282} 5216694956358656876 2283test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian { 2284 binary scan [binary format w [expr {3 << 31}]] m x 2285 set x 2286} 6442450944 2287test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian { 2288 binary scan [binary format W [expr {3 << 31}]] m x 2289 set x 2290} 6442450944 2291 2292# Big test for correct ordering of data in [expr] 2293 2294proc testIEEE {} { 2295 array set ieeeValues {} 2296 binary scan [binary format dd -1.0 1.0] c* c 2297 switch -exact -- $c { 2298 {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} { 2299 # little endian 2300 binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \ 2301 ieeeValues(-Infinity) 2302 binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \ 2303 ieeeValues(-Normal) 2304 binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \ 2305 ieeeValues(-Subnormal) 2306 binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \ 2307 ieeeValues(-0) 2308 binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ 2309 ieeeValues(+0) 2310 binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \ 2311 ieeeValues(+Subnormal) 2312 binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \ 2313 ieeeValues(+Normal) 2314 binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \ 2315 ieeeValues(+Infinity) 2316 binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \ 2317 ieeeValues(NaN) 2318 set ieeeValues(littleEndian) 1 2319 return 1 2320 } 2321 {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} { 2322 binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \ 2323 ieeeValues(-Infinity) 2324 binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \ 2325 ieeeValues(-Normal) 2326 binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \ 2327 ieeeValues(-Subnormal) 2328 binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \ 2329 ieeeValues(-0) 2330 binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \ 2331 ieeeValues(+0) 2332 binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \ 2333 ieeeValues(+Subnormal) 2334 binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \ 2335 ieeeValues(+Normal) 2336 binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \ 2337 ieeeValues(+Infinity) 2338 binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \ 2339 ieeeValues(NaN) 2340 set ieeeValues(littleEndian) 0 2341 return 1 2342 } 2343 default { 2344 return 0 2345 } 2346 } 2347} 2348 2349testConstraint ieeeFloatingPoint [testIEEE] 2350 2351# scan/format infinities 2352 2353test binary-62.1 {infinity} ieeeFloatingPoint { 2354 binary scan [binary format q Infinity] w w 2355 format 0x%016lx $w 2356} 0x7ff0000000000000 2357test binary-62.2 {infinity} ieeeFloatingPoint { 2358 binary scan [binary format q -Infinity] w w 2359 format 0x%016lx $w 2360} 0xfff0000000000000 2361test binary-62.3 {infinity} ieeeFloatingPoint { 2362 binary scan [binary format q Inf] w w 2363 format 0x%016lx $w 2364} 0x7ff0000000000000 2365test binary-62.4 {infinity} ieeeFloatingPoint { 2366 binary scan [binary format q -Infinity] w w 2367 format 0x%016lx $w 2368} 0xfff0000000000000 2369test binary-62.5 {infinity} ieeeFloatingPoint { 2370 binary scan [binary format w 0x7ff0000000000000] q d 2371 set d 2372} Inf 2373test binary-62.6 {infinity} ieeeFloatingPoint { 2374 binary scan [binary format w 0xfff0000000000000] q d 2375 set d 2376} -Inf 2377 2378# scan/format Not-a-Number 2379 2380test binary-63.1 {NaN} {ieeeFloatingPoint maxCompatibility} { 2381 binary scan [binary format q NaN] w w 2382 format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] 2383} 0x7ff0000000000000 2384# Tests binary-63.2-4, 63.5-9, 64.2 excluded. 2385# Apparently strtod (and Jim) don't have 2386# advanced NaN-handling facility as Tcl does :) 2387test binary-63.2 {NaN} {ieeeFloatingPoint notImplemented} { 2388 binary scan [binary format q -NaN] w w 2389 format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] 2390} 0xfff0000000000000 2391test binary-63.3 {NaN} {ieeeFloatingPoint notImplemented} { 2392 binary scan [binary format q NaN(3123456789aBc)] w w 2393 format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] 2394} 0x7ff3123456789abc 2395test binary-63.4 {NaN} {ieeeFloatingPoint notImplemented} { 2396 binary scan [binary format q {NaN( 3123456789aBc)}] w w 2397 format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] 2398} 0x7ff3123456789abc 2399 2400# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540] 2401test binary-63.5 {NaN} -constraints {ieeeFloatingPoint} -body { 2402 binary format q Nan( 2403} -returnCodes error -match glob -result {expected floating-point number*} 2404test binary-63.6 {NaN} -constraints {ieeeFloatingPoint notImplemented} -body { 2405 binary format q Nan() 2406} -returnCodes error -match glob -result {expected floating-point number*} 2407test binary-63.7 {NaN} -constraints {ieeeFloatingPoint notImplemented} -body { 2408 binary format q Nan(g) 2409} -returnCodes error -match glob -result {expected floating-point number*} 2410test binary-63.8 {NaN} -constraints {ieeeFloatingPoint notImplemented} -body { 2411 binary format q Nan(1,2) 2412} -returnCodes error -match glob -result {expected floating-point number*} 2413test binary-63.9 {NaN} -constraints {ieeeFloatingPoint notImplemented} -body { 2414 binary format q Nan(1234567890abcd) 2415} -returnCodes error -match glob -result {expected floating-point number*} 2416 2417test binary-64.1 {NaN} \ 2418 -constraints ieeeFloatingPoint \ 2419 -body { 2420 binary scan [binary format w 0x7ff8000000000000] q d 2421 set d 2422 } \ 2423 -match glob -result NaN* 2424test binary-64.2 {NaN} \ 2425 -constraints {ieeeFloatingPoint notImplemented} \ 2426 -body { 2427 binary scan [binary format w 0x7ff0123456789aBc] q d 2428 set d 2429 } \ 2430 -match glob -result NaN(*123456789abc) 2431 2432# NB: the problem of %.12g format in Jim_DoubleToString 2433# make these tests meaningless. Excluded 65.1/3/5,7-9. 2434 2435test binary-65.1 {largest significand} {ieeeFloatingPoint maxCompatibility} { 2436 binary scan [binary format w 0x3fcfffffffffffff] q d 2437 set d 2438} 0.24999999999999997 2439test binary-65.2 {smallest significand} ieeeFloatingPoint { 2440 binary scan [binary format w 0x3fd0000000000000] q d 2441 set d 2442} 0.25 2443test binary-65.3 {largest significand} {ieeeFloatingPoint maxCompatibility} { 2444 binary scan [binary format w 0x3fdfffffffffffff] q d 2445 set d 2446} 0.49999999999999994 2447test binary-65.4 {smallest significand} ieeeFloatingPoint { 2448 binary scan [binary format w 0x3fe0000000000000] q d 2449 set d 2450} 0.5 2451test binary-65.5 {largest significand} {ieeeFloatingPoint maxCompatibility} { 2452 binary scan [binary format w 0x3fffffffffffffff] q d 2453 set d 2454} 1.9999999999999998 2455test binary-65.6 {smallest significand} ieeeFloatingPoint { 2456 binary scan [binary format w 0x4000000000000000] q d 2457 set d 2458} 2.0 2459test binary-65.7 {smallest significand} {ieeeFloatingPoint maxCompatibility} { 2460 binary scan [binary format w 0x434fffffffffffff] q d 2461 set d 2462} 18014398509481982.0 2463test binary-65.8 {largest significand} {ieeeFloatingPoint maxCompatibility} { 2464 binary scan [binary format w 0x4350000000000000] q d 2465 set d 2466} 18014398509481984.0 2467test binary-65.9 {largest significand} {ieeeFloatingPoint maxCompatibility} { 2468 binary scan [binary format w 0x4350000000000001] q d 2469 set d 2470} 18014398509481988.0 2471 2472# Jim-specific test. 2473# binary scan must return immediately if there's not enough bytes left. 2474test binary-66.1 {binary scan: not enought bytes} {} { 2475 unset -nocomplain arg1 arg2 2476 binary scan ab is arg1 arg2 2477} 0 2478 2479# cleanup 2480::tcltest::cleanupTests 2481return 2482 2483# Local Variables: 2484# mode: tcl 2485# End: 2486