sl@0: # This file contains tests for the tclVar.c source file. Tests appear in
sl@0: # the same order as the C code that they test. The set of tests is
sl@0: # currently incomplete since it currently includes only new tests for
sl@0: # code changed for the addition of Tcl namespaces. Other variable-
sl@0: # related tests appear in several other test files including
sl@0: # namespace.test, set.test, trace.test, and upvar.test.
sl@0: #
sl@0: # Sourcing this file into Tcl runs the tests and generates output for
sl@0: # errors. No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1997 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: var.test,v 1.20.2.4 2007/03/13 15:59:53 dgp Exp $
sl@0: #
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest 2.2
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: catch {rename p ""}
sl@0: catch {namespace delete test_ns_var}
sl@0: catch {unset xx}
sl@0: catch {unset x}
sl@0: catch {unset y}
sl@0: catch {unset i}
sl@0: catch {unset a}
sl@0: catch {unset arr}
sl@0: 
sl@0: test var-1.1 {TclLookupVar, Array handling} {
sl@0:     catch {unset a}
sl@0:     set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
sl@0:     set i 10
sl@0:     set arr(foo) 37
sl@0:     list [$x i] $i [$x arr(foo)] $arr(foo)
sl@0: } {11 11 38 38}
sl@0: test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
sl@0:     set x "global value"
sl@0:     namespace eval test_ns_var {
sl@0:         variable x "namespace value"
sl@0:         proc p {} {
sl@0:             global x  ;# specifies TCL_GLOBAL_ONLY to get global x
sl@0:             return $x
sl@0:         }
sl@0:     }
sl@0:     test_ns_var::p
sl@0: } {global value}
sl@0: test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} {
sl@0:     namespace eval test_ns_var {
sl@0:         proc q {} {
sl@0:             variable x  ;# specifies TCL_NAMESPACE_ONLY to get namespace x
sl@0:             return $x
sl@0:         }
sl@0:     }
sl@0:     test_ns_var::q
sl@0: } {namespace value}
sl@0: test var-1.4 {TclLookupVar, no active call frame implies global namespace var} {
sl@0:     set x
sl@0: } {global value}
sl@0: test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
sl@0:     namespace eval test_ns_var {set x}
sl@0: } {namespace value}
sl@0: test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
sl@0:     namespace eval test_ns_var {set ::x}
sl@0: } {global value}
sl@0: test var-1.7 {TclLookupVar, error finding namespace var} {
sl@0:     list [catch {set a:::b} msg] $msg
sl@0: } {1 {can't read "a:::b": no such variable}}
sl@0: test var-1.8 {TclLookupVar, error finding namespace var} {
sl@0:     list [catch {set ::foobarfoo} msg] $msg
sl@0: } {1 {can't read "::foobarfoo": no such variable}}
sl@0: test var-1.9 {TclLookupVar, create new namespace var} {
sl@0:     namespace eval test_ns_var {
sl@0:         set v hello
sl@0:     }
sl@0: } {hello}
sl@0: test var-1.10 {TclLookupVar, create new namespace var} {
sl@0:     catch {unset y}
sl@0:     namespace eval test_ns_var {
sl@0:         set ::y 789
sl@0:     }
sl@0:     set y
sl@0: } {789}
sl@0: test var-1.11 {TclLookupVar, error creating new namespace var} {
sl@0:     namespace eval test_ns_var {
sl@0:         list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
sl@0:     }
sl@0: } {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
sl@0: test var-1.12 {TclLookupVar, error creating new namespace var} {
sl@0:     namespace eval test_ns_var {
sl@0:         list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
sl@0:     }
sl@0: } {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
sl@0: test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
sl@0:     catch {unset aNeWnAmEiNnS}
sl@0:     namespace eval test_ns_var {
sl@0:         namespace eval test_ns_var2::test_ns_var3 {
sl@0:             set aNeWnAmEiNnS 77777
sl@0:         }
sl@0:         # namespace which builds a name by traversing nsPtr chain to ::
sl@0:         namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
sl@0:     }
sl@0: } {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
sl@0: test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
sl@0:     namespace eval test_ns_var {
sl@0:         set : 123
sl@0:         set v: 456
sl@0:         set x:y: 789
sl@0:         list [set :] [set v:] [set x:y:] \
sl@0:              ${:} ${v:} ${x:y:} \
sl@0:              [expr {[lsearch [info vars] :] != -1}] \
sl@0:              [expr {[lsearch [info vars] v:] != -1}] \
sl@0:              [expr {[lsearch [info vars] x:y:] != -1}]
sl@0:     }
sl@0: } {123 456 789 123 456 789 1 1 1}
sl@0: test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
sl@0:     namespace eval test_ns_var {
sl@0: 	variable foo 2
sl@0:     }
sl@0:     proc p {} {
sl@0: 	variable ::test_ns_var::foo
sl@0: 	lappend result [catch {set foo} msg] $msg
sl@0:         namespace delete ::test_ns_var
sl@0: 	lappend result [catch {set foo 3} msg] $msg
sl@0: 	lappend result [catch {set foo(3) 3} msg] $msg
sl@0:     }
sl@0:     p
sl@0: } {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}}
sl@0: test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
sl@0:     namespace eval test_ns_var {
sl@0: 	variable result
sl@0:         namespace eval subns {
sl@0: 	    variable foo 2
sl@0: 	}
sl@0: 	upvar 0 subns::foo foo
sl@0: 	lappend result [catch {set foo} msg] $msg
sl@0:         namespace delete subns
sl@0: 	lappend result [catch {set foo 3} msg] $msg
sl@0: 	lappend result [catch {set foo(3) 3} msg] $msg
sl@0:         namespace delete [namespace current]
sl@0: 	set result
sl@0:     }
sl@0: } {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}}
sl@0: test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
sl@0:     namespace eval test_ns_var {
sl@0: 	variable result
sl@0: 	proc p {} {
sl@0: 	    array set x {1 2 3 4}
sl@0: 	    upvar 0 x(1) foo
sl@0: 	    lappend result [catch {set foo} msg] $msg
sl@0: 	    unset x
sl@0: 	    lappend result [catch {set foo 3} msg] $msg
sl@0: 	}
sl@0: 	set result [p]
sl@0:         namespace delete [namespace current]
sl@0: 	set result
sl@0:     }
sl@0: } {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
sl@0: test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
sl@0:     namespace eval test_ns_var {
sl@0: 	variable result {}
sl@0: 	variable x
sl@0: 	array set x {1 2 3 4}
sl@0: 	upvar 0 x(1) foo
sl@0: 	lappend result [catch {set foo} msg] $msg
sl@0: 	unset x
sl@0: 	lappend result [catch {set foo 3} msg] $msg
sl@0:         namespace delete [namespace current]
sl@0: 	set result
sl@0:     }
sl@0: } {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
sl@0: test var-1.19 {TclLookupVar, right error message when parsing variable name} {
sl@0:     list [catch {[format set] thisvar(doesntexist)} msg] $msg
sl@0: } {1 {can't read "thisvar(doesntexist)": no such variable}}
sl@0: 
sl@0: test var-2.1 {Tcl_LappendObjCmd, create var if new} {
sl@0:     catch {unset x}
sl@0:     lappend x 1 2
sl@0: } {1 2}
sl@0: 
sl@0: test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
sl@0:     catch {unset x}
sl@0:     set x 1997
sl@0:     proc p {} {
sl@0:         global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
sl@0:         return $x
sl@0:     }
sl@0:     p
sl@0: } {1997}
sl@0: test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
sl@0:     namespace eval test_ns_var {
sl@0:         catch {unset v}
sl@0:         variable v 1998
sl@0:         proc p {} {
sl@0:             variable v  ;# TCL_NAMESPACE_ONLY specified for other var x
sl@0:             return $v
sl@0:         }
sl@0:         p
sl@0:     }
sl@0: } {1998}
sl@0: if {[info commands testupvar] != {}} {
sl@0:     test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} {
sl@0:         catch {unset a}
sl@0:         set a 123321
sl@0:         proc p {} {
sl@0:             # create global xx linked to global a
sl@0: 	    testupvar 1 a {} xx global 
sl@0: 	}
sl@0:         list [p] $xx [set xx 789] $a
sl@0:     } {{} 123321 789 789}
sl@0:     test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} {
sl@0:         catch {unset a}
sl@0:         set a 456
sl@0:         namespace eval test_ns_var {
sl@0:             catch {unset ::test_ns_var::vv}
sl@0:             proc p {} {
sl@0:                 # create namespace var vv linked to global a
sl@0: 	        testupvar 1 a {} vv namespace 
sl@0: 	    }
sl@0:             p
sl@0:         }
sl@0:         list $test_ns_var::vv [set test_ns_var::vv 123] $a
sl@0:     } {456 123 123}
sl@0: }
sl@0: test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
sl@0:     catch {unset aaaaa}
sl@0:     catch {unset xxxxx}
sl@0:     set aaaaa 77777
sl@0:     upvar #0 aaaaa xxxxx
sl@0:     list [set xxxxx] [set aaaaa]
sl@0: } {77777 77777}
sl@0: test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
sl@0:     catch {unset a}
sl@0:     set a 121212
sl@0:     namespace eval test_ns_var {
sl@0:         upvar ::a vvv
sl@0:         set vvv
sl@0:     }
sl@0: } {121212}
sl@0: test var-3.7 {MakeUpvar, my var has ::s} {
sl@0:     catch {unset a}
sl@0:     set a 789789
sl@0:     upvar #0 a test_ns_var::lnk
sl@0:     namespace eval test_ns_var {
sl@0:         set lnk
sl@0:     }
sl@0: } {789789}
sl@0: test var-3.8 {MakeUpvar, my var already exists in global ns} {
sl@0:     catch {unset aaaaa}
sl@0:     catch {unset xxxxx}
sl@0:     set aaaaa 456654
sl@0:     set xxxxx hello
sl@0:     upvar #0 aaaaa xxxxx
sl@0:     set xxxxx
sl@0: } {hello}
sl@0: test var-3.9 {MakeUpvar, my var has invalid ns name} {
sl@0:     catch {unset aaaaa}
sl@0:     set aaaaa 789789
sl@0:     list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
sl@0: } {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
sl@0: test var-3.10 {MakeUpvar, } {
sl@0:     namespace eval {} {
sl@0: 	set bar 0
sl@0: 	namespace eval foo upvar bar bar
sl@0: 	set foo::bar 1
sl@0: 	catch {list $bar $foo::bar} msg
sl@0: 	unset ::aaaaa
sl@0: 	set msg
sl@0:     }
sl@0: } {1 1}
sl@0: 
sl@0: if {[info commands testgetvarfullname] != {}} {
sl@0:     test var-4.1 {Tcl_GetVariableName, global variable} {
sl@0:         catch {unset a}
sl@0:         set a 123
sl@0:         testgetvarfullname a global
sl@0:     } ::a
sl@0:     test var-4.2 {Tcl_GetVariableName, namespace variable} {
sl@0:         namespace eval test_ns_var {
sl@0:             variable george
sl@0:             testgetvarfullname george namespace
sl@0:         }
sl@0:     } ::test_ns_var::george
sl@0:     test var-4.3 {Tcl_GetVariableName, variable can't be array element} {
sl@0:         catch {unset a}
sl@0:         set a(1) foo
sl@0:         list [catch {testgetvarfullname a(1) global} msg] $msg
sl@0:     } {1 {unknown variable "a(1)"}}
sl@0: }
sl@0: 
sl@0: test var-5.1 {Tcl_GetVariableFullName, global variable} {
sl@0:     catch {unset a}
sl@0:     set a bar
sl@0:     namespace which -variable a
sl@0: } {::a}
sl@0: test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable martha
sl@0:         namespace which -variable martha
sl@0:     }
sl@0: } {::test_ns_var::martha}
sl@0: test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
sl@0:     namespace which -variable test_ns_var::martha
sl@0: } {::test_ns_var::martha}
sl@0: 
sl@0: test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable boeing 777
sl@0:     }
sl@0:     proc p {} {
sl@0:         global ::test_ns_var::boeing
sl@0:         set boeing
sl@0:     }
sl@0:     p
sl@0: } {777}
sl@0: test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
sl@0:     namespace eval test_ns_var {
sl@0:         namespace eval test_ns_nested {
sl@0:             variable java java
sl@0:         }
sl@0:         proc p {} {
sl@0:             global ::test_ns_var::test_ns_nested::java
sl@0:             set java
sl@0:         }
sl@0:     }
sl@0:     test_ns_var::p
sl@0: } {java}
sl@0: test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
sl@0:     set ::test_ns_var::test_ns_nested:: 24
sl@0:     proc p {} {
sl@0:         global ::test_ns_var::test_ns_nested::
sl@0:         set {}
sl@0:     }
sl@0:     p
sl@0: } {24}
sl@0: test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
sl@0:     # Test for Tcl Bug 480176
sl@0:     set :v broken
sl@0:     proc p {} {
sl@0: 	global :v
sl@0: 	set :v fixed
sl@0:     }
sl@0:     p
sl@0:     set :v
sl@0: } {fixed}
sl@0: 
sl@0: test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
sl@0:     catch {namespace delete test_ns_var}
sl@0:     namespace eval test_ns_var {
sl@0:         variable one 1
sl@0:     }
sl@0:     list [info vars test_ns_var::*] [set test_ns_var::one]
sl@0: } {::test_ns_var::one 1}
sl@0: test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
sl@0:     set two 2222222
sl@0:     namespace eval test_ns_var {
sl@0:         variable two
sl@0:     }
sl@0:     list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
sl@0: } {0 1 {can't read "test_ns_var::two": no such variable}}
sl@0: test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable two 2
sl@0:     }
sl@0:     list [lsort [info vars test_ns_var::*]] \
sl@0:          [namespace eval test_ns_var {set two}]
sl@0: } [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
sl@0: test var-7.4 {Tcl_VariableObjCmd, list of vars} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable three 3 four 4
sl@0:     }
sl@0:     list [lsort [info vars test_ns_var::*]] \
sl@0:          [namespace eval test_ns_var {expr $three+$four}]
sl@0: } [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
sl@0: test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
sl@0:     catch {unset a}
sl@0:     catch {unset five}
sl@0:     catch {unset six}
sl@0:     set a ""
sl@0:     set five 555
sl@0:     set six  666
sl@0:     namespace eval test_ns_var {
sl@0:         variable five 5 six
sl@0:         lappend a $five
sl@0:     }
sl@0:     lappend a $test_ns_var::five \
sl@0:         [set test_ns_var::six 6] [set test_ns_var::six] $six
sl@0:     catch {unset five}
sl@0:     catch {unset six}
sl@0:     set a
sl@0: } {5 5 6 6 666}
sl@0: catch {unset newvar}
sl@0: test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable ::newvar cheers!
sl@0:     }
sl@0:     set newvar
sl@0: } {cheers!}
sl@0: catch {unset newvar}
sl@0: test var-7.7 {Tcl_VariableObjCmd, bad var name} {
sl@0:     namespace eval test_ns_var {
sl@0:         list [catch {variable sev:::en 7} msg] $msg
sl@0:     }
sl@0: } {1 {can't define "sev:::en": parent namespace doesn't exist}}
sl@0: test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
sl@0:     set a ""
sl@0:     namespace eval test_ns_var {
sl@0:         variable eight 8
sl@0:         lappend a $eight
sl@0:         variable eight
sl@0:         lappend a $eight
sl@0:     }
sl@0:     set a
sl@0: } {8 8}
sl@0: test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
sl@0:     catch {namespace delete test_ns_var2}
sl@0:     set a ""
sl@0:     namespace eval test_ns_var2 {
sl@0:         variable x 123
sl@0:         variable y
sl@0:         variable z
sl@0:     }
sl@0:     lappend a [lsort [info vars test_ns_var2::*]]
sl@0:     lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
sl@0:         [info exists test_ns_var2::z]
sl@0:     lappend a [list [catch {set test_ns_var2::y} msg] $msg]
sl@0:     lappend a [lsort [info vars test_ns_var2::*]]
sl@0:     lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
sl@0:     lappend a [set test_ns_var2::y hello]
sl@0:     lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
sl@0:     lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
sl@0:     lappend a [lsort [info vars test_ns_var2::*]]
sl@0:     lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
sl@0:     lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
sl@0:     lappend a [namespace delete test_ns_var2]
sl@0:     set a
sl@0: } [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
sl@0: 	{1 {can't read "test_ns_var2::y": no such variable}}\
sl@0: 	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
sl@0: 	hello 1 0\
sl@0: 	{0 {}}\
sl@0: 	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
sl@0: 	{1 {can't unset "test_ns_var2::z": no such variable}}\
sl@0: 	{}]
sl@0: test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
sl@0:     namespace eval test_ns_var {
sl@0:         proc p {} {
sl@0:             variable eight
sl@0:             list [set eight] [info vars]
sl@0:         }
sl@0:         p
sl@0:     }
sl@0: } {8 eight}
sl@0: test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
sl@0:     proc p {} {   ;# note this proc is at global :: scope
sl@0:         variable test_ns_var::eight
sl@0:         list [set eight] [info vars]
sl@0:     }
sl@0:     p
sl@0: } {8 eight}
sl@0: test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable {} {My name is empty}
sl@0:     }
sl@0:     proc p {} {   ;# note this proc is at global :: scope
sl@0:         variable test_ns_var::
sl@0:         list [set {}] [info vars]
sl@0:     }
sl@0:     p
sl@0: } {{My name is empty} {{}}}
sl@0: test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
sl@0:     namespace eval test_ns_var {
sl@0:         variable : {My name is ":"}
sl@0: 	proc p {} {
sl@0: 	    variable :
sl@0: 	    list [set :] [info vars]
sl@0: 	}
sl@0: 	p
sl@0:     }
sl@0: } {{My name is ":"} :}
sl@0: test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
sl@0:     catch {namespace eval test_ns_var { variable arrayvar(1) }} res
sl@0:     set res
sl@0: } "can't define \"arrayvar(1)\": name refers to an element in an array"
sl@0: test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
sl@0:     catch {
sl@0: 	namespace eval test_ns_var { 
sl@0: 	    variable arrayvar
sl@0: 	    set arrayvar(1) x
sl@0: 	    variable arrayvar(1) y
sl@0: 	}   
sl@0:     } res
sl@0:     set res
sl@0: } "can't define \"arrayvar(1)\": name refers to an element in an array"
sl@0: test var-7.16 {Tcl_VariableObjCmd, no args} {
sl@0:     list [catch {variable} msg] $msg
sl@0: } {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
sl@0: test var-7.17 {Tcl_VariableObjCmd, no args} {
sl@0:     namespace eval test_ns_var {
sl@0: 	list [catch {variable} msg] $msg
sl@0:     }
sl@0: } {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
sl@0: 
sl@0: test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
sl@0:     catch {namespace delete test_ns_var}
sl@0:     catch {unset a}
sl@0:     namespace eval test_ns_var {
sl@0:         variable v 123
sl@0:         variable info ""
sl@0: 
sl@0:         proc traceUnset {name1 name2 op} {
sl@0:             variable info
sl@0:             set info [concat $info [list $name1 $name2 $op]]
sl@0:         }
sl@0: 
sl@0:         trace var v u [namespace code traceUnset]
sl@0:     }
sl@0:     list [unset test_ns_var::v] $test_ns_var::info
sl@0: } {{} {test_ns_var::v {} u}}
sl@0: 
sl@0: if {[info commands testsetnoerr] == {}} {
sl@0:     puts "This application hasn't been compiled with the \"testsetnoerr\""
sl@0:     puts "command, so I can't test TclSetVar etc."
sl@0: } else {
sl@0: test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
sl@0:     catch {unset u}; catch {unset v}
sl@0:     list \
sl@0:        [set u a; testsetnoerr u] \
sl@0:        [testsetnoerr v b] \
sl@0:        [testseterr u] \
sl@0:        [unset v; testseterr v b]
sl@0: } [list {before get a} {before set b} {before get a} {before set b}]
sl@0: test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
sl@0:     catch {namespace delete ns}
sl@0:     namespace eval ns {variable u a; variable v}
sl@0:     list \
sl@0:        [testsetnoerr ns::u] \
sl@0:        [testsetnoerr ns::v b] \
sl@0:        [testseterr ns::u] \
sl@0:        [unset ns::v; testseterr ns::v b]
sl@0: } [list {before get a} {before set b} {before get a} {before set b}]
sl@0: test var-9.3 {behaviour of TclGetVar no variable} {
sl@0:     catch {unset u}
sl@0:     list \
sl@0:        [catch {testsetnoerr u} res] $res \
sl@0:        [catch {testseterr u} res] $res
sl@0: } {1 {before get} 1 {can't read "u": no such variable}}
sl@0: test var-9.4 {behaviour of TclGetVar no namespace variable} {
sl@0:     catch {namespace delete ns}
sl@0:     namespace eval ns {}
sl@0:     list \
sl@0:        [catch {testsetnoerr ns::w} res] $res \
sl@0:        [catch {testseterr ns::w} res] $res
sl@0: } {1 {before get} 1 {can't read "ns::w": no such variable}}
sl@0: test var-9.5 {behaviour of TclGetVar no namespace} {
sl@0:     catch {namespace delete ns}
sl@0:     list \
sl@0:        [catch {testsetnoerr ns::u} res] $res \
sl@0:        [catch {testseterr ns::v} res] $res
sl@0: } {1 {before get} 1 {can't read "ns::v": no such variable}}
sl@0: test var-9.6 {behaviour of TclSetVar no namespace} {
sl@0:     catch {namespace delete ns}
sl@0:     list \
sl@0:        [catch {testsetnoerr ns::v 1} res] $res \
sl@0:        [catch {testseterr ns::v 1} res] $res
sl@0: } {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
sl@0: test var-9.7 {behaviour of TclGetVar array variable} {
sl@0:     catch {unset arr}
sl@0:     set arr(1) 1;
sl@0:     list \
sl@0:        [catch {testsetnoerr arr} res] $res \
sl@0:        [catch {testseterr arr} res] $res
sl@0: } {1 {before get} 1 {can't read "arr": variable is array}}
sl@0: test var-9.8 {behaviour of TclSetVar array variable} {
sl@0:     catch {unset arr}
sl@0:     set arr(1) 1
sl@0:     list \
sl@0:        [catch {testsetnoerr arr 2} res] $res \
sl@0:        [catch {testseterr arr 2} res] $res
sl@0: } {1 {before set} 1 {can't set "arr": variable is array}}
sl@0: test var-9.9 {behaviour of TclGetVar read trace success} {
sl@0:     proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
sl@0:     catch {unset u}; catch {unset v}
sl@0:     set u 10
sl@0:     trace var u r [list resetvar 1]
sl@0:     trace var v r [list resetvar 2]
sl@0:     list \
sl@0:        [testsetnoerr u] \
sl@0:        [testseterr v]
sl@0: } {{before get 1} {before get 2}}
sl@0: test var-9.10 {behaviour of TclGetVar read trace error} {
sl@0:     proc writeonly args {error "write-only"}
sl@0:     set v 456
sl@0:     trace var v r writeonly
sl@0:     list \
sl@0:        [catch {testsetnoerr v} msg] $msg \
sl@0:        [catch {testseterr v} msg] $msg
sl@0: } {1 {before get} 1 {can't read "v": write-only}}
sl@0: test var-9.11 {behaviour of TclSetVar write trace success} {
sl@0:     proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
sl@0:     catch {unset u}; catch {unset v}
sl@0:     set v 1
sl@0:     trace var v w doubleval
sl@0:     trace var u w doubleval
sl@0:     list \
sl@0:        [testsetnoerr u 2] \
sl@0:        [testseterr v 3]
sl@0: } {{before set 4} {before set 6}}
sl@0: test var-9.12 {behaviour of TclSetVar write trace error} {
sl@0:     proc readonly args {error "read-only"}
sl@0:     set v 456
sl@0:     trace var v w readonly
sl@0:     list \
sl@0:        [catch {testsetnoerr v 2} msg] $msg $v \
sl@0:        [catch {testseterr v 3} msg] $msg $v
sl@0: } {1 {before set} 2 1 {can't set "v": read-only} 3}
sl@0: }
sl@0: test var-10.1 {can't nest arrays with array set} {
sl@0:    catch {unset arr}
sl@0:    list [catch {array set arr(x) {a 1 b 2}} res] $res
sl@0: } {1 {can't set "arr(x)": variable isn't array}}
sl@0: 
sl@0: test var-10.2 {can't nest arrays with array set} {
sl@0:    catch {unset arr}
sl@0:    list [catch {array set arr(x) {}} res] $res
sl@0: } {1 {can't set "arr(x)": variable isn't array}}
sl@0: 
sl@0: test var-11.1 {array unset} {
sl@0:     catch {unset a}
sl@0:     array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
sl@0:     array unset a 1,*
sl@0:     lsort -dict [array names a]
sl@0: } {2,1 2,3}
sl@0: test var-11.2 {array unset} {
sl@0:     catch {unset a}
sl@0:     array set a { 1,1 a 1,2 b }
sl@0:     array unset a
sl@0:     array exists a
sl@0: } 0
sl@0: test var-11.3 {array unset errors} {
sl@0:     catch {unset a}
sl@0:     array set a { 1,1 a 1,2 b }
sl@0:     list [catch {array unset a pattern too} msg] $msg
sl@0: } {1 {wrong # args: should be "array unset arrayName ?pattern?"}}
sl@0: 
sl@0: test var-12.1 {TclFindCompiledLocals, {} array name} {
sl@0:     namespace eval n {
sl@0: 	proc p {} {
sl@0: 	    variable {}
sl@0: 	    set (0) 0
sl@0: 	    set (1) 1
sl@0: 	    set n 2
sl@0: 	    set ($n) 2
sl@0: 	    set ($n,foo) 2
sl@0: 	}
sl@0: 	p
sl@0: 	lsort -dictionary [array names {}]
sl@0:     }
sl@0: } {0 1 2 2,foo}
sl@0: 
sl@0: test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
sl@0:     catch {unset t}
sl@0:     proc foo {var ind op} {
sl@0: 	global t
sl@0: 	set foo bar
sl@0:     }
sl@0:     namespace eval :: {
sl@0: 	set t(1) 1
sl@0: 	trace variable t(1) u foo
sl@0: 	unset t
sl@0:     }
sl@0:     set x "If you see this, it worked"
sl@0: } "If you see this, it worked"
sl@0: 
sl@0: test var-14.1 {array names syntax} -body {
sl@0:     array names foo bar baz snafu
sl@0: } -returnCodes 1 -match glob -result *
sl@0: 
sl@0: test var-15.1 {segfault in [unset], [Bug 735335]} {
sl@0:     proc A { name } {
sl@0: 	upvar $name var
sl@0: 	set var $name
sl@0:     }
sl@0:     #
sl@0:     # Note that the variable name has to be 
sl@0:     # unused previously for the segfault to
sl@0:     # be triggered.
sl@0:     #
sl@0:     namespace eval test A useSomeUnlikelyNameHere
sl@0:     namespace eval test unset useSomeUnlikelyNameHere
sl@0: } {}
sl@0: 
sl@0: test var-16.1 {CallVarTraces: save/restore interp error state: 1038021} {
sl@0:     trace add variable errorCode write { ;#}
sl@0:     catch {error foo bar baz}
sl@0:     trace remove variable errorCode write { ;#}
sl@0:     set errorInfo
sl@0: } bar
sl@0: 
sl@0: test var-17.1 {TclArraySet [Bug 1669489]} -setup {
sl@0:     unset -nocomplain ::a
sl@0: } -body {
sl@0:     namespace eval :: {
sl@0:         set elements {1 2 3 4}
sl@0:         trace add variable a write {string length $elements ;#}
sl@0:         array set a $elements
sl@0:     }
sl@0: } -cleanup {
sl@0:     unset -nocomplain ::a ::elements
sl@0: } -result {}
sl@0: 
sl@0: catch {namespace delete ns}
sl@0: catch {unset arr}
sl@0: catch {unset v}
sl@0: 
sl@0: catch {rename p ""}
sl@0: catch {namespace delete test_ns_var}
sl@0: catch {namespace delete test_ns_var2}
sl@0: catch {unset xx}
sl@0: catch {unset x}
sl@0: catch {unset y}
sl@0: catch {unset i}
sl@0: catch {unset a}
sl@0: catch {unset xxxxx}
sl@0: catch {unset aaaaa}
sl@0: 
sl@0: # cleanup
sl@0: ::tcltest::cleanupTests
sl@0: return