# 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 © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 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.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [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]]
if {[testConstraint memory]} {
    proc getbytes {} {
	return [lindex [split [memory info] \n] 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}


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-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list € ä] {info vars}
} -body {
    # test variable with non-ascii name is available (euro and a-uml chars here):
    list \
	[p 1 2] \
	[apply [list [list € ä] {info vars}] 1 2] \
	[apply [list [list [list € €] [list ä ä]] {info vars}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list € ä]]
test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list [list € v€] [list ä vä]] {list [set €] [set ä]}
} -body {
    # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here):
    list \
	[p] \
	[apply [list [list € ä] {list [set €] [set ä]}] v€ vä] \
	[apply [list [list [list € v€] [list ä vä]] {list [set €] [set ä]}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list v€ vä]]

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 2 a {} vv namespace
	}
	p
    }
    # Modified: that should create a global var according to the docs!
    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 add var v unset [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} -result {{} {test_ns_var::v {} unset}}
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 add var v unset ::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 {} unset}}

test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
    proc ::t {a i o} {
	set $a 321
    }
} -body {
    leaktest {
	namespace eval n {
	    variable v 123
	    trace add variable v unset ::t
	}
	namespace delete n
    }
} -cleanup {
    rename ::t {}
} -result 0

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 add var u read [list resetvar 1]
    trace add var v read [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 add var v read 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 add var v write doubleval
    trace add var u write 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 add var v write 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 add variable t(1) unset foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
	unset a([array nextelement a $s])
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}
test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
	unset a(ff)
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}

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-17.2 {TclArraySet Dict shortcut only on pure value} -setup {
    unset -nocomplain a d
    set d {p 1 p 2}
    dict get $d p
    set foo 0
} -body {
    trace add variable a write "[list incr [namespace which -variable foo]];#"
    array set a $d
    set foo
} -cleanup {
    unset -nocomplain a d foo
} -result 2

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-20.11 {array set don't compile bad initializer} -setup {
    unset -nocomplain foo
    trace add variable foo array {set foo(bar) baz;#}
} -body {
    catch {array set foo bad}
    set foo(bar)
} -cleanup {
    unset -nocomplain foo
} -result baz
test var-20.12 {array set don't compile bad initializer} -setup {
    unset -nocomplain ::foo
    trace add variable ::foo array {set ::foo(bar) baz;#}
} -body {
    catch {apply {{} {
	set value bad
	array set ::foo $value

    }}}
    set ::foo(bar)
} -cleanup {
    unset -nocomplain ::foo
} -result baz

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 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 doit {}
} -result 0
test var-22.1 {leak in localVarName internalrep: Bug 80304238ac} -setup {
    proc doit {} {
	interp create child
	child eval {
	    proc doit script {
		eval $script
		set foo bar
	    }
	    doit {foreach foo baz {}}
	}
	interp delete child
    }
} -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 doit {}
} -result 0
test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
    array for {k v} {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.3 {array command, for loop, too many list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v w} a {}
} -result {must have two variable names}
test var-23.4 {array command, for loop, not enough list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k} a {}
} -result {must have two variable names}
test var-23.5 {array command, for loop, no array} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v} a {}
} -result {"a" isn't an array}
test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    apply {{x} {
	if {$x==1} {
	    return [array for {k v} a {}]
	}
	set a(x) 123
    }} 1
} -result {"a" isn't an array}
test var-23.7 {array enumeration} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 3}
test var-23.9 {array enumeration, nested} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k1 v1} a {
	lappend reslist $k1 $v1
	set r2 {}
	array for {k2 v2} a {
	    lappend r2 $k2 $v2
	}
	lappend reslist [lsort -stride 2 -index 0 $r2]
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 3 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -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}}
test var-23.10 {array enumeration, delete key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
	lappend reslist $k $v
	  if { $k eq "a" } {
	    unset a(c)
	  }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
    set retval
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
    unset -nocomplain retval
} -result {array changed during iteration*}
test var-23.11 {array enumeration, insert key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
	lappend reslist $k $v
	  if { $k eq "a" } {
	    set a(e) 5
	  }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {array changed during iteration*}
test var-23.12 {array enumeration, change value} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
	if { $k eq "a" } {
	  set a(c) 9
	}
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 9}
test var-23.13 {array enumeration, number of traces} -setup {
    set ::countarrayfor 0
    proc ::tracearrayfor { args } {
      incr ::countarrayfor
    }
    unset -nocomplain ::a
    set reslist [list]
} -body {
    array set ::a {a 1 b 2 c 3}
    foreach {k} [array names a] {
      trace add variable ::a($k) read ::tracearrayfor
    }
    array for {k v} ::a {
	lappend reslist $k $v
    }
    set ::countarrayfor
} -cleanup {
    unset -nocomplain ::countarrayfor
    unset -nocomplain ::a
    unset -nocomplain reslist
} -result 3
test var-23.14 {array for, shared arguments} -setup {
    set vn {k v}
    unset -nocomplain $vn
} -body {
    array set $vn {a 1 b 2 c 3}
    array for $vn $vn {}
} -cleanup {
    unset -nocomplain $vn vn
} -result {}

test var-24.1 {array default set and get: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	[array default get ary]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 1 0 7}
test var-24.2 {array default set and get: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	    [array default get ary]
    }}
} {3 7 1 0 7}
test var-24.3 {array default unset: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 {} 3 1}
test var-24.4 {array default unset: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
	    [catch {set ary(b)}]
    }}
} {3 7 {} 3 1}
test var-24.5 {array default exists: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array set ary {a 3}
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 7
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 11
    lappend result [info exists ary],[array exists ary],[array default exists ary]
} -cleanup {
    unset -nocomplain ary result
} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.6 {array default exists: compiled} {
    apply {{} {
	array set ary {a 3}
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 7
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 11
	lappend result [info exists ary],[array exists ary],[array default exists ary]
    }}
} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.7 {array default and append: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    append ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    append ary(x) def
    append ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.8 {array default and append: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	append ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	append ary(x) def
	append ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.9 {array default and lappend: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    lappend ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    lappend ary(x) def
    lappend ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.10 {array default and lappend: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	lappend ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	lappend ary(x) def
	lappend ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.11 {array default and incr: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary 7
    lappend result [array size ary] [info exist ary(x)]
    incr ary(x) 11
    lappend result [array size ary] $ary(x)
    array default unset ary
    incr ary(x)
    incr ary(y)
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 18 2 19 1}
test var-24.12 {array default and incr: compiled} {
    apply {{} {
	array default set ary 7
	lappend result [array size ary] [info exist ary(x)]
	incr ary(x) 11
	lappend result [array size ary] $ary(x)
	array default unset ary
	incr ary(x)
	incr ary(y)
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 18 2 19 1}
test var-24.13 {array default and dict: interpreted} -setup {
    unset -nocomplain ary x y z
} -body {
    array default set ary {x y}
    dict lappend ary(p) x z
    dict update ary(q) x y {
	set y z
    }
    dict with ary(r) {
	set x 123
    }
    lsort -stride 2 -index 0 [array get ary]
} -cleanup {
    unset -nocomplain ary x y z
} -result {p {x {y z}} q {x z} r {x 123}}
test var-24.14 {array default and dict: compiled} {
    lsort -stride 2 -index 0 [apply {{} {
	array default set ary {x y}
	dict lappend ary(p) x z
	dict update ary(q) x y {
	    set y z
	}
	dict with ary(r) {
	    set x 123
	}
	array get ary
    }}]
} {p {x {y z}} q {x z} r {x 123}}
test var-24.15 {array default set and get: two-level} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	apply {{} {
	    upvar 1 ary ary ary(c) c
	    lappend result $ary(a) $ary(b) $c
	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
	    lappend result [array default get ary]
	}}
    }}
} {3 7 7 1 0 0 7}
test var-24.16 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default set ary 7
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {can't array default set "ary": variable isn't array}
test var-24.17 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.18 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.19 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default get ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.20 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    array default get ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.21 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default exists ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.22 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    array default exists ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.23 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default unset ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

# The const command
test var-25.1 {const: no argument} -body {
    apply {{} {
	const
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.2 {const: single argument} -body {
    apply {{} {
	const X
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.3 {const: two arguments (basic correct usage)} {
    apply {{} {
	set res [const X gorp]
	return [list $res $X]
    }}
} {{} gorp}
test var-25.4 {const: three arguments} -body {
    apply {{} {
	const X gorp foo
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.5 {const: four arguments} -body {
    apply {{} {
	const X gorp foo bar
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.6 {const: non-existing namespace Bug [4b22d84a62]} -body {
    apply {{} {
	const ::nosuchns::x 10
    }}
} -returnCodes error -result {can't const "::nosuchns::x": parent namespace doesn't exist}
test var-25.7 {const: non-existing namespace Bug [4b22d84a62] - non compiled} -body {
    apply {{} {
	set const const
	$const ::nosuchns::x 10
    }}
} -returnCodes error -result {can't const "::nosuchns::x": parent namespace doesn't exist}

test var-26.1 {const: unmodifiable by set} -body {
    apply {{} {
	const X 123
	set X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.2 {const: unmodifiable by append} -body {
    apply {{} {
	const X 123
	append X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.3 {const: unmodifiable by lappend} -body {
    apply {{} {
	const X 123
	lappend X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.4 {const: unmodifiable by incr} -body {
    apply {{} {
	const X 123
	incr X
    }}
} -returnCodes error -result {can't incr "X": variable is a constant}
test var-26.5 {const: unmodifiable by dict set} -body {
    apply {{} {
	const X {a 123}
	dict set X a gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.6 {const: unmodifiable by regsub} -body {
    apply {{} {
	const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var26.7.txt]
    set f [open $file]
} -body {
    apply {f {
	const X abcabc
	gets $f X
    }} $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {can't set "X": variable is a constant}
test var-26.8 {const: may not be array} -body {
    apply {{} {
	array set X {a b}
	const X 1
	return $X
    }}
} -returnCodes error -result {can't make constant "X": variable is array}
test var-26.9.1 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(a) 1
	return $X(a)
    }}
} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array}
test var-26.9.2 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(b) 1
	return $X(b)
    }}
} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array}
test var-26.10.1 {const: unmodifiable by const but not an error} {
    apply {{} {
	const X 1
	const X 2
	return $X
    }}
} 1
test var-26.10.2 {const: unmodifiable by const but not an error} {
    apply {{} {
	lmap x {1 2 3} {
	    const A 2
	    const B 3
	    const C 5
	    expr {$A * $x**2 + $B * $x + $C}
	}
    }}
} {10 19 32}
test var-26.11 {const: may not be unset} -body {
   apply {{} {
	const X 1
	unset X
   }}
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-26.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {{} {
	const X 1
	unset -nocomplain X
	return $X
   }}
} 1
test var-26.13 {const and traces: write trace causes fail} -body {
    apply {{} {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	const X gorp
	return $X
    }}
} -returnCodes error -result {can't set "X": ERR: X {} write}
test var-26.14 {const and traces: write trace err causes no const} -body {
    apply {{} {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {
	    const X gorp
	}
	trace remove variable X write $trace
	set X 123
	return $X
    }}
} -result 123
test var-26.15 {const and traces: read traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {{} {
	trace add variable X read {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	list $X $X $::traces
    }}
} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup {
    unset -nocomplain traces
}
test var-26.16 {const and traces: write traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {{} {
	trace add variable X write {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	const X foo
	catch {set X bar}
	list $X $::traces
    }}
} -result {gorp {{X {} write}}} -cleanup {
    unset -nocomplain traces
}
test var-26.17 {const and traces: unset traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    list {*}[apply {{} {
	trace add variable X unset {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	unset -nocomplain X
	list $X $::traces
    }}] $traces
} -result {gorp {} {{X {} unset}}} -cleanup {
    unset -nocomplain traces
}

# Same [const], but definitely not compiled
test var-27.1 {const: unmodifiable by set} -body {
    apply {const {
	$const X 123
	set X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.2 {const: unmodifiable by append} -body {
    apply {const {
	$const X 123
	append X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.3 {const: unmodifiable by lappend} -body {
    apply {const {
	$const X 123
	lappend X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.4 {const: unmodifiable by incr} -body {
    apply {const {
	$const X 123
	incr X
    }} const
} -returnCodes error -result {can't incr "X": variable is a constant}
test var-27.5 {const: unmodifiable by dict set} -body {
    apply {const {
	$const X {a 123}
	dict set X a gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.6 {const: unmodifiable by regsub} -body {
    apply {const {
	$const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var27.7.txt]
    set f [open $file]
} -body {
    apply {{const f} {
	$const X abcabc
	gets $f X
    }} const $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {can't set "X": variable is a constant}
test var-27.8 {const: may not be array} -body {
    apply {const {
	array set X {a b}
	$const X 1
	return $X
    }} const
} -returnCodes error -result {can't make constant "X": variable is array}
test var-27.9.1 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(a) 1
	return $X(a)
    }} const
} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array}
test var-27.9.2 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(b) 1
	return $X(b)
    }} const
} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array}
test var-27.10.1 {const: unmodifiable by const but not an error} {
    apply {const {
	$const X 1
	$const X 2
	return $X
    }} const
} 1
test var-27.10.2 {const: unmodifiable by const but not an error} {
    apply {const {
	lmap x {1 2 3} {
	    $const A 2
	    $const B 3
	    $const C 5
	    expr {$A * $x**2 + $B * $x + $C}
	}
    }} const
} {10 19 32}
test var-27.11 {const: may not be unset} -body {
   apply {const {
	$const X 1
	unset X
   }} const
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-27.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {const {
	$const X 1
	unset -nocomplain X
	return $X
   }} const
} 1
test var-27.13 {const and traces: write trace causes fail} -body {
    apply {const {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	$const X gorp
	return $X
    }} const
} -returnCodes error -result {can't set "X": ERR: X {} write}
test var-27.14 {const and traces: write trace err causes no const} -body {
    apply {const {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {
	    $const X gorp
	}
	trace remove variable X write $trace
	set X 123
	return $X
    }} const
} -result 123
test var-27.15 {const and traces: read traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {const {
	trace add variable X read {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	list $X $X $::traces
    }} const
} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup {
    unset -nocomplain traces
}
test var-27.16 {const and traces: write traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {const {
	trace add variable X write {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	$const X foo
	catch {set X bar}
	list $X $::traces
    }} const
} -result {gorp {{X {} write}}} -cleanup {
    unset -nocomplain traces
}
test var-27.17 {const and traces: unset traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    list {*}[apply {const {
	trace add variable X unset {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	unset -nocomplain X
	list $X $::traces
    }} const] $traces
} -result {gorp {} {{X {} unset}}} -cleanup {
    unset -nocomplain traces
}

test var-28.1 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
	return $X
    }
} -cleanup {
    namespace delete var28
} -result gorp
test var-28.2 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    apply {{} {
	variable X
	set X 123
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {can't set "X": variable is a constant}
test var-28.3 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    apply {{} {
	variable X
	unset X
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-28.4 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    namespace delete var28
    namespace eval var28 {
	variable X abc
    }
    apply {{} {
	variable X
	return $X
    } var28}
} -cleanup {
    namespace delete var28
} -result abc
test var-28.5 {const: in a namespace, direct access from proc} -setup {
    namespace eval var28 {}
} -body {
    set result [apply {{} {
	const ::var28::X abc
	# Constant in namespace, NOT locally!
	info exists X
    }}]
    apply {res {
	variable X
	list $res [catch {unset X} msg] $msg $X
    } var28} $result
} -cleanup {
    namespace delete var28
} -result {0 1 {can't unset "X": variable is a constant} abc}

test var-29.1 {const: globally} -setup {
    set int [interp create]
} -body {
    $int eval {
	const X gorp
	apply {{} {
	    global X
	    return $X
	}}
    }
} -cleanup {
    interp delete $int
} -result gorp
test var-29.2 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	variable X
	constructor {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.3 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	private variable X
	constructor {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.4 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	variable X
	constructor {} {
	    set X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
		set X gorp
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {0 abc} {0 gorp} 0 {}}
test var-29.5 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	variable X
	method init {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.6 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	private variable X
	method init {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.7 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	variable X
	method init {} {
	    set X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg
	}
	method checkUnset {} {
	    list [catch {
		unset X
		set X gorp
	    } msg] $msg
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {0 abc} {0 gorp} 0 {}}

# The info constant and info consts commands
test var-30.1 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts]] [info constant X]
	const X 1
	lappend consts [lsort [info consts]] [info constant X]
	const Y 2
	lappend consts [lsort [info consts]]
	const X 3
	lappend consts [lsort [info consts]]
    }}
} {{} 0 X 1 {X Y} {X Y}}
test var-30.2 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts X]]
	const X 1
	lappend consts [lsort [info consts X]]
	const Y 2
	lappend consts [lsort [info consts X]]
	const X 3
	lappend consts [lsort [info consts X]]
    }}
} {{} X X X}
test var-30.3 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts ?]]
	const X 1
	lappend consts [lsort [info consts ?]]
	const Y 2
	lappend consts [lsort [info consts ?]]
	const XX 3
	lappend consts [lsort [info consts ?]]
    }}
} {{} X {X Y} {X Y}}
test var-30.4 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts X]]
	set X 1
	lappend consts [lsort [info consts X]]
	set Y 2
	lappend consts [lsort [info consts X]]
	set X 3
	lappend consts [lsort [info consts X]]
    }}
} {{} {} {} {}}
test var-30.5 {info consts: in a namespace} -setup {
    namespace eval var30 {}
} -body {
    namespace eval var30 {
	const X gorp
	info consts
    }
} -cleanup {
    namespace delete var30
} -result X
test var-30.6 {info consts: in a namespace} -setup {
    namespace eval var30 {}
} -body {
    namespace eval var30 {
	const X gorp
	variable Y foo
    }
    info consts var30::*
} -cleanup {
    namespace delete var30
} -result ::var30::X
test var-30.7 {info constant: bad constant names: array element} {
    apply {{} {
	info constant a(b)
    }}
} 0
test var-30.8 {info constant: bad constant names: array} {
    apply {{} {
	array set a {}
	info constant a
    }}
} 0
test var-30.9 {info constant: bad constant names: no var} {
    apply {{} {
	info constant a
    }}
} 0
test var-30.10 {info constant: bad constant names: no namespace} {
    apply {{} {
	info constant ::var29::no::such::ns::a
    }}
} 0
test var-30.11 {info constant: bad constant names: dangling upvar} {
    apply {{} {
	upvar 0 no_var a
	info constant a
    }}
} 0
test var-30.12 {info constant: bad constant names: bad name} {
    apply {{} {
	info constant a(b
    }}
} 0
test var-30.13 {info constant: bad constant names: nesting} {
    apply {{} {
	array set b {c d}
	upvar 0 b(c) a
	info constant a(d)
    }}
} 0

test var-31.1 {info constant: syntax} -returnCodes error -body {
    info constant
} -result {wrong # args: should be "info constant varName"}
test var-31.2 {info constant: syntax} -returnCodes error -body {
    info constant foo bar
} -result {wrong # args: should be "info constant varName"}
test var-31.3 {info consts: syntax} -returnCodes error -body {
    info consts foo bar
} -result {wrong # args: should be "info consts ?pattern?"}

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
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:
