1# This file contains tests for the tclVar.c source file. Tests appear in 2# the same order as the C code that they test. The set of tests is 3# currently incomplete since it currently includes only new tests for 4# code changed for the addition of Tcl namespaces. Other variable- 5# related tests appear in several other test files including 6# namespace.test, set.test, trace.test, and upvar.test. 7# 8# Sourcing this file into Tcl runs the tests and generates output for 9# errors. No output means no errors were found. 10# 11# Copyright (c) 1997 Sun Microsystems, Inc. 12# Copyright (c) 1998-1999 by Scriptics Corporation. 13# 14# See the file "license.terms" for information on usage and redistribution 15# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 16# 17# RCS: @(#) $Id: var.test,v 1.20.2.4 2007/03/13 15:59:53 dgp Exp $ 18# 19 20if {[lsearch [namespace children] ::tcltest] == -1} { 21 package require tcltest 2.2 22 namespace import -force ::tcltest::* 23} 24 25catch {rename p ""} 26catch {namespace delete test_ns_var} 27catch {unset xx} 28catch {unset x} 29catch {unset y} 30catch {unset i} 31catch {unset a} 32catch {unset arr} 33 34test var-1.1 {TclLookupVar, Array handling} { 35 catch {unset a} 36 set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd 37 set i 10 38 set arr(foo) 37 39 list [$x i] $i [$x arr(foo)] $arr(foo) 40} {11 11 38 38} 41test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} { 42 set x "global value" 43 namespace eval test_ns_var { 44 variable x "namespace value" 45 proc p {} { 46 global x ;# specifies TCL_GLOBAL_ONLY to get global x 47 return $x 48 } 49 } 50 test_ns_var::p 51} {global value} 52test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} { 53 namespace eval test_ns_var { 54 proc q {} { 55 variable x ;# specifies TCL_NAMESPACE_ONLY to get namespace x 56 return $x 57 } 58 } 59 test_ns_var::q 60} {namespace value} 61test var-1.4 {TclLookupVar, no active call frame implies global namespace var} { 62 set x 63} {global value} 64test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} { 65 namespace eval test_ns_var {set x} 66} {namespace value} 67test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} { 68 namespace eval test_ns_var {set ::x} 69} {global value} 70test var-1.7 {TclLookupVar, error finding namespace var} { 71 list [catch {set a:::b} msg] $msg 72} {1 {can't read "a:::b": no such variable}} 73test var-1.8 {TclLookupVar, error finding namespace var} { 74 list [catch {set ::foobarfoo} msg] $msg 75} {1 {can't read "::foobarfoo": no such variable}} 76test var-1.9 {TclLookupVar, create new namespace var} { 77 namespace eval test_ns_var { 78 set v hello 79 } 80} {hello} 81test var-1.10 {TclLookupVar, create new namespace var} { 82 catch {unset y} 83 namespace eval test_ns_var { 84 set ::y 789 85 } 86 set y 87} {789} 88test var-1.11 {TclLookupVar, error creating new namespace var} { 89 namespace eval test_ns_var { 90 list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg 91 } 92} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}} 93test var-1.12 {TclLookupVar, error creating new namespace var} { 94 namespace eval test_ns_var { 95 list [catch {set ::test_ns_var::foo:: 1997} msg] $msg 96 } 97} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}} 98test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} { 99 catch {unset aNeWnAmEiNnS} 100 namespace eval test_ns_var { 101 namespace eval test_ns_var2::test_ns_var3 { 102 set aNeWnAmEiNnS 77777 103 } 104 # namespace which builds a name by traversing nsPtr chain to :: 105 namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS 106 } 107} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS} 108test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} { 109 namespace eval test_ns_var { 110 set : 123 111 set v: 456 112 set x:y: 789 113 list [set :] [set v:] [set x:y:] \ 114 ${:} ${v:} ${x:y:} \ 115 [expr {[lsearch [info vars] :] != -1}] \ 116 [expr {[lsearch [info vars] v:] != -1}] \ 117 [expr {[lsearch [info vars] x:y:] != -1}] 118 } 119} {123 456 789 123 456 789 1 1 1} 120test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} { 121 namespace eval test_ns_var { 122 variable foo 2 123 } 124 proc p {} { 125 variable ::test_ns_var::foo 126 lappend result [catch {set foo} msg] $msg 127 namespace delete ::test_ns_var 128 lappend result [catch {set foo 3} msg] $msg 129 lappend result [catch {set foo(3) 3} msg] $msg 130 } 131 p 132} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}} 133test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} { 134 namespace eval test_ns_var { 135 variable result 136 namespace eval subns { 137 variable foo 2 138 } 139 upvar 0 subns::foo foo 140 lappend result [catch {set foo} msg] $msg 141 namespace delete subns 142 lappend result [catch {set foo 3} msg] $msg 143 lappend result [catch {set foo(3) 3} msg] $msg 144 namespace delete [namespace current] 145 set result 146 } 147} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}} 148test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} { 149 namespace eval test_ns_var { 150 variable result 151 proc p {} { 152 array set x {1 2 3 4} 153 upvar 0 x(1) foo 154 lappend result [catch {set foo} msg] $msg 155 unset x 156 lappend result [catch {set foo 3} msg] $msg 157 } 158 set result [p] 159 namespace delete [namespace current] 160 set result 161 } 162} {0 2 1 {can't set "foo": upvar refers to element in deleted array}} 163test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} { 164 namespace eval test_ns_var { 165 variable result {} 166 variable x 167 array set x {1 2 3 4} 168 upvar 0 x(1) foo 169 lappend result [catch {set foo} msg] $msg 170 unset x 171 lappend result [catch {set foo 3} msg] $msg 172 namespace delete [namespace current] 173 set result 174 } 175} {0 2 1 {can't set "foo": upvar refers to element in deleted array}} 176test var-1.19 {TclLookupVar, right error message when parsing variable name} { 177 list [catch {[format set] thisvar(doesntexist)} msg] $msg 178} {1 {can't read "thisvar(doesntexist)": no such variable}} 179 180test var-2.1 {Tcl_LappendObjCmd, create var if new} { 181 catch {unset x} 182 lappend x 1 2 183} {1 2} 184 185test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} { 186 catch {unset x} 187 set x 1997 188 proc p {} { 189 global x ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x 190 return $x 191 } 192 p 193} {1997} 194test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} { 195 namespace eval test_ns_var { 196 catch {unset v} 197 variable v 1998 198 proc p {} { 199 variable v ;# TCL_NAMESPACE_ONLY specified for other var x 200 return $v 201 } 202 p 203 } 204} {1998} 205if {[info commands testupvar] != {}} { 206 test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} { 207 catch {unset a} 208 set a 123321 209 proc p {} { 210 # create global xx linked to global a 211 testupvar 1 a {} xx global 212 } 213 list [p] $xx [set xx 789] $a 214 } {{} 123321 789 789} 215 test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} { 216 catch {unset a} 217 set a 456 218 namespace eval test_ns_var { 219 catch {unset ::test_ns_var::vv} 220 proc p {} { 221 # create namespace var vv linked to global a 222 testupvar 1 a {} vv namespace 223 } 224 p 225 } 226 list $test_ns_var::vv [set test_ns_var::vv 123] $a 227 } {456 123 123} 228} 229test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} { 230 catch {unset aaaaa} 231 catch {unset xxxxx} 232 set aaaaa 77777 233 upvar #0 aaaaa xxxxx 234 list [set xxxxx] [set aaaaa] 235} {77777 77777} 236test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} { 237 catch {unset a} 238 set a 121212 239 namespace eval test_ns_var { 240 upvar ::a vvv 241 set vvv 242 } 243} {121212} 244test var-3.7 {MakeUpvar, my var has ::s} { 245 catch {unset a} 246 set a 789789 247 upvar #0 a test_ns_var::lnk 248 namespace eval test_ns_var { 249 set lnk 250 } 251} {789789} 252test var-3.8 {MakeUpvar, my var already exists in global ns} { 253 catch {unset aaaaa} 254 catch {unset xxxxx} 255 set aaaaa 456654 256 set xxxxx hello 257 upvar #0 aaaaa xxxxx 258 set xxxxx 259} {hello} 260test var-3.9 {MakeUpvar, my var has invalid ns name} { 261 catch {unset aaaaa} 262 set aaaaa 789789 263 list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg 264} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}} 265test var-3.10 {MakeUpvar, } { 266 namespace eval {} { 267 set bar 0 268 namespace eval foo upvar bar bar 269 set foo::bar 1 270 catch {list $bar $foo::bar} msg 271 unset ::aaaaa 272 set msg 273 } 274} {1 1} 275 276if {[info commands testgetvarfullname] != {}} { 277 test var-4.1 {Tcl_GetVariableName, global variable} { 278 catch {unset a} 279 set a 123 280 testgetvarfullname a global 281 } ::a 282 test var-4.2 {Tcl_GetVariableName, namespace variable} { 283 namespace eval test_ns_var { 284 variable george 285 testgetvarfullname george namespace 286 } 287 } ::test_ns_var::george 288 test var-4.3 {Tcl_GetVariableName, variable can't be array element} { 289 catch {unset a} 290 set a(1) foo 291 list [catch {testgetvarfullname a(1) global} msg] $msg 292 } {1 {unknown variable "a(1)"}} 293} 294 295test var-5.1 {Tcl_GetVariableFullName, global variable} { 296 catch {unset a} 297 set a bar 298 namespace which -variable a 299} {::a} 300test var-5.2 {Tcl_GetVariableFullName, namespace variable} { 301 namespace eval test_ns_var { 302 variable martha 303 namespace which -variable martha 304 } 305} {::test_ns_var::martha} 306test var-5.3 {Tcl_GetVariableFullName, namespace variable} { 307 namespace which -variable test_ns_var::martha 308} {::test_ns_var::martha} 309 310test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} { 311 namespace eval test_ns_var { 312 variable boeing 777 313 } 314 proc p {} { 315 global ::test_ns_var::boeing 316 set boeing 317 } 318 p 319} {777} 320test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} { 321 namespace eval test_ns_var { 322 namespace eval test_ns_nested { 323 variable java java 324 } 325 proc p {} { 326 global ::test_ns_var::test_ns_nested::java 327 set java 328 } 329 } 330 test_ns_var::p 331} {java} 332test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} { 333 set ::test_ns_var::test_ns_nested:: 24 334 proc p {} { 335 global ::test_ns_var::test_ns_nested:: 336 set {} 337 } 338 p 339} {24} 340test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} { 341 # Test for Tcl Bug 480176 342 set :v broken 343 proc p {} { 344 global :v 345 set :v fixed 346 } 347 p 348 set :v 349} {fixed} 350 351test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} { 352 catch {namespace delete test_ns_var} 353 namespace eval test_ns_var { 354 variable one 1 355 } 356 list [info vars test_ns_var::*] [set test_ns_var::one] 357} {::test_ns_var::one 1} 358test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} { 359 set two 2222222 360 namespace eval test_ns_var { 361 variable two 362 } 363 list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg 364} {0 1 {can't read "test_ns_var::two": no such variable}} 365test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} { 366 namespace eval test_ns_var { 367 variable two 2 368 } 369 list [lsort [info vars test_ns_var::*]] \ 370 [namespace eval test_ns_var {set two}] 371} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2] 372test var-7.4 {Tcl_VariableObjCmd, list of vars} { 373 namespace eval test_ns_var { 374 variable three 3 four 4 375 } 376 list [lsort [info vars test_ns_var::*]] \ 377 [namespace eval test_ns_var {expr $three+$four}] 378} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7] 379test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} { 380 catch {unset a} 381 catch {unset five} 382 catch {unset six} 383 set a "" 384 set five 555 385 set six 666 386 namespace eval test_ns_var { 387 variable five 5 six 388 lappend a $five 389 } 390 lappend a $test_ns_var::five \ 391 [set test_ns_var::six 6] [set test_ns_var::six] $six 392 catch {unset five} 393 catch {unset six} 394 set a 395} {5 5 6 6 666} 396catch {unset newvar} 397test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} { 398 namespace eval test_ns_var { 399 variable ::newvar cheers! 400 } 401 set newvar 402} {cheers!} 403catch {unset newvar} 404test var-7.7 {Tcl_VariableObjCmd, bad var name} { 405 namespace eval test_ns_var { 406 list [catch {variable sev:::en 7} msg] $msg 407 } 408} {1 {can't define "sev:::en": parent namespace doesn't exist}} 409test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} { 410 set a "" 411 namespace eval test_ns_var { 412 variable eight 8 413 lappend a $eight 414 variable eight 415 lappend a $eight 416 } 417 set a 418} {8 8} 419test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} { 420 catch {namespace delete test_ns_var2} 421 set a "" 422 namespace eval test_ns_var2 { 423 variable x 123 424 variable y 425 variable z 426 } 427 lappend a [lsort [info vars test_ns_var2::*]] 428 lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \ 429 [info exists test_ns_var2::z] 430 lappend a [list [catch {set test_ns_var2::y} msg] $msg] 431 lappend a [lsort [info vars test_ns_var2::*]] 432 lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] 433 lappend a [set test_ns_var2::y hello] 434 lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] 435 lappend a [list [catch {unset test_ns_var2::y} msg] $msg] 436 lappend a [lsort [info vars test_ns_var2::*]] 437 lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z] 438 lappend a [list [catch {unset test_ns_var2::z} msg] $msg] 439 lappend a [namespace delete test_ns_var2] 440 set a 441} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\ 442 {1 {can't read "test_ns_var2::y": no such variable}}\ 443 [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\ 444 hello 1 0\ 445 {0 {}}\ 446 [lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\ 447 {1 {can't unset "test_ns_var2::z": no such variable}}\ 448 {}] 449test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} { 450 namespace eval test_ns_var { 451 proc p {} { 452 variable eight 453 list [set eight] [info vars] 454 } 455 p 456 } 457} {8 eight} 458test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} { 459 proc p {} { ;# note this proc is at global :: scope 460 variable test_ns_var::eight 461 list [set eight] [info vars] 462 } 463 p 464} {8 eight} 465test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} { 466 namespace eval test_ns_var { 467 variable {} {My name is empty} 468 } 469 proc p {} { ;# note this proc is at global :: scope 470 variable test_ns_var:: 471 list [set {}] [info vars] 472 } 473 p 474} {{My name is empty} {{}}} 475test var-7.13 {Tcl_VariableObjCmd, variable named ":"} { 476 namespace eval test_ns_var { 477 variable : {My name is ":"} 478 proc p {} { 479 variable : 480 list [set :] [info vars] 481 } 482 p 483 } 484} {{My name is ":"} :} 485test var-7.14 {Tcl_VariableObjCmd, array element parameter} { 486 catch {namespace eval test_ns_var { variable arrayvar(1) }} res 487 set res 488} "can't define \"arrayvar(1)\": name refers to an element in an array" 489test var-7.15 {Tcl_VariableObjCmd, array element parameter} { 490 catch { 491 namespace eval test_ns_var { 492 variable arrayvar 493 set arrayvar(1) x 494 variable arrayvar(1) y 495 } 496 } res 497 set res 498} "can't define \"arrayvar(1)\": name refers to an element in an array" 499test var-7.16 {Tcl_VariableObjCmd, no args} { 500 list [catch {variable} msg] $msg 501} {1 {wrong # args: should be "variable ?name value...? name ?value?"}} 502test var-7.17 {Tcl_VariableObjCmd, no args} { 503 namespace eval test_ns_var { 504 list [catch {variable} msg] $msg 505 } 506} {1 {wrong # args: should be "variable ?name value...? name ?value?"}} 507 508test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} { 509 catch {namespace delete test_ns_var} 510 catch {unset a} 511 namespace eval test_ns_var { 512 variable v 123 513 variable info "" 514 515 proc traceUnset {name1 name2 op} { 516 variable info 517 set info [concat $info [list $name1 $name2 $op]] 518 } 519 520 trace var v u [namespace code traceUnset] 521 } 522 list [unset test_ns_var::v] $test_ns_var::info 523} {{} {test_ns_var::v {} u}} 524 525if {[info commands testsetnoerr] == {}} { 526 puts "This application hasn't been compiled with the \"testsetnoerr\"" 527 puts "command, so I can't test TclSetVar etc." 528} else { 529test var-9.1 {behaviour of TclGet/SetVar simple get/set} { 530 catch {unset u}; catch {unset v} 531 list \ 532 [set u a; testsetnoerr u] \ 533 [testsetnoerr v b] \ 534 [testseterr u] \ 535 [unset v; testseterr v b] 536} [list {before get a} {before set b} {before get a} {before set b}] 537test var-9.2 {behaviour of TclGet/SetVar namespace get/set} { 538 catch {namespace delete ns} 539 namespace eval ns {variable u a; variable v} 540 list \ 541 [testsetnoerr ns::u] \ 542 [testsetnoerr ns::v b] \ 543 [testseterr ns::u] \ 544 [unset ns::v; testseterr ns::v b] 545} [list {before get a} {before set b} {before get a} {before set b}] 546test var-9.3 {behaviour of TclGetVar no variable} { 547 catch {unset u} 548 list \ 549 [catch {testsetnoerr u} res] $res \ 550 [catch {testseterr u} res] $res 551} {1 {before get} 1 {can't read "u": no such variable}} 552test var-9.4 {behaviour of TclGetVar no namespace variable} { 553 catch {namespace delete ns} 554 namespace eval ns {} 555 list \ 556 [catch {testsetnoerr ns::w} res] $res \ 557 [catch {testseterr ns::w} res] $res 558} {1 {before get} 1 {can't read "ns::w": no such variable}} 559test var-9.5 {behaviour of TclGetVar no namespace} { 560 catch {namespace delete ns} 561 list \ 562 [catch {testsetnoerr ns::u} res] $res \ 563 [catch {testseterr ns::v} res] $res 564} {1 {before get} 1 {can't read "ns::v": no such variable}} 565test var-9.6 {behaviour of TclSetVar no namespace} { 566 catch {namespace delete ns} 567 list \ 568 [catch {testsetnoerr ns::v 1} res] $res \ 569 [catch {testseterr ns::v 1} res] $res 570} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}} 571test var-9.7 {behaviour of TclGetVar array variable} { 572 catch {unset arr} 573 set arr(1) 1; 574 list \ 575 [catch {testsetnoerr arr} res] $res \ 576 [catch {testseterr arr} res] $res 577} {1 {before get} 1 {can't read "arr": variable is array}} 578test var-9.8 {behaviour of TclSetVar array variable} { 579 catch {unset arr} 580 set arr(1) 1 581 list \ 582 [catch {testsetnoerr arr 2} res] $res \ 583 [catch {testseterr arr 2} res] $res 584} {1 {before set} 1 {can't set "arr": variable is array}} 585test var-9.9 {behaviour of TclGetVar read trace success} { 586 proc resetvar {val name elem op} {upvar 1 $name v; set v $val} 587 catch {unset u}; catch {unset v} 588 set u 10 589 trace var u r [list resetvar 1] 590 trace var v r [list resetvar 2] 591 list \ 592 [testsetnoerr u] \ 593 [testseterr v] 594} {{before get 1} {before get 2}} 595test var-9.10 {behaviour of TclGetVar read trace error} { 596 proc writeonly args {error "write-only"} 597 set v 456 598 trace var v r writeonly 599 list \ 600 [catch {testsetnoerr v} msg] $msg \ 601 [catch {testseterr v} msg] $msg 602} {1 {before get} 1 {can't read "v": write-only}} 603test var-9.11 {behaviour of TclSetVar write trace success} { 604 proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]} 605 catch {unset u}; catch {unset v} 606 set v 1 607 trace var v w doubleval 608 trace var u w doubleval 609 list \ 610 [testsetnoerr u 2] \ 611 [testseterr v 3] 612} {{before set 4} {before set 6}} 613test var-9.12 {behaviour of TclSetVar write trace error} { 614 proc readonly args {error "read-only"} 615 set v 456 616 trace var v w readonly 617 list \ 618 [catch {testsetnoerr v 2} msg] $msg $v \ 619 [catch {testseterr v 3} msg] $msg $v 620} {1 {before set} 2 1 {can't set "v": read-only} 3} 621} 622test var-10.1 {can't nest arrays with array set} { 623 catch {unset arr} 624 list [catch {array set arr(x) {a 1 b 2}} res] $res 625} {1 {can't set "arr(x)": variable isn't array}} 626 627test var-10.2 {can't nest arrays with array set} { 628 catch {unset arr} 629 list [catch {array set arr(x) {}} res] $res 630} {1 {can't set "arr(x)": variable isn't array}} 631 632test var-11.1 {array unset} { 633 catch {unset a} 634 array set a { 1,1 a 1,2 b 2,1 c 2,3 d } 635 array unset a 1,* 636 lsort -dict [array names a] 637} {2,1 2,3} 638test var-11.2 {array unset} { 639 catch {unset a} 640 array set a { 1,1 a 1,2 b } 641 array unset a 642 array exists a 643} 0 644test var-11.3 {array unset errors} { 645 catch {unset a} 646 array set a { 1,1 a 1,2 b } 647 list [catch {array unset a pattern too} msg] $msg 648} {1 {wrong # args: should be "array unset arrayName ?pattern?"}} 649 650test var-12.1 {TclFindCompiledLocals, {} array name} { 651 namespace eval n { 652 proc p {} { 653 variable {} 654 set (0) 0 655 set (1) 1 656 set n 2 657 set ($n) 2 658 set ($n,foo) 2 659 } 660 p 661 lsort -dictionary [array names {}] 662 } 663} {0 1 2 2,foo} 664 665test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} { 666 catch {unset t} 667 proc foo {var ind op} { 668 global t 669 set foo bar 670 } 671 namespace eval :: { 672 set t(1) 1 673 trace variable t(1) u foo 674 unset t 675 } 676 set x "If you see this, it worked" 677} "If you see this, it worked" 678 679test var-14.1 {array names syntax} -body { 680 array names foo bar baz snafu 681} -returnCodes 1 -match glob -result * 682 683test var-15.1 {segfault in [unset], [Bug 735335]} { 684 proc A { name } { 685 upvar $name var 686 set var $name 687 } 688 # 689 # Note that the variable name has to be 690 # unused previously for the segfault to 691 # be triggered. 692 # 693 namespace eval test A useSomeUnlikelyNameHere 694 namespace eval test unset useSomeUnlikelyNameHere 695} {} 696 697test var-16.1 {CallVarTraces: save/restore interp error state: 1038021} { 698 trace add variable errorCode write { ;#} 699 catch {error foo bar baz} 700 trace remove variable errorCode write { ;#} 701 set errorInfo 702} bar 703 704test var-17.1 {TclArraySet [Bug 1669489]} -setup { 705 unset -nocomplain ::a 706} -body { 707 namespace eval :: { 708 set elements {1 2 3 4} 709 trace add variable a write {string length $elements ;#} 710 array set a $elements 711 } 712} -cleanup { 713 unset -nocomplain ::a ::elements 714} -result {} 715 716catch {namespace delete ns} 717catch {unset arr} 718catch {unset v} 719 720catch {rename p ""} 721catch {namespace delete test_ns_var} 722catch {namespace delete test_ns_var2} 723catch {unset xx} 724catch {unset x} 725catch {unset y} 726catch {unset i} 727catch {unset a} 728catch {unset xxxxx} 729catch {unset aaaaa} 730 731# cleanup 732::tcltest::cleanupTests 733return 734