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