1# Commands covered: set 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1996 Sun Microsystems, Inc. 8# Copyright © 1998-1999 Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution 11# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18::tcltest::loadTestedCommands 19catch [list package require -exact tcl::test [info patchlevel]] 20 21testConstraint testset2 [llength [info commands testset2]] 22 23catch {unset x} 24catch {unset i} 25 26test set-1.1 {TclCompileSetCmd: missing variable name} { 27 list [catch {set} msg] $msg 28} {1 {wrong # args: should be "set varName ?newValue?"}} 29test set-1.2 {TclCompileSetCmd: simple variable name} { 30 set i 10 31 list [set i] $i 32} {10 10} 33test set-1.3 {TclCompileSetCmd: error compiling variable name} { 34 set i 10 35 catch {set "i"xxx} msg 36 set msg 37} {extra characters after close-quote} 38test set-1.4 {TclCompileSetCmd: simple variable name in quotes} { 39 set i 17 40 list [set "i"] $i 41} {17 17} 42test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup { 43 catch {unset {a simple var}} 44} -body { 45 set {a simple var} 27 46 list [set {a simple var}] ${a simple var} 47} -result {27 27} 48test set-1.6 {TclCompileSetCmd: simple array variable name} -setup { 49 catch {unset a} 50} -body { 51 set a(foo) 37 52 list [set a(foo)] $a(foo) 53} -result {37 37} 54test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} { 55 set x "i" 56 set i 77 57 list [set $x] $i 58} {77 77} 59test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} { 60 set x "i" 61 set i 77 62 list [set [set x] 2] $i 63} {2 2} 64 65test set-1.9 {TclCompileSetCmd: 3rd arg => assignment} { 66 set i "abcdef" 67 list [set i] $i 68} {abcdef abcdef} 69test set-1.10 {TclCompileSetCmd: only two args => just getting value} { 70 set i {one two} 71 set i 72} {one two} 73 74test set-1.11 {TclCompileSetCmd: simple global name} { 75 proc p {} { 76 global i 77 set i 54 78 set i 79 } 80 p 81} {54} 82test set-1.12 {TclCompileSetCmd: simple local name} { 83 proc p {bar} { 84 set foo $bar 85 set foo 86 } 87 p 999 88} {999} 89test set-1.13 {TclCompileSetCmd: simple but new (unknown) local name} { 90 proc p {} { 91 set bar 92 } 93 catch {p} msg 94 set msg 95} {can't read "bar": no such variable} 96test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} { 97 proc 260locals {} { 98 # create 260 locals (the last ones with index > 255) 99 set a0 0; set a1 0; set a2 0; set a3 0; set a4 0 100 set a5 0; set a6 0; set a7 0; set a8 0; set a9 0 101 set b0 0; set b1 0; set b2 0; set b3 0; set b4 0 102 set b5 0; set b6 0; set b7 0; set b8 0; set b9 0 103 set c0 0; set c1 0; set c2 0; set c3 0; set c4 0 104 set c5 0; set c6 0; set c7 0; set c8 0; set c9 0 105 set d0 0; set d1 0; set d2 0; set d3 0; set d4 0 106 set d5 0; set d6 0; set d7 0; set d8 0; set d9 0 107 set e0 0; set e1 0; set e2 0; set e3 0; set e4 0 108 set e5 0; set e6 0; set e7 0; set e8 0; set e9 0 109 set f0 0; set f1 0; set f2 0; set f3 0; set f4 0 110 set f5 0; set f6 0; set f7 0; set f8 0; set f9 0 111 set g0 0; set g1 0; set g2 0; set g3 0; set g4 0 112 set g5 0; set g6 0; set g7 0; set g8 0; set g9 0 113 set h0 0; set h1 0; set h2 0; set h3 0; set h4 0 114 set h5 0; set h6 0; set h7 0; set h8 0; set h9 0 115 set i0 0; set i1 0; set i2 0; set i3 0; set i4 0 116 set i5 0; set i6 0; set i7 0; set i8 0; set i9 0 117 set j0 0; set j1 0; set j2 0; set j3 0; set j4 0 118 set j5 0; set j6 0; set j7 0; set j8 0; set j9 0 119 set k0 0; set k1 0; set k2 0; set k3 0; set k4 0 120 set k5 0; set k6 0; set k7 0; set k8 0; set k9 0 121 set l0 0; set l1 0; set l2 0; set l3 0; set l4 0 122 set l5 0; set l6 0; set l7 0; set l8 0; set l9 0 123 set m0 0; set m1 0; set m2 0; set m3 0; set m4 0 124 set m5 0; set m6 0; set m7 0; set m8 0; set m9 0 125 set n0 0; set n1 0; set n2 0; set n3 0; set n4 0 126 set n5 0; set n6 0; set n7 0; set n8 0; set n9 0 127 set o0 0; set o1 0; set o2 0; set o3 0; set o4 0 128 set o5 0; set o6 0; set o7 0; set o8 0; set o9 0 129 set p0 0; set p1 0; set p2 0; set p3 0; set p4 0 130 set p5 0; set p6 0; set p7 0; set p8 0; set p9 0 131 set q0 0; set q1 0; set q2 0; set q3 0; set q4 0 132 set q5 0; set q6 0; set q7 0; set q8 0; set q9 0 133 set r0 0; set r1 0; set r2 0; set r3 0; set r4 0 134 set r5 0; set r6 0; set r7 0; set r8 0; set r9 0 135 set s0 0; set s1 0; set s2 0; set s3 0; set s4 0 136 set s5 0; set s6 0; set s7 0; set s8 0; set s9 0 137 set t0 0; set t1 0; set t2 0; set t3 0; set t4 0 138 set t5 0; set t6 0; set t7 0; set t8 0; set t9 0 139 set u0 0; set u1 0; set u2 0; set u3 0; set u4 0 140 set u5 0; set u6 0; set u7 0; set u8 0; set u9 0 141 set v0 0; set v1 0; set v2 0; set v3 0; set v4 0 142 set v5 0; set v6 0; set v7 0; set v8 0; set v9 0 143 set w0 0; set w1 0; set w2 0; set w3 0; set w4 0 144 set w5 0; set w6 0; set w7 0; set w8 0; set w9 0 145 set x0 0; set x1 0; set x2 0; set x3 0; set x4 0 146 set x5 0; set x6 0; set x7 0; set x8 0; set x9 0 147 set y0 0; set y1 0; set y2 0; set y3 0; set y4 0 148 set y5 0; set y6 0; set y7 0; set y8 0; set y9 0 149 set z0 0; set z1 0; set z2 0; set z3 0; set z4 0 150 set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234 151 } 152 260locals 153} {1234} 154test set-1.15 {TclCompileSetCmd: variable is array} -setup { 155 catch {unset a} 156} -body { 157 set x 27 158 set x [set a(foo) 11] 159 catch {unset a} 160 set x 161} -result 11 162test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup { 163 catch {unset a} 164} -body { 165 set i 5 166 set x 789 167 set a(foo5) 27 168 set x [set a(foo$i)] 169 catch {unset a} 170 set x 171} -result 27 172 173test set-1.17 {TclCompileSetCmd: doing assignment, simple int} { 174 set i 5 175 set i 123 176} 123 177test set-1.18 {TclCompileSetCmd: doing assignment, simple int} { 178 set i 5 179 set i -100 180} -100 181test set-1.19 {TclCompileSetCmd: doing assignment, simple but not int} { 182 set i 5 183 set i 0x12MNOP 184 set i 185} {0x12MNOP} 186test set-1.20 {TclCompileSetCmd: doing assignment, in quotes} { 187 set i 25 188 set i "-100" 189} -100 190test set-1.21 {TclCompileSetCmd: doing assignment, in braces} { 191 set i 24 192 set i {126} 193} 126 194test set-1.22 {TclCompileSetCmd: doing assignment, large int} { 195 set i 5 196 set i 200000 197} 200000 198test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} { 199 set i 25 200 set i 0o00012345 ;# an octal literal == 5349 decimal 201 list $i [incr i] 202} {0o00012345 5350} 203 204test set-1.24 {TclCompileSetCmd: too many arguments} { 205 set i 10 206 catch {set i 20 30} msg 207 set msg 208} {wrong # args: should be "set varName ?newValue?"} 209 210test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} { 211 # This was a known error in 8.1a* - 8.2.1 212 catch {unset array} 213 set {array($foo)} 5 214} 5 215test set-1.26 {TclCompileSetCmd: various array constructs} { 216 # Test all kinds of array constructs that TclCompileSetCmd 217 # may feel inclined to tamper with. 218 apply {{} { 219 set a x 220 set be(hej) 1 ; # hej 221 set be($a) 1 ; # x 222 set {be($a)} 1 ; # $a 223 set be($a,hej) 1 ; # x,hej 224 set be($a,$a) 5 ; # x,x 225 set be(c($a) 1 ; # c(x 226 set be(\w\w) 1 ; # ww 227 set be(a:$a) [set be(x,$a)] ; # a:x 228 set be(hej,$be($a,hej),hej) 1 ; # hej,1,hej 229 set be([string range hugge 0 2]) 1 ; # hug 230 set be(a\ a) 1 ; # a a 231 set be($a\ ,[string range hugge 1 3],hej) 1 ; # x ,ugg,hej 232 set be($a,h"ej) 1 ; # x,h"ej 233 set be([string range "a b c" 2 end]) 1 ; # b c 234 set [string range bet 0 1](foo) 1 ; # foo 235 set be([set be(a:$a)][set b\e($a)]) 1 ; # 51 236 return [lsort [array names be]] 237 }} 238} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej 239{b c} foo 51}]; # " just a matching end quote 240 241test set-2.1 {set command: runtime error, bad variable name} -setup { 242 unset -nocomplain {"foo} 243} -body { 244 list [catch {set {"foo}} msg] $msg $::errorInfo 245} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable 246 while executing 247"set {"foo}"}} 248# Stop my editor highlighter " from being confused 249test set-2.2 {set command: runtime error, not array variable} -setup { 250 unset -nocomplain b 251} -body { 252 set b 44 253 list [catch {set b(123)} msg] $msg 254} -result {1 {can't read "b(123)": variable isn't array}} 255test set-2.3 {set command: runtime error, errors in reading variables} -setup { 256 unset -nocomplain a 257} -body { 258 set a(6) 44 259 list [catch {set a(18)} msg] $msg 260} -result {1 {can't read "a(18)": no such element in array}} 261test set-2.4 {set command: runtime error, readonly variable} -setup { 262 unset -nocomplain x 263} -body { 264 proc readonly args {error "variable is read-only"} 265 set x 123 266 trace var x w readonly 267 list [catch {set x 1} msg] $msg $::errorInfo 268} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only 269 while executing 270* 271"set x 1"}} 272test set-2.5 {set command: runtime error, basic array operations} -setup { 273 unset -nocomplain a 274} -body { 275 array set a {} 276 list [catch {set a(other)} msg] $msg 277} -result {1 {can't read "a(other)": no such element in array}} 278test set-2.6 {set command: runtime error, basic array operations} -setup { 279 unset -nocomplain a 280} -body { 281 array set a {} 282 list [catch {set a} msg] $msg 283} -result {1 {can't read "a": variable is array}} 284 285# Test the uncompiled version of set 286 287catch {unset a} 288catch {unset b} 289catch {unset i} 290catch {unset x} 291 292test set-3.1 {uncompiled set command: missing variable name} { 293 set z set 294 list [catch {$z} msg] $msg 295} {1 {wrong # args: should be "set varName ?newValue?"}} 296test set-3.2 {uncompiled set command: simple variable name} { 297 set z set 298 $z i 10 299 list [$z i] $i 300} {10 10} 301test set-3.3 {uncompiled set command: error compiling variable name} { 302 set z set 303 $z i 10 304 catch {$z "i"xxx} msg 305 $z msg 306} {extra characters after close-quote} 307test set-3.4 {uncompiled set command: simple variable name in quotes} { 308 set z set 309 $z i 17 310 list [$z "i"] $i 311} {17 17} 312test set-3.5 {uncompiled set command: simple variable name in braces} { 313 set z set 314 catch {unset {a simple var}} 315 $z {a simple var} 27 316 list [$z {a simple var}] ${a simple var} 317} {27 27} 318test set-3.6 {uncompiled set command: simple array variable name} { 319 set z set 320 catch {unset a} 321 $z a(foo) 37 322 list [$z a(foo)] $a(foo) 323} {37 37} 324test set-3.7 {uncompiled set command: non-simple (computed) variable name} { 325 set z set 326 $z x "i" 327 $z i 77 328 list [$z $x] $i 329} {77 77} 330test set-3.8 {uncompiled set command: non-simple (computed) variable name} { 331 set z set 332 $z x "i" 333 $z i 77 334 list [$z [$z x] 2] $i 335} {2 2} 336 337test set-3.9 {uncompiled set command: 3rd arg => assignment} { 338 set z set 339 $z i "abcdef" 340 list [$z i] $i 341} {abcdef abcdef} 342test set-3.10 {uncompiled set command: only two args => just getting value} { 343 set z set 344 $z i {one two} 345 $z i 346} {one two} 347 348test set-3.11 {uncompiled set command: simple global name} { 349 proc p {} { 350 set z set 351 global i 352 $z i 54 353 $z i 354 } 355 p 356} {54} 357test set-3.12 {uncompiled set command: simple local name} { 358 proc p {bar} { 359 set z set 360 $z foo $bar 361 $z foo 362 } 363 p 999 364} {999} 365test set-3.13 {uncompiled set command: simple but new (unknown) local name} { 366 set z set 367 proc p {} { 368 set z set 369 $z bar 370 } 371 catch {p} msg 372 $z msg 373} {can't read "bar": no such variable} 374test set-3.14 {uncompiled set command: simple local name, >255 locals} { 375 proc 260locals {} { 376 set z set 377 # create 260 locals (the last ones with index > 255) 378 $z a0 0; $z a1 0; $z a2 0; $z a3 0; $z a4 0 379 $z a5 0; $z a6 0; $z a7 0; $z a8 0; $z a9 0 380 $z b0 0; $z b1 0; $z b2 0; $z b3 0; $z b4 0 381 $z b5 0; $z b6 0; $z b7 0; $z b8 0; $z b9 0 382 $z c0 0; $z c1 0; $z c2 0; $z c3 0; $z c4 0 383 $z c5 0; $z c6 0; $z c7 0; $z c8 0; $z c9 0 384 $z d0 0; $z d1 0; $z d2 0; $z d3 0; $z d4 0 385 $z d5 0; $z d6 0; $z d7 0; $z d8 0; $z d9 0 386 $z e0 0; $z e1 0; $z e2 0; $z e3 0; $z e4 0 387 $z e5 0; $z e6 0; $z e7 0; $z e8 0; $z e9 0 388 $z f0 0; $z f1 0; $z f2 0; $z f3 0; $z f4 0 389 $z f5 0; $z f6 0; $z f7 0; $z f8 0; $z f9 0 390 $z g0 0; $z g1 0; $z g2 0; $z g3 0; $z g4 0 391 $z g5 0; $z g6 0; $z g7 0; $z g8 0; $z g9 0 392 $z h0 0; $z h1 0; $z h2 0; $z h3 0; $z h4 0 393 $z h5 0; $z h6 0; $z h7 0; $z h8 0; $z h9 0 394 $z i0 0; $z i1 0; $z i2 0; $z i3 0; $z i4 0 395 $z i5 0; $z i6 0; $z i7 0; $z i8 0; $z i9 0 396 $z j0 0; $z j1 0; $z j2 0; $z j3 0; $z j4 0 397 $z j5 0; $z j6 0; $z j7 0; $z j8 0; $z j9 0 398 $z k0 0; $z k1 0; $z k2 0; $z k3 0; $z k4 0 399 $z k5 0; $z k6 0; $z k7 0; $z k8 0; $z k9 0 400 $z l0 0; $z l1 0; $z l2 0; $z l3 0; $z l4 0 401 $z l5 0; $z l6 0; $z l7 0; $z l8 0; $z l9 0 402 $z m0 0; $z m1 0; $z m2 0; $z m3 0; $z m4 0 403 $z m5 0; $z m6 0; $z m7 0; $z m8 0; $z m9 0 404 $z n0 0; $z n1 0; $z n2 0; $z n3 0; $z n4 0 405 $z n5 0; $z n6 0; $z n7 0; $z n8 0; $z n9 0 406 $z o0 0; $z o1 0; $z o2 0; $z o3 0; $z o4 0 407 $z o5 0; $z o6 0; $z o7 0; $z o8 0; $z o9 0 408 $z p0 0; $z p1 0; $z p2 0; $z p3 0; $z p4 0 409 $z p5 0; $z p6 0; $z p7 0; $z p8 0; $z p9 0 410 $z q0 0; $z q1 0; $z q2 0; $z q3 0; $z q4 0 411 $z q5 0; $z q6 0; $z q7 0; $z q8 0; $z q9 0 412 $z r0 0; $z r1 0; $z r2 0; $z r3 0; $z r4 0 413 $z r5 0; $z r6 0; $z r7 0; $z r8 0; $z r9 0 414 $z s0 0; $z s1 0; $z s2 0; $z s3 0; $z s4 0 415 $z s5 0; $z s6 0; $z s7 0; $z s8 0; $z s9 0 416 $z t0 0; $z t1 0; $z t2 0; $z t3 0; $z t4 0 417 $z t5 0; $z t6 0; $z t7 0; $z t8 0; $z t9 0 418 $z u0 0; $z u1 0; $z u2 0; $z u3 0; $z u4 0 419 $z u5 0; $z u6 0; $z u7 0; $z u8 0; $z u9 0 420 $z v0 0; $z v1 0; $z v2 0; $z v3 0; $z v4 0 421 $z v5 0; $z v6 0; $z v7 0; $z v8 0; $z v9 0 422 $z w0 0; $z w1 0; $z w2 0; $z w3 0; $z w4 0 423 $z w5 0; $z w6 0; $z w7 0; $z w8 0; $z w9 0 424 $z x0 0; $z x1 0; $z x2 0; $z x3 0; $z x4 0 425 $z x5 0; $z x6 0; $z x7 0; $z x8 0; $z x9 0 426 $z y0 0; $z y1 0; $z y2 0; $z y3 0; $z y4 0 427 $z y5 0; $z y6 0; $z y7 0; $z y8 0; $z y9 0 428 $z z0 0; $z z1 0; $z z2 0; $z z3 0; $z z4 0 429 $z z5 0; $z z6 0; $z z7 0; $z z8 0; $z z9 1234 430 } 431 260locals 432} {1234} 433test set-3.15 {uncompiled set command: variable is array} { 434 set z set 435 catch {unset a} 436 $z x 27 437 $z x [$z a(foo) 11] 438 catch {unset a} 439 $z x 440} 11 441test set-3.16 {uncompiled set command: variable is array, elem substitutions} { 442 set z set 443 catch {unset a} 444 $z i 5 445 $z x 789 446 $z a(foo5) 27 447 $z x [$z a(foo$i)] 448 catch {unset a} 449 $z x 450} 27 451 452test set-3.17 {uncompiled set command: doing assignment, simple int} { 453 set z set 454 $z i 5 455 $z i 123 456} 123 457test set-3.18 {uncompiled set command: doing assignment, simple int} { 458 set z set 459 $z i 5 460 $z i -100 461} -100 462test set-3.19 {uncompiled set command: doing assignment, simple but not int} { 463 set z set 464 $z i 5 465 $z i 0x12MNOP 466 $z i 467} {0x12MNOP} 468test set-3.20 {uncompiled set command: doing assignment, in quotes} { 469 set z set 470 $z i 25 471 $z i "-100" 472} -100 473test set-3.21 {uncompiled set command: doing assignment, in braces} { 474 set z set 475 $z i 24 476 $z i {126} 477} 126 478test set-3.22 {uncompiled set command: doing assignment, large int} { 479 set z set 480 $z i 5 481 $z i 200000 482} 200000 483test set-3.23 {uncompiled set command: doing assignment, formatted int != int} { 484 set z set 485 $z i 25 486 $z i 0o00012345 ;# an octal literal == 5349 decimal 487 list $i [incr i] 488} {0o00012345 5350} 489 490test set-3.24 {uncompiled set command: too many arguments} { 491 set z set 492 $z i 10 493 catch {$z i 20 30} msg 494 $z msg 495} {wrong # args: should be "set varName ?newValue?"} 496 497test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup { 498 unset -nocomplain {"foo} 499} -body { 500 set z set 501 list [catch {$z {"foo}} msg] $msg $::errorInfo 502} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable 503 while executing 504"$z {"foo}"}} 505# Stop my editor highlighter " from being confused 506test set-4.2 {uncompiled set command: runtime error, not array variable} -setup { 507 catch {unset b} 508} -body { 509 set z set 510 $z b 44 511 list [catch {$z b(123)} msg] $msg 512} -result {1 {can't read "b(123)": variable isn't array}} 513test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup { 514 catch {unset a} 515} -body { 516 set z set 517 $z a(6) 44 518 list [catch {$z a(18)} msg] $msg 519} -result {1 {can't read "a(18)": no such element in array}} 520test set-4.4 {uncompiled set command: runtime error, readonly variable} -body { 521 set z set 522 proc readonly args {error "variable is read-only"} 523 $z x 123 524 trace var x w readonly 525 list [catch {$z x 1} msg] $msg $::errorInfo 526} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only 527 while executing 528* 529"$z x 1"}} 530test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup { 531 unset -nocomplain a 532 array set a {} 533} -body { 534 set z set 535 list [catch {$z a(other)} msg] $msg 536} -result {1 {can't read "a(other)": no such element in array}} 537test set-4.6 {set command: runtime error, basic array operations} -setup { 538 unset -nocomplain a 539 array set a {} 540} -body { 541 set z set 542 list [catch {$z a} msg] $msg 543} -result {1 {can't read "a": variable is array}} 544 545test set-5.1 {error on malformed array name} -constraints testset2 -setup { 546 unset -nocomplain z 547} -body { 548 catch {testset2 z(a) b} msg 549 catch {testset2 z(b) a} msg1 550 list $msg $msg1 551} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}} 552# In a mem-debug build, this test will crash unless Bug 3602706 is fixed. 553test set-5.2 {Bug 3602706} -body { 554 testset2 ::tcl_platform not-in-there 555} -returnCodes error -result * -match glob 556 557# cleanup 558catch {unset a} 559catch {unset b} 560catch {unset i} 561catch {unset x} 562catch {unset z} 563::tcltest::cleanupTests 564return 565 566# Local Variables: 567# mode: tcl 568# End: 569