Merge commit '9966985d896629eede849a84f18e406d1164a16c' as 'tcl8.6'

1 files changed, 993 insertions, 0 deletions

diff --git a/tcl8.6/tests/var.test b/tcl8.6/tests/var.test
new file mode 100644
index 0000000..297034a
--- /dev/null
+++ b/tcl8.6/tests/var.test
@@ -0,0 +1,993 @@
+# This file contains tests for the tclVar.c source file. Tests appear in the
+# same order as the C code that they test. The set of tests is currently
+# incomplete since it currently includes only new tests for code changed for
+# the addition of Tcl namespaces. Other variable-related tests appear in
+# several other test files including namespace.test, set.test, trace.test, and
+# upvar.test.
+#
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.2
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testupvar [llength [info commands testupvar]]
+testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
+testConstraint testsetnoerr [llength [info commands testsetnoerr]]
+testConstraint memory [llength [info commands memory]]
+
+catch {rename p ""}
+catch {namespace delete test_ns_var}
+catch {unset xx}
+catch {unset x}
+catch {unset y}
+catch {unset i}
+catch {unset a}
+catch {unset arr}
+
+test var-1.1 {TclLookupVar, Array handling} -setup {
+    catch {unset a}
+} -body {
+    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
+    set i 10
+    set arr(foo) 37
+    list [$x i] $i [$x arr(foo)] $arr(foo)
+} -result {11 11 38 38}
+set ::x "global value"
+namespace eval test_ns_var {
+    variable x "namespace value"
+}
+test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
+    namespace eval test_ns_var {
+        proc p {} {
+            global x  ;# specifies TCL_GLOBAL_ONLY to get global x
+            return $x
+        }
+    }
+    test_ns_var::p
+} {global value}
+test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} {
+    namespace eval test_ns_var {
+        proc q {} {
+            variable x  ;# specifies TCL_NAMESPACE_ONLY to get namespace x
+            return $x
+        }
+    }
+    test_ns_var::q
+} {namespace value}
+test var-1.4 {TclLookupVar, no active call frame implies global namespace var} {
+    set x
+} {global value}
+test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
+    namespace eval test_ns_var {set x}
+} {namespace value}
+test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
+    namespace eval test_ns_var {set ::x}
+} {global value}
+test var-1.7 {TclLookupVar, error finding namespace var} -body {
+    set a:::b
+} -returnCodes error -result {can't read "a:::b": no such variable}
+test var-1.8 {TclLookupVar, error finding namespace var} -body {
+    set ::foobarfoo
+} -returnCodes error -result {can't read "::foobarfoo": no such variable}
+test var-1.9 {TclLookupVar, create new namespace var} {
+    namespace eval test_ns_var {
+        set v hello
+    }
+} {hello}
+test var-1.10 {TclLookupVar, create new namespace var} -setup {
+    catch {unset y}
+} -body {
+    namespace eval test_ns_var {
+        set ::y 789
+    }
+    set y
+} -result {789}
+test var-1.11 {TclLookupVar, error creating new namespace var} -body {
+    namespace eval test_ns_var {
+        set ::test_ns_var::foo::bar 314159
+    }
+} -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}
+test var-1.12 {TclLookupVar, error creating new namespace var} -body {
+    namespace eval test_ns_var {
+        set ::test_ns_var::foo:: 1997
+    }
+} -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist}
+test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
+    catch {unset aNeWnAmEiNnS}
+    namespace eval test_ns_var {
+        namespace eval test_ns_var2::test_ns_var3 {
+            set aNeWnAmEiNnS 77777
+        }
+        # namespace which builds a name by traversing nsPtr chain to ::
+        namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
+    }
+} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
+test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
+    namespace eval test_ns_var {
+        set : 123
+        set v: 456
+        set x:y: 789
+        list [set :] [set v:] [set x:y:] \
+             ${:} ${v:} ${x:y:} \
+             [expr {":" in [info vars]}] \
+             [expr {"v:" in [info vars]}] \
+             [expr {"x:y:" in [info vars]}]
+    }
+} {123 456 789 123 456 789 1 1 1}
+test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
+    namespace eval test_ns_var {
+	variable foo 2
+    }
+    proc p {} {
+	variable ::test_ns_var::foo
+	lappend result [catch {set foo} msg] $msg
+        namespace delete ::test_ns_var
+	lappend result [catch {set foo 3} msg] $msg
+	lappend result [catch {set foo(3) 3} msg] $msg
+    }
+    p
+} {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}}
+test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
+    namespace eval test_ns_var {
+	variable result
+        namespace eval subns {
+	    variable foo 2
+	}
+	upvar 0 subns::foo foo
+	lappend result [catch {set foo} msg] $msg
+        namespace delete subns
+	lappend result [catch {set foo 3} msg] $msg
+	lappend result [catch {set foo(3) 3} msg] $msg
+        namespace delete [namespace current]
+	set result
+    }
+} {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}}
+test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
+    namespace eval test_ns_var {
+	variable result
+	proc p {} {
+	    array set x {1 2 3 4}
+	    upvar 0 x(1) foo
+	    lappend result [catch {set foo} msg] $msg
+	    unset x
+	    lappend result [catch {set foo 3} msg] $msg
+	}
+	set result [p]
+        namespace delete [namespace current]
+	set result
+    }
+} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
+    unset -nocomplain test_ns_var::x
+} -body {
+    namespace eval test_ns_var {
+	variable result {}
+	variable x
+	array set x {1 2 3 4}
+	upvar 0 x(1) foo
+	lappend result [catch {set foo} msg] $msg
+	unset x
+	lappend result [catch {set foo 3} msg] $msg
+        namespace delete [namespace current]
+	set result
+    }
+} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
+    [format set] thisvar(doesntexist)
+} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
+
+test var-2.1 {Tcl_LappendObjCmd, create var if new} {
+    catch {unset x}
+    lappend x 1 2
+} {1 2}
+
+test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
+    catch {unset x}
+} -body {
+    set x 1997
+    proc p {} {
+        global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
+        return $x
+    }
+    p
+} -result {1997}
+test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
+    namespace eval test_ns_var {
+        catch {unset v}
+        variable v 1998
+        proc p {} {
+            variable v  ;# TCL_NAMESPACE_ONLY specified for other var x
+            return $v
+        }
+        p
+    }
+} {1998}
+test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
+    catch {unset a}
+} -constraints testupvar -body {
+    set a 123321
+    proc p {} {
+	# create global xx linked to global a
+	testupvar 1 a {} xx global 
+    }
+    list [p] $xx [set xx 789] $a
+} -result {{} 123321 789 789}
+test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
+    catch {unset a}
+} -constraints testupvar -body {
+    set a 456
+    namespace eval test_ns_var {
+	catch {unset ::test_ns_var::vv}
+	proc p {} {
+	    # create namespace var vv linked to global a
+	    testupvar 1 a {} vv namespace 
+	}
+	p
+    }
+    list $test_ns_var::vv [set test_ns_var::vv 123] $a
+} -result {456 123 123}
+test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
+    catch {unset aaaaa}
+    catch {unset xxxxx}
+} -body {
+    set aaaaa 77777
+    upvar #0 aaaaa xxxxx
+    list [set xxxxx] [set aaaaa]
+} -result {77777 77777}
+test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup {
+    catch {unset a}
+} -body {
+    set a 121212
+    namespace eval test_ns_var {
+        upvar ::a vvv
+        set vvv
+    }
+} -result {121212}
+test var-3.7 {MakeUpvar, my var has ::s} -setup {
+    catch {unset a}
+} -body {
+    set a 789789
+    upvar #0 a test_ns_var::lnk
+    namespace eval test_ns_var {
+        set lnk
+    }
+} -result {789789}
+test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
+    upvar #0 aaaaa xxxxx
+    catch {unset aaaaa}
+    catch {unset xxxxx}
+} -body {
+    set aaaaa 456654
+    set xxxxx hello
+    upvar #0 aaaaa xxxxx
+    set xxxxx
+} -result {hello}
+test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
+    catch {unset aaaaa}
+} -returnCodes error -body {
+    set aaaaa 789789
+    upvar #0 aaaaa test_ns_fred::lnk
+} -cleanup {
+    unset ::aaaaa
+} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
+test var-3.10 {MakeUpvar, between namespaces} -body {
+    namespace eval {} {
+	variable bar 0
+	namespace eval foo upvar bar bar
+	set foo::bar 1
+	list $bar $foo::bar
+    }
+} -result {1 1}
+test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
+    catch {unset aaaaa}
+} -returnCodes error -body {
+    set aaaaa 789789
+    upvar #0 aaaaa foo(bar)
+} -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}
+
+test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
+    catch {unset a}
+    set a 123
+    testgetvarfullname a global
+} ::a
+test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
+    namespace eval test_ns_var {
+	variable george
+	testgetvarfullname george namespace
+    }
+} ::test_ns_var::george
+test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup {
+    catch {unset a}
+} -constraints testgetvarfullname -body {
+    set a(1) foo
+    testgetvarfullname a(1) global
+} -returnCodes error -result {unknown variable "a(1)"}
+
+test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {
+    catch {unset a}
+} -body {
+    set a bar
+    namespace which -variable a
+} -result {::a}
+test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
+    namespace eval test_ns_var {
+        variable martha
+        namespace which -variable martha
+    }
+} {::test_ns_var::martha}
+test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
+    namespace eval test_ns_var {variable martha}
+} -body {
+    namespace which -variable test_ns_var::martha
+} -result {::test_ns_var::martha}
+
+test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
+    namespace eval test_ns_var {
+        variable boeing 777
+    }
+    apply {{} {
+        global ::test_ns_var::boeing
+        set boeing
+    }}
+} {777}
+test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
+    namespace eval test_ns_var {
+        namespace eval test_ns_nested {
+            variable java java
+        }
+        proc p {} {
+            global ::test_ns_var::test_ns_nested::java
+            set java
+        }
+    }
+    test_ns_var::p
+} {java}
+test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
+    namespace eval ::test_ns_var::test_ns_nested {}
+    set ::test_ns_var::test_ns_nested:: 24
+    apply {{} {
+        global ::test_ns_var::test_ns_nested::
+        set {}
+    }}
+} {24}
+test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
+    # Test for Tcl Bug 480176
+    set :v broken
+    proc p {} {
+	global :v
+	set :v fixed
+    }
+    p
+    set :v
+} {fixed}
+test var-6.5 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
+    global
+} {}
+test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
+    proc p {} {
+	global
+    }
+    p
+} {}
+
+test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup {
+    catch {namespace delete test_ns_var}
+} -body {
+    namespace eval test_ns_var {
+        variable one 1
+    }
+    list [info vars test_ns_var::*] [set test_ns_var::one]
+} -result {::test_ns_var::one 1}
+test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
+    set two 2222222
+    namespace eval test_ns_var {
+        variable two
+    }
+    list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
+} {0 1 {can't read "test_ns_var::two": no such variable}}
+test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
+    catch {namespace delete test_ns_var}
+    namespace eval test_ns_var {variable one 1}
+} -body {
+    namespace eval test_ns_var {
+        variable two 2
+    }
+    list [lsort [info vars test_ns_var::*]] \
+         [namespace eval test_ns_var {set two}]
+} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
+test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
+    catch {namespace delete test_ns_var}
+    namespace eval test_ns_var {variable one 1; variable two 2}
+} -body {
+    namespace eval test_ns_var {
+        variable three 3 four 4
+    }
+    list [lsort [info vars test_ns_var::*]] \
+         [namespace eval test_ns_var {expr $three+$four}]
+} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
+test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
+    catch {unset a}
+    catch {unset five}
+    catch {unset six}
+} -body {
+    set a ""
+    set five 555
+    set six  666
+    namespace eval test_ns_var {
+        variable five 5 six
+        lappend a $five
+    }
+    lappend a $test_ns_var::five \
+        [set test_ns_var::six 6] [set test_ns_var::six] $six
+} -cleanup {
+    catch {unset five}
+    catch {unset six}
+} -result {5 5 6 6 666}
+test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup {
+    catch {unset newvar}
+} -body {
+    namespace eval test_ns_var {
+        variable ::newvar cheers!
+    }
+    return $newvar
+} -cleanup {
+    catch {unset newvar}
+} -result {cheers!}
+test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
+    namespace eval test_ns_var {
+        variable sev:::en 7
+    }
+} -result {can't define "sev:::en": parent namespace doesn't exist}
+test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
+    set a ""
+    namespace eval test_ns_var {
+        variable eight 8
+        lappend a $eight
+        variable eight
+        lappend a $eight
+    }
+    set a
+} {8 8}
+test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
+    catch {namespace delete test_ns_var2}
+} -body {
+    set a ""
+    namespace eval test_ns_var2 {
+        variable x 123
+        variable y
+        variable z
+    }
+    lappend a [lsort [info vars test_ns_var2::*]]
+    lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
+        [info exists test_ns_var2::z]
+    lappend a [list [catch {set test_ns_var2::y} msg] $msg]
+    lappend a [lsort [info vars test_ns_var2::*]]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [set test_ns_var2::y hello]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
+    lappend a [lsort [info vars test_ns_var2::*]]
+    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
+    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
+    lappend a [namespace delete test_ns_var2]
+} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
+	{1 {can't read "test_ns_var2::y": no such variable}}\
+	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
+	hello 1 0\
+	{0 {}}\
+	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
+	{1 {can't unset "test_ns_var2::z": no such variable}}\
+	{}]
+test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+    namespace eval test_ns_var { variable eight 8 }
+} -body {
+    namespace eval test_ns_var {
+        proc p {} {
+            variable eight
+            list [set eight] [info vars]
+        }
+        p
+    }
+} -result {8 eight}
+test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+    namespace eval test_ns_var { variable eight 8 }
+} -body {
+    proc p {} {   ;# note this proc is at global :: scope
+        variable test_ns_var::eight
+        list [set eight] [info vars]
+    }
+    p
+} -result {8 eight}
+test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+    namespace eval test_ns_var {
+        variable {} {My name is empty}
+    }
+    proc p {} {   ;# note this proc is at global :: scope
+        variable test_ns_var::
+        list [set {}] [info vars]
+    }
+    p
+} {{My name is empty} {{}}}
+test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
+    namespace eval test_ns_var {
+        variable : {My name is ":"}
+	proc p {} {
+	    variable :
+	    list [set :] [info vars]
+	}
+	p
+    }
+} {{My name is ":"} :}
+test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
+    namespace eval test_ns_var { variable arrayvar(1) }
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
+    namespace eval test_ns_var { 
+	variable arrayvar
+	set arrayvar(1) x
+	variable arrayvar(1) y
+    }   
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
+    variable
+} {}
+test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
+    namespace eval test_ns_var {
+	variable
+    }
+} {}
+
+test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup {
+    catch {namespace delete test_ns_var}
+    catch {unset a}
+} -body {
+    namespace eval test_ns_var {
+        variable v 123
+        variable info ""
+        proc traceUnset {name1 name2 op} {
+            variable info
+            set info [concat $info [list $name1 $name2 $op]]
+        }
+        trace var v u [namespace code traceUnset]
+    }
+    list [unset test_ns_var::v] $test_ns_var::info
+} -result {{} {test_ns_var::v {} u}}
+test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
+    catch {namespace delete test_ns_var}
+    catch {unset a}
+} -body {
+    set info ""
+    namespace eval test_ns_var {
+        variable v 123 1
+        trace var v u ::traceUnset
+    }
+    proc traceUnset {name1 name2 op} {
+	set ::info [concat $::info [list $name1 $name2 $op]]
+    }
+    list [namespace delete test_ns_var] $::info
+} -result {{} {::test_ns_var::v {} u}}
+
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
+    list \
+	[set u a; testsetnoerr u] \
+	[testsetnoerr v b] \
+	[testseterr u] \
+	[unset v; testseterr v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup {
+    catch {namespace delete ns}
+} -constraints testsetnoerr -body {
+    namespace eval ns {variable u a; variable v}
+    list \
+	[testsetnoerr ns::u] \
+	[testsetnoerr ns::v b] \
+	[testseterr ns::u] \
+	[unset ns::v; testseterr ns::v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.3 {behaviour of TclGetVar no variable} -setup {
+    catch {unset u}
+} -constraints testsetnoerr -body {
+    list \
+	[catch {testsetnoerr u} res] $res \
+	[catch {testseterr u} res] $res
+} -result {1 {before get} 1 {can't read "u": no such variable}}
+test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
+    catch {namespace delete ns}
+} -constraints testsetnoerr -body {
+    namespace eval ns {}
+    list \
+	[catch {testsetnoerr ns::w} res] $res \
+	[catch {testseterr ns::w} res] $res
+} -result {1 {before get} 1 {can't read "ns::w": no such variable}}
+test var-9.5 {behaviour of TclGetVar no namespace} -setup {
+    catch {namespace delete ns}
+} -constraints testsetnoerr -body {
+    list \
+	[catch {testsetnoerr ns::u} res] $res \
+	[catch {testseterr ns::v} res] $res
+} -result {1 {before get} 1 {can't read "ns::v": no such variable}}
+test var-9.6 {behaviour of TclSetVar no namespace} -setup {
+    catch {namespace delete ns}
+} -constraints testsetnoerr -body {
+    list \
+	[catch {testsetnoerr ns::v 1} res] $res \
+	[catch {testseterr ns::v 1} res] $res
+} -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
+test var-9.7 {behaviour of TclGetVar array variable} -setup {
+    catch {unset arr}
+} -constraints testsetnoerr -body {
+    set arr(1) 1
+    list \
+	[catch {testsetnoerr arr} res] $res \
+	[catch {testseterr arr} res] $res
+} -result {1 {before get} 1 {can't read "arr": variable is array}}
+test var-9.8 {behaviour of TclSetVar array variable} -setup {
+    catch {unset arr}
+} -constraints testsetnoerr -body {
+    set arr(1) 1
+    list \
+	[catch {testsetnoerr arr 2} res] $res \
+	[catch {testseterr arr 2} res] $res
+} -result {1 {before set} 1 {can't set "arr": variable is array}}
+test var-9.9 {behaviour of TclGetVar read trace success} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
+    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
+    set u 10
+    trace var u r [list resetvar 1]
+    trace var v r [list resetvar 2]
+    list \
+	[testsetnoerr u] \
+	[testseterr v]
+} -result {{before get 1} {before get 2}}
+test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
+    proc writeonly args {error "write-only"}
+    set v 456
+    trace var v r writeonly
+    list \
+	[catch {testsetnoerr v} msg] $msg \
+	[catch {testseterr v} msg] $msg
+} {1 {before get} 1 {can't read "v": write-only}}
+test var-9.11 {behaviour of TclSetVar write trace success} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
+    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
+    set v 1
+    trace var v w doubleval
+    trace var u w doubleval
+    list \
+	[testsetnoerr u 2] \
+	[testseterr v 3]
+} -result {{before set 4} {before set 6}}
+test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
+    proc readonly args {error "read-only"}
+    set v 456
+    trace var v w readonly
+    list \
+	[catch {testsetnoerr v 2} msg] $msg $v \
+	[catch {testseterr v 3} msg] $msg $v
+} {1 {before set} 2 1 {can't set "v": read-only} 3}
+
+test var-10.1 {can't nest arrays with array set} -setup {
+   catch {unset arr}
+} -returnCodes error -body {
+   array set arr(x) {a 1 b 2}
+} -result {can't set "arr(x)": variable isn't array}
+test var-10.2 {can't nest arrays with array set} -setup {
+   catch {unset arr}
+} -returnCodes error -body {
+   array set arr(x) {}
+} -result {can't set "arr(x)": variable isn't array}
+
+test var-11.1 {array unset} -setup {
+    catch {unset a}
+} -body {
+    array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
+    array unset a 1,*
+    lsort -dict [array names a]
+} -result {2,1 2,3}
+test var-11.2 {array unset} -setup {
+    catch {unset a}
+} -body {
+    array set a { 1,1 a 1,2 b }
+    array unset a
+    array exists a
+} -result 0
+test var-11.3 {array unset errors} -setup {
+    catch {unset a}
+} -returnCodes error -body {
+    array set a { 1,1 a 1,2 b }
+    array unset a pattern too
+} -result {wrong # args: should be "array unset arrayName ?pattern?"}
+
+test var-12.1 {TclFindCompiledLocals, {} array name} {
+    namespace eval n {
+	proc p {} {
+	    variable {}
+	    set (0) 0
+	    set (1) 1
+	    set n 2
+	    set ($n) 2
+	    set ($n,foo) 2
+	}
+	p
+	lsort -dictionary [array names {}]
+    }
+} {0 1 2 2,foo}
+
+test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
+    catch {unset t}
+} -body {
+    proc foo {var ind op} {
+	global t
+	set foo bar
+    }
+    namespace eval :: {
+	set t(1) 1
+	trace variable t(1) u foo
+	unset t
+    }
+    set x "If you see this, it worked"
+} -result "If you see this, it worked"
+
+test var-14.1 {array names syntax} -body {
+    array names foo bar baz snafu
+} -returnCodes 1 -match glob -result *
+test var-14.2 {array names -glob} -body {
+    array names tcl_platform -glob os
+} -result os
+
+test var-15.1 {segfault in [unset], [Bug 735335]} {
+    proc A { name } {
+	upvar $name var
+	set var $name
+    }
+    #
+    # Note that the variable name has to be 
+    # unused previously for the segfault to
+    # be triggered.
+    #
+    namespace eval test A useSomeUnlikelyNameHere
+    namespace eval test unset useSomeUnlikelyNameHere
+} {}
+test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
+    apply {{} {unset foo [return ok]}}
+} ok
+
+test var-16.1 {CallVarTraces: save/restore interp error state} {
+    trace add variable ::errorCode write " ;#"
+    catch {error foo bar baz}
+    trace remove variable ::errorCode write " ;#"
+    set ::errorInfo
+} bar
+
+test var-17.1 {TclArraySet [Bug 1669489]} -setup {
+    unset -nocomplain ::a
+} -body {
+    namespace eval :: {
+	set elements {1 2 3 4}
+	trace add variable a write "string length \$elements ;#"
+	array set a $elements
+    }
+} -cleanup {
+    unset -nocomplain ::a ::elements
+} -result {}
+
+test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
+    set already 0
+    unset -nocomplain x
+} -body {
+    array set x {e 1 i 1}
+    trace add variable x unset {apply {args {
+	global already x
+	if {!$already} {
+	    set already 1
+	    unset x(i)
+	}
+    }}}
+    # The next command would crash reliably with memory debugging prior to the
+    # bug fix.
+    array unset x *
+    array size x
+} -cleanup {
+    unset x already
+} -result 0
+
+test var-19.1 {crash when freeing locals hashtable: Bug 3037525} {
+    proc foo {} { catch {upvar 0 dummy \$index} }
+    foo ; # This crashes without the fix for the bug
+    rename foo {}
+} {}
+
+test var-20.1 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	array set x {a 1}
+    }}
+    array size x
+} -result 1
+test var-20.2 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	array set x {}
+    }}
+    array size x
+} -result 0
+test var-20.3 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	array set ::x {a 1}
+    }}
+    array size x
+} -result 1
+test var-20.4 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	array set ::x {}
+    }}
+    array size x
+} -result 0
+test var-20.5 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	eval {array set x {a 1}}
+    }}
+    array size x
+} -result 1
+test var-20.6 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	eval {array set x {}}
+    }}
+    array size x
+} -result 0
+test var-20.7 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	eval {array set ::x {a 1}}
+    }}
+    array size x
+} -result 1
+test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	eval {array set ::x {}}
+    }}
+    array size x
+} -result 0
+test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup {
+    variable foo
+    variable lambda
+    unset -nocomplain lambda foo
+    array set foo {}
+    lappend lambda {}
+    lappend lambda [list array set [namespace which -variable foo] {a 1}]
+} -body {
+    after 0 [list apply $lambda]
+    vwait [namespace which -variable foo]
+} -cleanup {
+    unset -nocomplain lambda foo
+} -result {}
+test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
+    apply {{} {set name foo(bar); array set $name {a 1}}}
+} -returnCodes error -match glob -result *
+
+test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+	set foo bar
+        unset foo {*}{
+        } [return [incr n -[linenumber]]]
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
+test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
+    proc getbytes {} {
+	lindex [split [memory info] \n] 3 3
+    }
+    proc doit k {
+	variable A
+	set A($k) {}
+	foreach n [array names A] {
+	    if {$n <= $k-1} {
+		unset A($n)
+	    }
+	}
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	doit $i
+        set tmp $end
+        set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    array unset A
+    rename getbytes {}
+    rename doit {}
+} -result 0
+test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
+    proc getbytes {} {
+	lindex [split [memory info] \n] 3 3
+    }
+    proc doit {} {
+	interp create slave
+	slave eval {
+	    proc doit script {
+		eval $script
+		set foo bar
+	    }
+	    doit {foreach foo baz {}}
+	}
+	interp delete slave
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	doit
+        set tmp $end
+        set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    array unset A
+    rename getbytes {}
+    rename doit {}
+} -result 0
+
+
+catch {namespace delete ns}
+catch {unset arr}
+catch {unset v}
+
+catch {rename p ""}
+catch {namespace delete test_ns_var}
+catch {namespace delete test_ns_var2}
+catch {unset xx}
+catch {unset x}
+catch {unset y}
+catch {unset i}
+catch {unset a}
+catch {unset xxxxx}
+catch {unset aaaaa}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: