1# This file contains tests for the tclVar.c source file. Tests appear in the
2# same order as the C code that they test. The set of tests is currently
3# incomplete since it currently includes only new tests for code changed for
4# the addition of Tcl namespaces. Other variable-related tests appear in
5# several other test files including namespace.test, set.test, trace.test, and
6# upvar.test.
7#
8# Sourcing this file into Tcl runs the tests and generates output for errors.
9# No output means no errors were found.
10#
11# Copyright © 1997 Sun Microsystems, Inc.
12# Copyright © 1998-1999 Scriptics Corporation.
13#
14# See the file "license.terms" for information on usage and redistribution of
15# this file, and for a DISCLAIMER OF ALL WARRANTIES.
16
17if {"::tcltest" ni [namespace children]} {
18    package require tcltest 2.5
19    namespace import -force ::tcltest::*
20}
21
22::tcltest::loadTestedCommands
23catch [list package require -exact tcl::test [info patchlevel]]
24
25testConstraint testupvar [llength [info commands testupvar]]
26testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
27testConstraint testsetnoerr [llength [info commands testsetnoerr]]
28testConstraint memory [llength [info commands memory]]
29if {[testConstraint memory]} {
30    proc getbytes {} {
31        return [lindex [split [memory info] \n] 3 3]
32    }
33    proc leaktest {script {iterations 3}} {
34        set end [getbytes]
35        for {set i 0} {$i < $iterations} {incr i} {
36            uplevel 1 $script
37            set tmp $end
38            set end [getbytes]
39        }
40        return [expr {$end - $tmp}]
41    }
42}
43
44
45catch {rename p ""}
46catch {namespace delete test_ns_var}
47catch {unset xx}
48catch {unset x}
49catch {unset y}
50catch {unset i}
51catch {unset a}
52catch {unset arr}
53
54test var-1.1 {TclLookupVar, Array handling} -setup {
55    catch {unset a}
56} -body {
57    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd
58    set i 10
59    set arr(foo) 37
60    list [$x i] $i [$x arr(foo)] $arr(foo)
61} -result {11 11 38 38}
62set ::x "global value"
63namespace eval test_ns_var {
64    variable x "namespace value"
65}
66test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
67    namespace eval test_ns_var {
68        proc p {} {
69            global x  ;# specifies TCL_GLOBAL_ONLY to get global x
70            return $x
71        }
72    }
73    test_ns_var::p
74} {global value}
75test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} {
76    namespace eval test_ns_var {
77        proc q {} {
78            variable x  ;# specifies TCL_NAMESPACE_ONLY to get namespace x
79            return $x
80        }
81    }
82    test_ns_var::q
83} {namespace value}
84test var-1.4 {TclLookupVar, no active call frame implies global namespace var} {
85    set x
86} {global value}
87test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
88    namespace eval test_ns_var {set x}
89} {namespace value}
90test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
91    namespace eval test_ns_var {set ::x}
92} {global value}
93test var-1.7 {TclLookupVar, error finding namespace var} -body {
94    set a:::b
95} -returnCodes error -result {can't read "a:::b": no such variable}
96test var-1.8 {TclLookupVar, error finding namespace var} -body {
97    set ::foobarfoo
98} -returnCodes error -result {can't read "::foobarfoo": no such variable}
99test var-1.9 {TclLookupVar, create new namespace var} {
100    namespace eval test_ns_var {
101        set v hello
102    }
103} {hello}
104test var-1.10 {TclLookupVar, create new namespace var} -setup {
105    catch {unset y}
106} -body {
107    namespace eval test_ns_var {
108        set ::y 789
109    }
110    set y
111} -result {789}
112test var-1.11 {TclLookupVar, error creating new namespace var} -body {
113    namespace eval test_ns_var {
114        set ::test_ns_var::foo::bar 314159
115    }
116} -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}
117test var-1.12 {TclLookupVar, error creating new namespace var} -body {
118    namespace eval test_ns_var {
119        set ::test_ns_var::foo:: 1997
120    }
121} -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist}
122test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
123    catch {unset aNeWnAmEiNnS}
124    namespace eval test_ns_var {
125        namespace eval test_ns_var2::test_ns_var3 {
126            set aNeWnAmEiNnS 77777
127        }
128        # namespace which builds a name by traversing nsPtr chain to ::
129        namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
130    }
131} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
132test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
133    namespace eval test_ns_var {
134        set : 123
135        set v: 456
136        set x:y: 789
137        list [set :] [set v:] [set x:y:] \
138             ${:} ${v:} ${x:y:} \
139             [expr {":" in [info vars]}] \
140             [expr {"v:" in [info vars]}] \
141             [expr {"x:y:" in [info vars]}]
142    }
143} {123 456 789 123 456 789 1 1 1}
144test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
145    namespace eval test_ns_var {
146	variable foo 2
147    }
148    proc p {} {
149	variable ::test_ns_var::foo
150	lappend result [catch {set foo} msg] $msg
151        namespace delete ::test_ns_var
152	lappend result [catch {set foo 3} msg] $msg
153	lappend result [catch {set foo(3) 3} msg] $msg
154    }
155    p
156} {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}}
157test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
158    namespace eval test_ns_var {
159	variable result
160        namespace eval subns {
161	    variable foo 2
162	}
163	upvar 0 subns::foo foo
164	lappend result [catch {set foo} msg] $msg
165        namespace delete subns
166	lappend result [catch {set foo 3} msg] $msg
167	lappend result [catch {set foo(3) 3} msg] $msg
168        namespace delete [namespace current]
169	set result
170    }
171} {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}}
172test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
173    namespace eval test_ns_var {
174	variable result
175	proc p {} {
176	    array set x {1 2 3 4}
177	    upvar 0 x(1) foo
178	    lappend result [catch {set foo} msg] $msg
179	    unset x
180	    lappend result [catch {set foo 3} msg] $msg
181	}
182	set result [p]
183        namespace delete [namespace current]
184	set result
185    }
186} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
187test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
188    unset -nocomplain test_ns_var::x
189} -body {
190    namespace eval test_ns_var {
191	variable result {}
192	variable x
193	array set x {1 2 3 4}
194	upvar 0 x(1) foo
195	lappend result [catch {set foo} msg] $msg
196	unset x
197	lappend result [catch {set foo 3} msg] $msg
198        namespace delete [namespace current]
199	set result
200    }
201} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
202test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
203    [format set] thisvar(doesntexist)
204} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
205test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
206    proc p [list € ä] {info vars}
207} -body {
208    # test variable with non-ascii name is available (euro and a-uml chars here):
209    list \
210	[p 1 2] \
211	[apply [list [list € ä] {info vars}] 1 2] \
212	[apply [list [list [list € €] [list ä ä]] {info vars}]] \
213} -cleanup {
214    rename p {}
215} -result [lrepeat 3 [list € ä]]
216test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup {
217    proc p [list [list € v€] [list ä vä]] {list [set €] [set ä]}
218} -body {
219    # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here):
220    list \
221	[p] \
222	[apply [list [list € ä] {list [set €] [set ä]}] v€ vä] \
223	[apply [list [list [list € v€] [list ä vä]] {list [set €] [set ä]}]] \
224} -cleanup {
225    rename p {}
226} -result [lrepeat 3 [list v€ vä]]
227
228test var-2.1 {Tcl_LappendObjCmd, create var if new} {
229    catch {unset x}
230    lappend x 1 2
231} {1 2}
232
233test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
234    catch {unset x}
235} -body {
236    set x 1997
237    proc p {} {
238        global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
239        return $x
240    }
241    p
242} -result {1997}
243test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
244    namespace eval test_ns_var {
245        catch {unset v}
246        variable v 1998
247        proc p {} {
248            variable v  ;# TCL_NAMESPACE_ONLY specified for other var x
249            return $v
250        }
251        p
252    }
253} {1998}
254test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
255    catch {unset a}
256} -constraints testupvar -body {
257    set a 123321
258    proc p {} {
259	# create global xx linked to global a
260	testupvar 1 a {} xx global
261    }
262    list [p] $xx [set xx 789] $a
263} -result {{} 123321 789 789}
264test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
265    catch {unset a}
266} -constraints testupvar -body {
267    set a 456
268    namespace eval test_ns_var {
269	catch {unset ::test_ns_var::vv}
270	proc p {} {
271	    # create namespace var vv linked to global a
272	    testupvar 1 a {} vv namespace
273	}
274	p
275    }
276    list $test_ns_var::vv [set test_ns_var::vv 123] $a
277} -result {456 123 123}
278test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
279    catch {unset aaaaa}
280    catch {unset xxxxx}
281} -body {
282    set aaaaa 77777
283    upvar #0 aaaaa xxxxx
284    list [set xxxxx] [set aaaaa]
285} -result {77777 77777}
286test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup {
287    catch {unset a}
288} -body {
289    set a 121212
290    namespace eval test_ns_var {
291        upvar ::a vvv
292        set vvv
293    }
294} -result {121212}
295test var-3.7 {MakeUpvar, my var has ::s} -setup {
296    catch {unset a}
297} -body {
298    set a 789789
299    upvar #0 a test_ns_var::lnk
300    namespace eval test_ns_var {
301        set lnk
302    }
303} -result {789789}
304test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
305    upvar #0 aaaaa xxxxx
306    catch {unset aaaaa}
307    catch {unset xxxxx}
308} -body {
309    set aaaaa 456654
310    set xxxxx hello
311    upvar #0 aaaaa xxxxx
312    set xxxxx
313} -result {hello}
314test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
315    catch {unset aaaaa}
316} -returnCodes error -body {
317    set aaaaa 789789
318    upvar #0 aaaaa test_ns_fred::lnk
319} -cleanup {
320    unset ::aaaaa
321} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
322test var-3.10 {MakeUpvar, between namespaces} -body {
323    namespace eval {} {
324	variable bar 0
325	namespace eval foo upvar bar bar
326	set foo::bar 1
327	list $bar $foo::bar
328    }
329} -result {1 1}
330test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
331    catch {unset aaaaa}
332} -returnCodes error -body {
333    set aaaaa 789789
334    upvar #0 aaaaa foo(bar)
335} -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}
336
337test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
338    catch {unset a}
339    set a 123
340    testgetvarfullname a global
341} ::a
342test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
343    namespace eval test_ns_var {
344	variable george
345	testgetvarfullname george namespace
346    }
347} ::test_ns_var::george
348test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup {
349    catch {unset a}
350} -constraints testgetvarfullname -body {
351    set a(1) foo
352    testgetvarfullname a(1) global
353} -returnCodes error -result {unknown variable "a(1)"}
354
355test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {
356    catch {unset a}
357} -body {
358    set a bar
359    namespace which -variable a
360} -result {::a}
361test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
362    namespace eval test_ns_var {
363        variable martha
364        namespace which -variable martha
365    }
366} {::test_ns_var::martha}
367test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
368    namespace eval test_ns_var {variable martha}
369} -body {
370    namespace which -variable test_ns_var::martha
371} -result {::test_ns_var::martha}
372
373test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
374    namespace eval test_ns_var {
375        variable boeing 777
376    }
377    apply {{} {
378        global ::test_ns_var::boeing
379        set boeing
380    }}
381} {777}
382test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
383    namespace eval test_ns_var {
384        namespace eval test_ns_nested {
385            variable java java
386        }
387        proc p {} {
388            global ::test_ns_var::test_ns_nested::java
389            set java
390        }
391    }
392    test_ns_var::p
393} {java}
394test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
395    namespace eval ::test_ns_var::test_ns_nested {}
396    set ::test_ns_var::test_ns_nested:: 24
397    apply {{} {
398        global ::test_ns_var::test_ns_nested::
399        set {}
400    }}
401} {24}
402test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
403    # Test for Tcl Bug 480176
404    set :v broken
405    proc p {} {
406	global :v
407	set :v fixed
408    }
409    p
410    set :v
411} {fixed}
412test var-6.5 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
413    global
414} {}
415test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
416    proc p {} {
417	global
418    }
419    p
420} {}
421
422test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup {
423    catch {namespace delete test_ns_var}
424} -body {
425    namespace eval test_ns_var {
426        variable one 1
427    }
428    list [info vars test_ns_var::*] [set test_ns_var::one]
429} -result {::test_ns_var::one 1}
430test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
431    set two 2222222
432    namespace eval test_ns_var {
433        variable two
434    }
435    list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
436} {0 1 {can't read "test_ns_var::two": no such variable}}
437test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
438    catch {namespace delete test_ns_var}
439    namespace eval test_ns_var {variable one 1}
440} -body {
441    namespace eval test_ns_var {
442        variable two 2
443    }
444    list [lsort [info vars test_ns_var::*]] \
445         [namespace eval test_ns_var {set two}]
446} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
447test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
448    catch {namespace delete test_ns_var}
449    namespace eval test_ns_var {variable one 1; variable two 2}
450} -body {
451    namespace eval test_ns_var {
452        variable three 3 four 4
453    }
454    list [lsort [info vars test_ns_var::*]] \
455         [namespace eval test_ns_var {expr {$three+$four}}]
456} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
457test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
458    catch {unset a}
459    catch {unset five}
460    catch {unset six}
461} -body {
462    set a ""
463    set five 555
464    set six  666
465    namespace eval test_ns_var {
466        variable five 5 six
467        lappend a $five
468    }
469    lappend a $test_ns_var::five \
470        [set test_ns_var::six 6] [set test_ns_var::six] $six
471} -cleanup {
472    catch {unset five}
473    catch {unset six}
474} -result {5 5 6 6 666}
475test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup {
476    catch {unset newvar}
477} -body {
478    namespace eval test_ns_var {
479        variable ::newvar cheers!
480    }
481    return $newvar
482} -cleanup {
483    catch {unset newvar}
484} -result {cheers!}
485test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
486    namespace eval test_ns_var {
487        variable sev:::en 7
488    }
489} -result {can't define "sev:::en": parent namespace doesn't exist}
490test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
491    set a ""
492    namespace eval test_ns_var {
493        variable eight 8
494        lappend a $eight
495        variable eight
496        lappend a $eight
497    }
498    set a
499} {8 8}
500test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
501    catch {namespace delete test_ns_var2}
502} -body {
503    set a ""
504    namespace eval test_ns_var2 {
505        variable x 123
506        variable y
507        variable z
508    }
509    lappend a [lsort [info vars test_ns_var2::*]]
510    lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
511        [info exists test_ns_var2::z]
512    lappend a [list [catch {set test_ns_var2::y} msg] $msg]
513    lappend a [lsort [info vars test_ns_var2::*]]
514    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
515    lappend a [set test_ns_var2::y hello]
516    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
517    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
518    lappend a [lsort [info vars test_ns_var2::*]]
519    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
520    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
521    lappend a [namespace delete test_ns_var2]
522} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
523	{1 {can't read "test_ns_var2::y": no such variable}}\
524	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
525	hello 1 0\
526	{0 {}}\
527	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
528	{1 {can't unset "test_ns_var2::z": no such variable}}\
529	{}]
530test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
531    namespace eval test_ns_var { variable eight 8 }
532} -body {
533    namespace eval test_ns_var {
534        proc p {} {
535            variable eight
536            list [set eight] [info vars]
537        }
538        p
539    }
540} -result {8 eight}
541test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
542    namespace eval test_ns_var { variable eight 8 }
543} -body {
544    proc p {} {   ;# note this proc is at global :: scope
545        variable test_ns_var::eight
546        list [set eight] [info vars]
547    }
548    p
549} -result {8 eight}
550test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
551    namespace eval test_ns_var {
552        variable {} {My name is empty}
553    }
554    proc p {} {   ;# note this proc is at global :: scope
555        variable test_ns_var::
556        list [set {}] [info vars]
557    }
558    p
559} {{My name is empty} {{}}}
560test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
561    namespace eval test_ns_var {
562        variable : {My name is ":"}
563	proc p {} {
564	    variable :
565	    list [set :] [info vars]
566	}
567	p
568    }
569} {{My name is ":"} :}
570test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
571    namespace eval test_ns_var { variable arrayvar(1) }
572} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
573test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
574    namespace eval test_ns_var {
575	variable arrayvar
576	set arrayvar(1) x
577	variable arrayvar(1) y
578    }
579} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
580test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
581    variable
582} {}
583test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
584    namespace eval test_ns_var {
585	variable
586    }
587} {}
588
589test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup {
590    catch {namespace delete test_ns_var}
591    catch {unset a}
592} -body {
593    namespace eval test_ns_var {
594        variable v 123
595        variable info ""
596        proc traceUnset {name1 name2 op} {
597            variable info
598            set info [concat $info [list $name1 $name2 $op]]
599        }
600        trace var v u [namespace code traceUnset]
601    }
602    list [unset test_ns_var::v] $test_ns_var::info
603} -result {{} {test_ns_var::v {} u}}
604test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
605    catch {namespace delete test_ns_var}
606    catch {unset a}
607} -body {
608    set info ""
609    namespace eval test_ns_var {
610        variable v 123 1
611        trace var v u ::traceUnset
612    }
613    proc traceUnset {name1 name2 op} {
614	set ::info [concat $::info [list $name1 $name2 $op]]
615    }
616    list [namespace delete test_ns_var] $::info
617} -result {{} {::test_ns_var::v {} u}}
618
619test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
620    proc ::t {a i o} {
621	set $a 321
622    }
623} -body {
624    leaktest {
625	namespace eval n {
626	    variable v 123
627	    trace variable v u ::t
628	}
629	namespace delete n
630    }
631} -cleanup {
632    rename ::t {}
633} -result 0
634
635test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
636    catch {unset u}
637    catch {unset v}
638} -constraints testsetnoerr -body {
639    list \
640	[set u a; testsetnoerr u] \
641	[testsetnoerr v b] \
642	[testseterr u] \
643	[unset v; testseterr v b]
644} -result [list {before get a} {before set b} {before get a} {before set b}]
645test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup {
646    catch {namespace delete ns}
647} -constraints testsetnoerr -body {
648    namespace eval ns {variable u a; variable v}
649    list \
650	[testsetnoerr ns::u] \
651	[testsetnoerr ns::v b] \
652	[testseterr ns::u] \
653	[unset ns::v; testseterr ns::v b]
654} -result [list {before get a} {before set b} {before get a} {before set b}]
655test var-9.3 {behaviour of TclGetVar no variable} -setup {
656    catch {unset u}
657} -constraints testsetnoerr -body {
658    list \
659	[catch {testsetnoerr u} res] $res \
660	[catch {testseterr u} res] $res
661} -result {1 {before get} 1 {can't read "u": no such variable}}
662test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
663    catch {namespace delete ns}
664} -constraints testsetnoerr -body {
665    namespace eval ns {}
666    list \
667	[catch {testsetnoerr ns::w} res] $res \
668	[catch {testseterr ns::w} res] $res
669} -result {1 {before get} 1 {can't read "ns::w": no such variable}}
670test var-9.5 {behaviour of TclGetVar no namespace} -setup {
671    catch {namespace delete ns}
672} -constraints testsetnoerr -body {
673    list \
674	[catch {testsetnoerr ns::u} res] $res \
675	[catch {testseterr ns::v} res] $res
676} -result {1 {before get} 1 {can't read "ns::v": no such variable}}
677test var-9.6 {behaviour of TclSetVar no namespace} -setup {
678    catch {namespace delete ns}
679} -constraints testsetnoerr -body {
680    list \
681	[catch {testsetnoerr ns::v 1} res] $res \
682	[catch {testseterr ns::v 1} res] $res
683} -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
684test var-9.7 {behaviour of TclGetVar array variable} -setup {
685    catch {unset arr}
686} -constraints testsetnoerr -body {
687    set arr(1) 1
688    list \
689	[catch {testsetnoerr arr} res] $res \
690	[catch {testseterr arr} res] $res
691} -result {1 {before get} 1 {can't read "arr": variable is array}}
692test var-9.8 {behaviour of TclSetVar array variable} -setup {
693    catch {unset arr}
694} -constraints testsetnoerr -body {
695    set arr(1) 1
696    list \
697	[catch {testsetnoerr arr 2} res] $res \
698	[catch {testseterr arr 2} res] $res
699} -result {1 {before set} 1 {can't set "arr": variable is array}}
700test var-9.9 {behaviour of TclGetVar read trace success} -setup {
701    catch {unset u}
702    catch {unset v}
703} -constraints testsetnoerr -body {
704    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
705    set u 10
706    trace var u r [list resetvar 1]
707    trace var v r [list resetvar 2]
708    list \
709	[testsetnoerr u] \
710	[testseterr v]
711} -result {{before get 1} {before get 2}}
712test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
713    proc writeonly args {error "write-only"}
714    set v 456
715    trace var v r writeonly
716    list \
717	[catch {testsetnoerr v} msg] $msg \
718	[catch {testseterr v} msg] $msg
719} {1 {before get} 1 {can't read "v": write-only}}
720test var-9.11 {behaviour of TclSetVar write trace success} -setup {
721    catch {unset u}
722    catch {unset v}
723} -constraints testsetnoerr -body {
724    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
725    set v 1
726    trace var v w doubleval
727    trace var u w doubleval
728    list \
729	[testsetnoerr u 2] \
730	[testseterr v 3]
731} -result {{before set 4} {before set 6}}
732test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
733    proc readonly args {error "read-only"}
734    set v 456
735    trace var v w readonly
736    list \
737	[catch {testsetnoerr v 2} msg] $msg $v \
738	[catch {testseterr v 3} msg] $msg $v
739} {1 {before set} 2 1 {can't set "v": read-only} 3}
740
741test var-10.1 {can't nest arrays with array set} -setup {
742   catch {unset arr}
743} -returnCodes error -body {
744   array set arr(x) {a 1 b 2}
745} -result {can't set "arr(x)": variable isn't array}
746test var-10.2 {can't nest arrays with array set} -setup {
747   catch {unset arr}
748} -returnCodes error -body {
749   array set arr(x) {}
750} -result {can't set "arr(x)": variable isn't array}
751
752test var-11.1 {array unset} -setup {
753    catch {unset a}
754} -body {
755    array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
756    array unset a 1,*
757    lsort -dict [array names a]
758} -result {2,1 2,3}
759test var-11.2 {array unset} -setup {
760    catch {unset a}
761} -body {
762    array set a { 1,1 a 1,2 b }
763    array unset a
764    array exists a
765} -result 0
766test var-11.3 {array unset errors} -setup {
767    catch {unset a}
768} -returnCodes error -body {
769    array set a { 1,1 a 1,2 b }
770    array unset a pattern too
771} -result {wrong # args: should be "array unset arrayName ?pattern?"}
772
773test var-12.1 {TclFindCompiledLocals, {} array name} {
774    namespace eval n {
775	proc p {} {
776	    variable {}
777	    set (0) 0
778	    set (1) 1
779	    set n 2
780	    set ($n) 2
781	    set ($n,foo) 2
782	}
783	p
784	lsort -dictionary [array names {}]
785    }
786} {0 1 2 2,foo}
787
788test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
789    catch {unset t}
790} -body {
791    proc foo {var ind op} {
792	global t
793	set foo bar
794    }
795    namespace eval :: {
796	set t(1) 1
797	trace variable t(1) u foo
798	unset t
799    }
800    set x "If you see this, it worked"
801} -result "If you see this, it worked"
802test var-13.2 {unset array with search, bug 46a2410650} -body {
803    apply {{} {
804	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
805	set s [array startsearch a]
806	unset a([array nextelement a $s])
807	array nextelement a $s
808    }}
809} -returnCodes error -result {couldn't find search "s-1-a"}
810test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
811    apply {{} {
812	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
813	set s [array startsearch a]
814        unset a(ff)
815	array nextelement a $s
816    }}
817} -returnCodes error -result {couldn't find search "s-1-a"}
818
819test var-14.1 {array names syntax} -body {
820    array names foo bar baz snafu
821} -returnCodes 1 -match glob -result *
822test var-14.2 {array names -glob} -body {
823    array names tcl_platform -glob os
824} -result os
825
826test var-15.1 {segfault in [unset], [Bug 735335]} {
827    proc A { name } {
828	upvar $name var
829	set var $name
830    }
831    #
832    # Note that the variable name has to be
833    # unused previously for the segfault to
834    # be triggered.
835    #
836    namespace eval test A useSomeUnlikelyNameHere
837    namespace eval test unset useSomeUnlikelyNameHere
838} {}
839test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
840    apply {{} {unset foo [return ok]}}
841} ok
842
843test var-16.1 {CallVarTraces: save/restore interp error state} {
844    trace add variable ::errorCode write " ;#"
845    catch {error foo bar baz}
846    trace remove variable ::errorCode write " ;#"
847    set ::errorInfo
848} bar
849
850test var-17.1 {TclArraySet [Bug 1669489]} -setup {
851    unset -nocomplain ::a
852} -body {
853    namespace eval :: {
854	set elements {1 2 3 4}
855	trace add variable a write "string length \$elements ;#"
856	array set a $elements
857    }
858} -cleanup {
859    unset -nocomplain ::a ::elements
860} -result {}
861test var-17.2 {TclArraySet Dict shortcut only on pure value} -setup {
862    unset -nocomplain a d
863    set d {p 1 p 2}
864    dict get $d p
865    set foo 0
866} -body {
867    trace add variable a write "[list incr [namespace which -variable foo]];#"
868    array set a $d
869    set foo
870} -cleanup {
871    unset -nocomplain a d foo
872} -result 2
873
874test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
875    set already 0
876    unset -nocomplain x
877} -body {
878    array set x {e 1 i 1}
879    trace add variable x unset {apply {args {
880	global already x
881	if {!$already} {
882	    set already 1
883	    unset x(i)
884	}
885    }}}
886    # The next command would crash reliably with memory debugging prior to the
887    # bug fix.
888    array unset x *
889    array size x
890} -cleanup {
891    unset x already
892} -result 0
893
894test var-19.1 {crash when freeing locals hashtable: Bug 3037525} {
895    proc foo {} { catch {upvar 0 dummy \$index} }
896    foo ; # This crashes without the fix for the bug
897    rename foo {}
898} {}
899
900test var-20.1 {array set compilation correctness: Bug 3603163} -setup {
901    unset -nocomplain x
902} -body {
903    apply {{} {
904	global x
905	array set x {a 1}
906    }}
907    array size x
908} -result 1
909test var-20.2 {array set compilation correctness: Bug 3603163} -setup {
910    unset -nocomplain x
911} -body {
912    apply {{} {
913	global x
914	array set x {}
915    }}
916    array size x
917} -result 0
918test var-20.3 {array set compilation correctness: Bug 3603163} -setup {
919    unset -nocomplain x
920} -body {
921    apply {{} {
922	array set ::x {a 1}
923    }}
924    array size x
925} -result 1
926test var-20.4 {array set compilation correctness: Bug 3603163} -setup {
927    unset -nocomplain x
928} -body {
929    apply {{} {
930	array set ::x {}
931    }}
932    array size x
933} -result 0
934test var-20.5 {array set compilation correctness: Bug 3603163} -setup {
935    unset -nocomplain x
936} -body {
937    apply {{} {
938	global x
939	eval {array set x {a 1}}
940    }}
941    array size x
942} -result 1
943test var-20.6 {array set compilation correctness: Bug 3603163} -setup {
944    unset -nocomplain x
945} -body {
946    apply {{} {
947	global x
948	eval {array set x {}}
949    }}
950    array size x
951} -result 0
952test var-20.7 {array set compilation correctness: Bug 3603163} -setup {
953    unset -nocomplain x
954} -body {
955    apply {{} {
956	eval {array set ::x {a 1}}
957    }}
958    array size x
959} -result 1
960test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
961    unset -nocomplain x
962} -body {
963    apply {{} {
964	eval {array set ::x {}}
965    }}
966    array size x
967} -result 0
968test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup {
969    variable foo
970    variable lambda
971    unset -nocomplain lambda foo
972    array set foo {}
973    lappend lambda {}
974    lappend lambda [list array set [namespace which -variable foo] {a 1}]
975} -body {
976    after 0 [list apply $lambda]
977    vwait [namespace which -variable foo]
978} -cleanup {
979    unset -nocomplain lambda foo
980} -result {}
981test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
982    apply {{} {set name foo(bar); array set $name {a 1}}}
983} -returnCodes error -match glob -result *
984test var-20.11 {array set don't compile bad initializer} -setup {
985    unset -nocomplain foo
986    trace add variable foo array {set foo(bar) baz;#}
987} -body {
988    catch {array set foo bad}
989    set foo(bar)
990} -cleanup {
991    unset -nocomplain foo
992} -result baz
993test var-20.12 {array set don't compile bad initializer} -setup {
994    unset -nocomplain ::foo
995    trace add variable ::foo array {set ::foo(bar) baz;#}
996} -body {
997    catch {apply {{} {
998	set value bad
999	array set ::foo $value
1000
1001    }}}
1002    set ::foo(bar)
1003} -cleanup {
1004    unset -nocomplain ::foo
1005} -result baz
1006
1007test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
1008    proc linenumber {} {dict get [info frame -1] line}
1009} -body {
1010    apply {n {
1011	set foo bar
1012        unset foo {*}{
1013        } [return [incr n -[linenumber]]]
1014    }} [linenumber]
1015} -cleanup {
1016    rename linenumber {}
1017} -result 1
1018
1019test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
1020    proc doit k {
1021	variable A
1022	set A($k) {}
1023	foreach n [array names A] {
1024	    if {$n <= $k-1} {
1025		unset A($n)
1026	    }
1027	}
1028    }
1029} -constraints memory -body {
1030    set end [getbytes]
1031    for {set i 0} {$i < 5} {incr i} {
1032	doit $i
1033        set tmp $end
1034        set end [getbytes]
1035    }
1036    set leakedBytes [expr {$end - $tmp}]
1037} -cleanup {
1038    array unset A
1039    rename doit {}
1040} -result 0
1041test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
1042    proc doit {} {
1043	interp create child
1044	child eval {
1045	    proc doit script {
1046		eval $script
1047		set foo bar
1048	    }
1049	    doit {foreach foo baz {}}
1050	}
1051	interp delete child
1052    }
1053} -constraints memory -body {
1054    set end [getbytes]
1055    for {set i 0} {$i < 5} {incr i} {
1056	doit
1057        set tmp $end
1058        set end [getbytes]
1059    }
1060    set leakedBytes [expr {$end - $tmp}]
1061} -cleanup {
1062    array unset A
1063    rename doit {}
1064} -result 0
1065test var-22.2 {leak in parsedVarName} -constraints memory -body {
1066    set i 0
1067    leaktest {lappend x($i)}
1068} -cleanup {
1069    unset -nocomplain i x
1070} -result 0
1071
1072unset -nocomplain a k v
1073test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
1074    array for {k v} c d e {}
1075} -result {wrong # args: should be "array for {key value} arrayName script"}
1076test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
1077    array for {k v} {}
1078} -result {wrong # args: should be "array for {key value} arrayName script"}
1079test var-23.3 {array command, for loop, too many list args} -setup {
1080    unset -nocomplain a
1081} -returnCodes error -body {
1082    array for {k v w} a {}
1083} -result {must have two variable names}
1084test var-23.4 {array command, for loop, not enough list args} -setup {
1085    unset -nocomplain a
1086} -returnCodes error -body {
1087    array for {k} a {}
1088} -result {must have two variable names}
1089test var-23.5 {array command, for loop, no array} -setup {
1090    unset -nocomplain a
1091} -returnCodes error -body {
1092    array for {k v} a {}
1093} -result {"a" isn't an array}
1094test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
1095    catch {rename p ""}
1096} -returnCodes error -body {
1097    apply {{x} {
1098        if {$x==1} {
1099            return [array for {k v} a {}]
1100        }
1101        set a(x) 123
1102    }} 1
1103} -result {"a" isn't an array}
1104test var-23.7 {array enumeration} -setup {
1105    unset -nocomplain a
1106    set reslist [list]
1107} -body {
1108    array set a {a 1 b 2 c 3}
1109    array for {k v} a {
1110	lappend reslist $k $v
1111    }
1112    lsort -stride 2 -index 0 $reslist
1113} -cleanup {
1114    unset -nocomplain a
1115    unset -nocomplain reslist
1116} -result {a 1 b 2 c 3}
1117test var-23.9 {array enumeration, nested} -setup {
1118    unset -nocomplain a
1119    set reslist [list]
1120} -body {
1121    array set a {a 1 b 2 c 3}
1122    array for {k1 v1} a {
1123	lappend reslist $k1 $v1
1124	set r2 {}
1125	array for {k2 v2} a {
1126	    lappend r2 $k2 $v2
1127	}
1128	lappend reslist [lsort -stride 2 -index 0 $r2]
1129    }
1130    # there is no guarantee in which order the array contents will be
1131    # returned.
1132    lsort -stride 3 -index 0 $reslist
1133} -cleanup {
1134    unset -nocomplain a
1135    unset -nocomplain reslist
1136} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
1137test var-23.10 {array enumeration, delete key} -match glob -setup {
1138    unset -nocomplain a
1139    set reslist [list]
1140} -body {
1141    set retval {}
1142    try {
1143      array set a {a 1 b 2 c 3 d 4}
1144      array for {k v} a {
1145  	lappend reslist $k $v
1146          if { $k eq "a" } {
1147            unset a(c)
1148          }
1149      }
1150      lsort -stride 2 -index 0 $reslist
1151    } on error {err res} {
1152      set retval [dict get $res -errorinfo]
1153    }
1154    set retval
1155} -cleanup {
1156    unset -nocomplain a
1157    unset -nocomplain reslist
1158    unset -nocomplain retval
1159} -result {array changed during iteration*}
1160test var-23.11 {array enumeration, insert key} -match glob -setup {
1161    unset -nocomplain a
1162    set reslist [list]
1163} -body {
1164    set retval {}
1165    try {
1166      array set a {a 1 b 2 c 3 d 4}
1167      array for {k v} a {
1168  	lappend reslist $k $v
1169          if { $k eq "a" } {
1170            set a(e) 5
1171          }
1172      }
1173      lsort -stride 2 -index 0 $reslist
1174    } on error {err res} {
1175      set retval [dict get $res -errorinfo]
1176    }
1177} -cleanup {
1178    unset -nocomplain a
1179    unset -nocomplain reslist
1180} -result {array changed during iteration*}
1181test var-23.12 {array enumeration, change value} -setup {
1182    unset -nocomplain a
1183    set reslist [list]
1184} -body {
1185    array set a {a 1 b 2 c 3}
1186    array for {k v} a {
1187	lappend reslist $k $v
1188        if { $k eq "a" } {
1189          set a(c) 9
1190        }
1191    }
1192    lsort -stride 2 -index 0 $reslist
1193} -cleanup {
1194    unset -nocomplain a
1195    unset -nocomplain reslist
1196} -result {a 1 b 2 c 9}
1197test var-23.13 {array enumeration, number of traces} -setup {
1198    set ::countarrayfor 0
1199    proc ::tracearrayfor { args } {
1200      incr ::countarrayfor
1201    }
1202    unset -nocomplain ::a
1203    set reslist [list]
1204} -body {
1205    array set ::a {a 1 b 2 c 3}
1206    foreach {k} [array names a] {
1207      trace add variable ::a($k) read ::tracearrayfor
1208    }
1209    array for {k v} ::a {
1210	lappend reslist $k $v
1211    }
1212    set ::countarrayfor
1213} -cleanup {
1214    unset -nocomplain ::countarrayfor
1215    unset -nocomplain ::a
1216    unset -nocomplain reslist
1217} -result 3
1218test var-23.14 {array for, shared arguments} -setup {
1219    set vn {k v}
1220    unset -nocomplain $vn
1221} -body {
1222    array set $vn {a 1 b 2 c 3}
1223    array for $vn $vn {}
1224} -cleanup {
1225    unset -nocomplain $vn vn
1226} -result {}
1227
1228test var-24.1 {array default set and get: interpreted} -setup {
1229    unset -nocomplain ary
1230} -body {
1231    array set ary {a 3}
1232    array default set ary 7
1233    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
1234	[array default get ary]
1235} -cleanup {
1236    unset -nocomplain ary
1237} -result {3 7 1 0 7}
1238test var-24.2 {array default set and get: compiled} {
1239    apply {{} {
1240	array set ary {a 3}
1241	array default set ary 7
1242	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
1243	    [array default get ary]
1244    }}
1245} {3 7 1 0 7}
1246test var-24.3 {array default unset: interpreted} -setup {
1247    unset -nocomplain ary
1248} -body {
1249    array set ary {a 3}
1250    array default set ary 7
1251    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
1252} -cleanup {
1253    unset -nocomplain ary
1254} -result {3 7 {} 3 1}
1255test var-24.4 {array default unset: compiled} {
1256    apply {{} {
1257	array set ary {a 3}
1258	array default set ary 7
1259	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
1260	    [catch {set ary(b)}]
1261    }}
1262} {3 7 {} 3 1}
1263test var-24.5 {array default exists: interpreted} -setup {
1264    unset -nocomplain ary result
1265    set result {}
1266} -body {
1267    array set ary {a 3}
1268    lappend result [info exists ary],[array exists ary],[array default exists ary]
1269    array default set ary 7
1270    lappend result [info exists ary],[array exists ary],[array default exists ary]
1271    array default unset ary
1272    lappend result [info exists ary],[array exists ary],[array default exists ary]
1273    unset ary
1274    lappend result [info exists ary],[array exists ary],[array default exists ary]
1275    array default set ary 11
1276    lappend result [info exists ary],[array exists ary],[array default exists ary]
1277} -cleanup {
1278    unset -nocomplain ary result
1279} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
1280test var-24.6 {array default exists: compiled} {
1281    apply {{} {
1282	array set ary {a 3}
1283	lappend result [info exists ary],[array exists ary],[array default exists ary]
1284	array default set ary 7
1285	lappend result [info exists ary],[array exists ary],[array default exists ary]
1286	array default unset ary
1287	lappend result [info exists ary],[array exists ary],[array default exists ary]
1288	unset ary
1289	lappend result [info exists ary],[array exists ary],[array default exists ary]
1290	array default set ary 11
1291	lappend result [info exists ary],[array exists ary],[array default exists ary]
1292    }}
1293} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
1294test var-24.7 {array default and append: interpreted} -setup {
1295    unset -nocomplain ary result
1296    set result {}
1297} -body {
1298    array default set ary grill
1299    lappend result [array size ary] [info exist ary(x)]
1300    append ary(x) abc
1301    lappend result [array size ary] $ary(x)
1302    array default unset ary
1303    append ary(x) def
1304    append ary(y) ghi
1305    lappend result [array size ary] $ary(x) $ary(y)
1306} -cleanup {
1307    unset -nocomplain ary result
1308} -result {0 0 1 grillabc 2 grillabcdef ghi}
1309test var-24.8 {array default and append: compiled} {
1310    apply {{} {
1311	array default set ary grill
1312	lappend result [array size ary] [info exist ary(x)]
1313	append ary(x) abc
1314	lappend result [array size ary] $ary(x)
1315	array default unset ary
1316	append ary(x) def
1317	append ary(y) ghi
1318	lappend result [array size ary] $ary(x) $ary(y)
1319    }}
1320} {0 0 1 grillabc 2 grillabcdef ghi}
1321test var-24.9 {array default and lappend: interpreted} -setup {
1322    unset -nocomplain ary result
1323    set result {}
1324} -body {
1325    array default set ary grill
1326    lappend result [array size ary] [info exist ary(x)]
1327    lappend ary(x) abc
1328    lappend result [array size ary] $ary(x)
1329    array default unset ary
1330    lappend ary(x) def
1331    lappend ary(y) ghi
1332    lappend result [array size ary] $ary(x) $ary(y)
1333} -cleanup {
1334    unset -nocomplain ary result
1335} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
1336test var-24.10 {array default and lappend: compiled} {
1337    apply {{} {
1338	array default set ary grill
1339	lappend result [array size ary] [info exist ary(x)]
1340	lappend ary(x) abc
1341	lappend result [array size ary] $ary(x)
1342	array default unset ary
1343	lappend ary(x) def
1344	lappend ary(y) ghi
1345	lappend result [array size ary] $ary(x) $ary(y)
1346    }}
1347} {0 0 1 {grill abc} 2 {grill abc def} ghi}
1348test var-24.11 {array default and incr: interpreted} -setup {
1349    unset -nocomplain ary result
1350    set result {}
1351} -body {
1352    array default set ary 7
1353    lappend result [array size ary] [info exist ary(x)]
1354    incr ary(x) 11
1355    lappend result [array size ary] $ary(x)
1356    array default unset ary
1357    incr ary(x)
1358    incr ary(y)
1359    lappend result [array size ary] $ary(x) $ary(y)
1360} -cleanup {
1361    unset -nocomplain ary result
1362} -result {0 0 1 18 2 19 1}
1363test var-24.12 {array default and incr: compiled} {
1364    apply {{} {
1365	array default set ary 7
1366	lappend result [array size ary] [info exist ary(x)]
1367	incr ary(x) 11
1368	lappend result [array size ary] $ary(x)
1369	array default unset ary
1370	incr ary(x)
1371	incr ary(y)
1372	lappend result [array size ary] $ary(x) $ary(y)
1373    }}
1374} {0 0 1 18 2 19 1}
1375test var-24.13 {array default and dict: interpreted} -setup {
1376    unset -nocomplain ary x y z
1377} -body {
1378    array default set ary {x y}
1379    dict lappend ary(p) x z
1380    dict update ary(q) x y {
1381	set y z
1382    }
1383    dict with ary(r) {
1384	set x 123
1385    }
1386    lsort -stride 2 -index 0 [array get ary]
1387} -cleanup {
1388    unset -nocomplain ary x y z
1389} -result {p {x {y z}} q {x z} r {x 123}}
1390test var-24.14 {array default and dict: compiled} {
1391    lsort -stride 2 -index 0 [apply {{} {
1392	array default set ary {x y}
1393	dict lappend ary(p) x z
1394	dict update ary(q) x y {
1395	    set y z
1396	}
1397	dict with ary(r) {
1398	    set x 123
1399	}
1400	array get ary
1401    }}]
1402} {p {x {y z}} q {x z} r {x 123}}
1403test var-24.15 {array default set and get: two-level} {
1404    apply {{} {
1405	array set ary {a 3}
1406	array default set ary 7
1407	apply {{} {
1408	    upvar 1 ary ary ary(c) c
1409	    lappend result $ary(a) $ary(b) $c
1410	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
1411	    lappend result [array default get ary]
1412	}}
1413    }}
1414} {3 7 7 1 0 0 7}
1415test var-24.16 {array default set: errors} -setup {
1416    unset -nocomplain ary
1417} -body {
1418    set ary not-an-array
1419    array default set ary 7
1420} -returnCodes error -cleanup {
1421    unset -nocomplain ary
1422} -result {can't array default set "ary": variable isn't array}
1423test var-24.17 {array default set: errors} -setup {
1424    unset -nocomplain ary
1425} -body {
1426    array default set ary
1427} -returnCodes error -cleanup {
1428    unset -nocomplain ary
1429} -result * -match glob
1430test var-24.18 {array default set: errors} -setup {
1431    unset -nocomplain ary
1432} -body {
1433    array default set ary x y
1434} -returnCodes error -cleanup {
1435    unset -nocomplain ary
1436} -result * -match glob
1437test var-24.19 {array default get: errors} -setup {
1438    unset -nocomplain ary
1439} -body {
1440    set ary not-an-array
1441    array default get ary
1442} -returnCodes error -cleanup {
1443    unset -nocomplain ary
1444} -result {"ary" isn't an array}
1445test var-24.20 {array default get: errors} -setup {
1446    unset -nocomplain ary
1447} -body {
1448    array default get ary x y
1449} -returnCodes error -cleanup {
1450    unset -nocomplain ary
1451} -result * -match glob
1452test var-24.21 {array default exists: errors} -setup {
1453    unset -nocomplain ary
1454} -body {
1455    set ary not-an-array
1456    array default exists ary
1457} -returnCodes error -cleanup {
1458    unset -nocomplain ary
1459} -result {"ary" isn't an array}
1460test var-24.22 {array default exists: errors} -setup {
1461    unset -nocomplain ary
1462} -body {
1463    array default exists ary x
1464} -returnCodes error -cleanup {
1465    unset -nocomplain ary
1466} -result * -match glob
1467test var-24.23 {array default unset: errors} -setup {
1468    unset -nocomplain ary
1469} -body {
1470    set ary not-an-array
1471    array default unset ary
1472} -returnCodes error -cleanup {
1473    unset -nocomplain ary
1474} -result {"ary" isn't an array}
1475test var-24.24 {array default unset: errors} -setup {
1476    unset -nocomplain ary
1477} -body {
1478    array default unset ary x
1479} -returnCodes error -cleanup {
1480    unset -nocomplain ary
1481} -result * -match glob
1482
1483catch {namespace delete ns}
1484catch {unset arr}
1485catch {unset v}
1486
1487catch {rename getbytes ""}
1488catch {rename p ""}
1489catch {namespace delete test_ns_var}
1490catch {namespace delete test_ns_var2}
1491catch {unset xx}
1492catch {unset x}
1493catch {unset y}
1494catch {unset i}
1495catch {unset a}
1496catch {unset xxxxx}
1497catch {unset aaaaa}
1498
1499# cleanup
1500::tcltest::cleanupTests
1501return
1502
1503# Local Variables:
1504# mode: tcl
1505# End:
1506