|
sl@0
|
1 |
# This file contains tests for the tclVar.c source file. Tests appear in
|
|
sl@0
|
2 |
# the same order as the C code that they test. The set of tests is
|
|
sl@0
|
3 |
# currently incomplete since it currently includes only new tests for
|
|
sl@0
|
4 |
# code changed for the addition of Tcl namespaces. Other variable-
|
|
sl@0
|
5 |
# related tests appear in several other test files including
|
|
sl@0
|
6 |
# namespace.test, set.test, trace.test, and upvar.test.
|
|
sl@0
|
7 |
#
|
|
sl@0
|
8 |
# Sourcing this file into Tcl runs the tests and generates output for
|
|
sl@0
|
9 |
# errors. No output means no errors were found.
|
|
sl@0
|
10 |
#
|
|
sl@0
|
11 |
# Copyright (c) 1997 Sun Microsystems, Inc.
|
|
sl@0
|
12 |
# Copyright (c) 1998-1999 by Scriptics Corporation.
|
|
sl@0
|
13 |
#
|
|
sl@0
|
14 |
# See the file "license.terms" for information on usage and redistribution
|
|
sl@0
|
15 |
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
sl@0
|
16 |
#
|
|
sl@0
|
17 |
# RCS: @(#) $Id: var.test,v 1.20.2.4 2007/03/13 15:59:53 dgp Exp $
|
|
sl@0
|
18 |
#
|
|
sl@0
|
19 |
|
|
sl@0
|
20 |
if {[lsearch [namespace children] ::tcltest] == -1} {
|
|
sl@0
|
21 |
package require tcltest 2.2
|
|
sl@0
|
22 |
namespace import -force ::tcltest::*
|
|
sl@0
|
23 |
}
|
|
sl@0
|
24 |
|
|
sl@0
|
25 |
catch {rename p ""}
|
|
sl@0
|
26 |
catch {namespace delete test_ns_var}
|
|
sl@0
|
27 |
catch {unset xx}
|
|
sl@0
|
28 |
catch {unset x}
|
|
sl@0
|
29 |
catch {unset y}
|
|
sl@0
|
30 |
catch {unset i}
|
|
sl@0
|
31 |
catch {unset a}
|
|
sl@0
|
32 |
catch {unset arr}
|
|
sl@0
|
33 |
|
|
sl@0
|
34 |
test var-1.1 {TclLookupVar, Array handling} {
|
|
sl@0
|
35 |
catch {unset a}
|
|
sl@0
|
36 |
set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
|
|
sl@0
|
37 |
set i 10
|
|
sl@0
|
38 |
set arr(foo) 37
|
|
sl@0
|
39 |
list [$x i] $i [$x arr(foo)] $arr(foo)
|
|
sl@0
|
40 |
} {11 11 38 38}
|
|
sl@0
|
41 |
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
|
|
sl@0
|
42 |
set x "global value"
|
|
sl@0
|
43 |
namespace eval test_ns_var {
|
|
sl@0
|
44 |
variable x "namespace value"
|
|
sl@0
|
45 |
proc p {} {
|
|
sl@0
|
46 |
global x ;# specifies TCL_GLOBAL_ONLY to get global x
|
|
sl@0
|
47 |
return $x
|
|
sl@0
|
48 |
}
|
|
sl@0
|
49 |
}
|
|
sl@0
|
50 |
test_ns_var::p
|
|
sl@0
|
51 |
} {global value}
|
|
sl@0
|
52 |
test var-1.3 {TclLookupVar, TCL_NAMESPACE_ONLY implies namespace var} {
|
|
sl@0
|
53 |
namespace eval test_ns_var {
|
|
sl@0
|
54 |
proc q {} {
|
|
sl@0
|
55 |
variable x ;# specifies TCL_NAMESPACE_ONLY to get namespace x
|
|
sl@0
|
56 |
return $x
|
|
sl@0
|
57 |
}
|
|
sl@0
|
58 |
}
|
|
sl@0
|
59 |
test_ns_var::q
|
|
sl@0
|
60 |
} {namespace value}
|
|
sl@0
|
61 |
test var-1.4 {TclLookupVar, no active call frame implies global namespace var} {
|
|
sl@0
|
62 |
set x
|
|
sl@0
|
63 |
} {global value}
|
|
sl@0
|
64 |
test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
|
|
sl@0
|
65 |
namespace eval test_ns_var {set x}
|
|
sl@0
|
66 |
} {namespace value}
|
|
sl@0
|
67 |
test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
|
|
sl@0
|
68 |
namespace eval test_ns_var {set ::x}
|
|
sl@0
|
69 |
} {global value}
|
|
sl@0
|
70 |
test var-1.7 {TclLookupVar, error finding namespace var} {
|
|
sl@0
|
71 |
list [catch {set a:::b} msg] $msg
|
|
sl@0
|
72 |
} {1 {can't read "a:::b": no such variable}}
|
|
sl@0
|
73 |
test var-1.8 {TclLookupVar, error finding namespace var} {
|
|
sl@0
|
74 |
list [catch {set ::foobarfoo} msg] $msg
|
|
sl@0
|
75 |
} {1 {can't read "::foobarfoo": no such variable}}
|
|
sl@0
|
76 |
test var-1.9 {TclLookupVar, create new namespace var} {
|
|
sl@0
|
77 |
namespace eval test_ns_var {
|
|
sl@0
|
78 |
set v hello
|
|
sl@0
|
79 |
}
|
|
sl@0
|
80 |
} {hello}
|
|
sl@0
|
81 |
test var-1.10 {TclLookupVar, create new namespace var} {
|
|
sl@0
|
82 |
catch {unset y}
|
|
sl@0
|
83 |
namespace eval test_ns_var {
|
|
sl@0
|
84 |
set ::y 789
|
|
sl@0
|
85 |
}
|
|
sl@0
|
86 |
set y
|
|
sl@0
|
87 |
} {789}
|
|
sl@0
|
88 |
test var-1.11 {TclLookupVar, error creating new namespace var} {
|
|
sl@0
|
89 |
namespace eval test_ns_var {
|
|
sl@0
|
90 |
list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
|
|
sl@0
|
91 |
}
|
|
sl@0
|
92 |
} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
|
|
sl@0
|
93 |
test var-1.12 {TclLookupVar, error creating new namespace var} {
|
|
sl@0
|
94 |
namespace eval test_ns_var {
|
|
sl@0
|
95 |
list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
|
|
sl@0
|
96 |
}
|
|
sl@0
|
97 |
} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
|
|
sl@0
|
98 |
test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
|
|
sl@0
|
99 |
catch {unset aNeWnAmEiNnS}
|
|
sl@0
|
100 |
namespace eval test_ns_var {
|
|
sl@0
|
101 |
namespace eval test_ns_var2::test_ns_var3 {
|
|
sl@0
|
102 |
set aNeWnAmEiNnS 77777
|
|
sl@0
|
103 |
}
|
|
sl@0
|
104 |
# namespace which builds a name by traversing nsPtr chain to ::
|
|
sl@0
|
105 |
namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
|
|
sl@0
|
106 |
}
|
|
sl@0
|
107 |
} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
|
|
sl@0
|
108 |
test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
|
|
sl@0
|
109 |
namespace eval test_ns_var {
|
|
sl@0
|
110 |
set : 123
|
|
sl@0
|
111 |
set v: 456
|
|
sl@0
|
112 |
set x:y: 789
|
|
sl@0
|
113 |
list [set :] [set v:] [set x:y:] \
|
|
sl@0
|
114 |
${:} ${v:} ${x:y:} \
|
|
sl@0
|
115 |
[expr {[lsearch [info vars] :] != -1}] \
|
|
sl@0
|
116 |
[expr {[lsearch [info vars] v:] != -1}] \
|
|
sl@0
|
117 |
[expr {[lsearch [info vars] x:y:] != -1}]
|
|
sl@0
|
118 |
}
|
|
sl@0
|
119 |
} {123 456 789 123 456 789 1 1 1}
|
|
sl@0
|
120 |
test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
|
|
sl@0
|
121 |
namespace eval test_ns_var {
|
|
sl@0
|
122 |
variable foo 2
|
|
sl@0
|
123 |
}
|
|
sl@0
|
124 |
proc p {} {
|
|
sl@0
|
125 |
variable ::test_ns_var::foo
|
|
sl@0
|
126 |
lappend result [catch {set foo} msg] $msg
|
|
sl@0
|
127 |
namespace delete ::test_ns_var
|
|
sl@0
|
128 |
lappend result [catch {set foo 3} msg] $msg
|
|
sl@0
|
129 |
lappend result [catch {set foo(3) 3} msg] $msg
|
|
sl@0
|
130 |
}
|
|
sl@0
|
131 |
p
|
|
sl@0
|
132 |
} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
|
|
sl@0
|
133 |
test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} {
|
|
sl@0
|
134 |
namespace eval test_ns_var {
|
|
sl@0
|
135 |
variable result
|
|
sl@0
|
136 |
namespace eval subns {
|
|
sl@0
|
137 |
variable foo 2
|
|
sl@0
|
138 |
}
|
|
sl@0
|
139 |
upvar 0 subns::foo foo
|
|
sl@0
|
140 |
lappend result [catch {set foo} msg] $msg
|
|
sl@0
|
141 |
namespace delete subns
|
|
sl@0
|
142 |
lappend result [catch {set foo 3} msg] $msg
|
|
sl@0
|
143 |
lappend result [catch {set foo(3) 3} msg] $msg
|
|
sl@0
|
144 |
namespace delete [namespace current]
|
|
sl@0
|
145 |
set result
|
|
sl@0
|
146 |
}
|
|
sl@0
|
147 |
} {0 2 1 {can't set "foo": upvar refers to variable in deleted namespace} 1 {can't set "foo(3)": upvar refers to variable in deleted namespace}}
|
|
sl@0
|
148 |
test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array: compiled code path} {
|
|
sl@0
|
149 |
namespace eval test_ns_var {
|
|
sl@0
|
150 |
variable result
|
|
sl@0
|
151 |
proc p {} {
|
|
sl@0
|
152 |
array set x {1 2 3 4}
|
|
sl@0
|
153 |
upvar 0 x(1) foo
|
|
sl@0
|
154 |
lappend result [catch {set foo} msg] $msg
|
|
sl@0
|
155 |
unset x
|
|
sl@0
|
156 |
lappend result [catch {set foo 3} msg] $msg
|
|
sl@0
|
157 |
}
|
|
sl@0
|
158 |
set result [p]
|
|
sl@0
|
159 |
namespace delete [namespace current]
|
|
sl@0
|
160 |
set result
|
|
sl@0
|
161 |
}
|
|
sl@0
|
162 |
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
|
|
sl@0
|
163 |
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
|
|
sl@0
|
164 |
namespace eval test_ns_var {
|
|
sl@0
|
165 |
variable result {}
|
|
sl@0
|
166 |
variable x
|
|
sl@0
|
167 |
array set x {1 2 3 4}
|
|
sl@0
|
168 |
upvar 0 x(1) foo
|
|
sl@0
|
169 |
lappend result [catch {set foo} msg] $msg
|
|
sl@0
|
170 |
unset x
|
|
sl@0
|
171 |
lappend result [catch {set foo 3} msg] $msg
|
|
sl@0
|
172 |
namespace delete [namespace current]
|
|
sl@0
|
173 |
set result
|
|
sl@0
|
174 |
}
|
|
sl@0
|
175 |
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
|
|
sl@0
|
176 |
test var-1.19 {TclLookupVar, right error message when parsing variable name} {
|
|
sl@0
|
177 |
list [catch {[format set] thisvar(doesntexist)} msg] $msg
|
|
sl@0
|
178 |
} {1 {can't read "thisvar(doesntexist)": no such variable}}
|
|
sl@0
|
179 |
|
|
sl@0
|
180 |
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
|
|
sl@0
|
181 |
catch {unset x}
|
|
sl@0
|
182 |
lappend x 1 2
|
|
sl@0
|
183 |
} {1 2}
|
|
sl@0
|
184 |
|
|
sl@0
|
185 |
test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
|
|
sl@0
|
186 |
catch {unset x}
|
|
sl@0
|
187 |
set x 1997
|
|
sl@0
|
188 |
proc p {} {
|
|
sl@0
|
189 |
global x ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
|
|
sl@0
|
190 |
return $x
|
|
sl@0
|
191 |
}
|
|
sl@0
|
192 |
p
|
|
sl@0
|
193 |
} {1997}
|
|
sl@0
|
194 |
test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
|
|
sl@0
|
195 |
namespace eval test_ns_var {
|
|
sl@0
|
196 |
catch {unset v}
|
|
sl@0
|
197 |
variable v 1998
|
|
sl@0
|
198 |
proc p {} {
|
|
sl@0
|
199 |
variable v ;# TCL_NAMESPACE_ONLY specified for other var x
|
|
sl@0
|
200 |
return $v
|
|
sl@0
|
201 |
}
|
|
sl@0
|
202 |
p
|
|
sl@0
|
203 |
}
|
|
sl@0
|
204 |
} {1998}
|
|
sl@0
|
205 |
if {[info commands testupvar] != {}} {
|
|
sl@0
|
206 |
test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} {
|
|
sl@0
|
207 |
catch {unset a}
|
|
sl@0
|
208 |
set a 123321
|
|
sl@0
|
209 |
proc p {} {
|
|
sl@0
|
210 |
# create global xx linked to global a
|
|
sl@0
|
211 |
testupvar 1 a {} xx global
|
|
sl@0
|
212 |
}
|
|
sl@0
|
213 |
list [p] $xx [set xx 789] $a
|
|
sl@0
|
214 |
} {{} 123321 789 789}
|
|
sl@0
|
215 |
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} {
|
|
sl@0
|
216 |
catch {unset a}
|
|
sl@0
|
217 |
set a 456
|
|
sl@0
|
218 |
namespace eval test_ns_var {
|
|
sl@0
|
219 |
catch {unset ::test_ns_var::vv}
|
|
sl@0
|
220 |
proc p {} {
|
|
sl@0
|
221 |
# create namespace var vv linked to global a
|
|
sl@0
|
222 |
testupvar 1 a {} vv namespace
|
|
sl@0
|
223 |
}
|
|
sl@0
|
224 |
p
|
|
sl@0
|
225 |
}
|
|
sl@0
|
226 |
list $test_ns_var::vv [set test_ns_var::vv 123] $a
|
|
sl@0
|
227 |
} {456 123 123}
|
|
sl@0
|
228 |
}
|
|
sl@0
|
229 |
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
|
|
sl@0
|
230 |
catch {unset aaaaa}
|
|
sl@0
|
231 |
catch {unset xxxxx}
|
|
sl@0
|
232 |
set aaaaa 77777
|
|
sl@0
|
233 |
upvar #0 aaaaa xxxxx
|
|
sl@0
|
234 |
list [set xxxxx] [set aaaaa]
|
|
sl@0
|
235 |
} {77777 77777}
|
|
sl@0
|
236 |
test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
|
|
sl@0
|
237 |
catch {unset a}
|
|
sl@0
|
238 |
set a 121212
|
|
sl@0
|
239 |
namespace eval test_ns_var {
|
|
sl@0
|
240 |
upvar ::a vvv
|
|
sl@0
|
241 |
set vvv
|
|
sl@0
|
242 |
}
|
|
sl@0
|
243 |
} {121212}
|
|
sl@0
|
244 |
test var-3.7 {MakeUpvar, my var has ::s} {
|
|
sl@0
|
245 |
catch {unset a}
|
|
sl@0
|
246 |
set a 789789
|
|
sl@0
|
247 |
upvar #0 a test_ns_var::lnk
|
|
sl@0
|
248 |
namespace eval test_ns_var {
|
|
sl@0
|
249 |
set lnk
|
|
sl@0
|
250 |
}
|
|
sl@0
|
251 |
} {789789}
|
|
sl@0
|
252 |
test var-3.8 {MakeUpvar, my var already exists in global ns} {
|
|
sl@0
|
253 |
catch {unset aaaaa}
|
|
sl@0
|
254 |
catch {unset xxxxx}
|
|
sl@0
|
255 |
set aaaaa 456654
|
|
sl@0
|
256 |
set xxxxx hello
|
|
sl@0
|
257 |
upvar #0 aaaaa xxxxx
|
|
sl@0
|
258 |
set xxxxx
|
|
sl@0
|
259 |
} {hello}
|
|
sl@0
|
260 |
test var-3.9 {MakeUpvar, my var has invalid ns name} {
|
|
sl@0
|
261 |
catch {unset aaaaa}
|
|
sl@0
|
262 |
set aaaaa 789789
|
|
sl@0
|
263 |
list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
|
|
sl@0
|
264 |
} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
|
|
sl@0
|
265 |
test var-3.10 {MakeUpvar, } {
|
|
sl@0
|
266 |
namespace eval {} {
|
|
sl@0
|
267 |
set bar 0
|
|
sl@0
|
268 |
namespace eval foo upvar bar bar
|
|
sl@0
|
269 |
set foo::bar 1
|
|
sl@0
|
270 |
catch {list $bar $foo::bar} msg
|
|
sl@0
|
271 |
unset ::aaaaa
|
|
sl@0
|
272 |
set msg
|
|
sl@0
|
273 |
}
|
|
sl@0
|
274 |
} {1 1}
|
|
sl@0
|
275 |
|
|
sl@0
|
276 |
if {[info commands testgetvarfullname] != {}} {
|
|
sl@0
|
277 |
test var-4.1 {Tcl_GetVariableName, global variable} {
|
|
sl@0
|
278 |
catch {unset a}
|
|
sl@0
|
279 |
set a 123
|
|
sl@0
|
280 |
testgetvarfullname a global
|
|
sl@0
|
281 |
} ::a
|
|
sl@0
|
282 |
test var-4.2 {Tcl_GetVariableName, namespace variable} {
|
|
sl@0
|
283 |
namespace eval test_ns_var {
|
|
sl@0
|
284 |
variable george
|
|
sl@0
|
285 |
testgetvarfullname george namespace
|
|
sl@0
|
286 |
}
|
|
sl@0
|
287 |
} ::test_ns_var::george
|
|
sl@0
|
288 |
test var-4.3 {Tcl_GetVariableName, variable can't be array element} {
|
|
sl@0
|
289 |
catch {unset a}
|
|
sl@0
|
290 |
set a(1) foo
|
|
sl@0
|
291 |
list [catch {testgetvarfullname a(1) global} msg] $msg
|
|
sl@0
|
292 |
} {1 {unknown variable "a(1)"}}
|
|
sl@0
|
293 |
}
|
|
sl@0
|
294 |
|
|
sl@0
|
295 |
test var-5.1 {Tcl_GetVariableFullName, global variable} {
|
|
sl@0
|
296 |
catch {unset a}
|
|
sl@0
|
297 |
set a bar
|
|
sl@0
|
298 |
namespace which -variable a
|
|
sl@0
|
299 |
} {::a}
|
|
sl@0
|
300 |
test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
|
|
sl@0
|
301 |
namespace eval test_ns_var {
|
|
sl@0
|
302 |
variable martha
|
|
sl@0
|
303 |
namespace which -variable martha
|
|
sl@0
|
304 |
}
|
|
sl@0
|
305 |
} {::test_ns_var::martha}
|
|
sl@0
|
306 |
test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
|
|
sl@0
|
307 |
namespace which -variable test_ns_var::martha
|
|
sl@0
|
308 |
} {::test_ns_var::martha}
|
|
sl@0
|
309 |
|
|
sl@0
|
310 |
test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
|
|
sl@0
|
311 |
namespace eval test_ns_var {
|
|
sl@0
|
312 |
variable boeing 777
|
|
sl@0
|
313 |
}
|
|
sl@0
|
314 |
proc p {} {
|
|
sl@0
|
315 |
global ::test_ns_var::boeing
|
|
sl@0
|
316 |
set boeing
|
|
sl@0
|
317 |
}
|
|
sl@0
|
318 |
p
|
|
sl@0
|
319 |
} {777}
|
|
sl@0
|
320 |
test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
|
|
sl@0
|
321 |
namespace eval test_ns_var {
|
|
sl@0
|
322 |
namespace eval test_ns_nested {
|
|
sl@0
|
323 |
variable java java
|
|
sl@0
|
324 |
}
|
|
sl@0
|
325 |
proc p {} {
|
|
sl@0
|
326 |
global ::test_ns_var::test_ns_nested::java
|
|
sl@0
|
327 |
set java
|
|
sl@0
|
328 |
}
|
|
sl@0
|
329 |
}
|
|
sl@0
|
330 |
test_ns_var::p
|
|
sl@0
|
331 |
} {java}
|
|
sl@0
|
332 |
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
|
|
sl@0
|
333 |
set ::test_ns_var::test_ns_nested:: 24
|
|
sl@0
|
334 |
proc p {} {
|
|
sl@0
|
335 |
global ::test_ns_var::test_ns_nested::
|
|
sl@0
|
336 |
set {}
|
|
sl@0
|
337 |
}
|
|
sl@0
|
338 |
p
|
|
sl@0
|
339 |
} {24}
|
|
sl@0
|
340 |
test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
|
|
sl@0
|
341 |
# Test for Tcl Bug 480176
|
|
sl@0
|
342 |
set :v broken
|
|
sl@0
|
343 |
proc p {} {
|
|
sl@0
|
344 |
global :v
|
|
sl@0
|
345 |
set :v fixed
|
|
sl@0
|
346 |
}
|
|
sl@0
|
347 |
p
|
|
sl@0
|
348 |
set :v
|
|
sl@0
|
349 |
} {fixed}
|
|
sl@0
|
350 |
|
|
sl@0
|
351 |
test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
|
|
sl@0
|
352 |
catch {namespace delete test_ns_var}
|
|
sl@0
|
353 |
namespace eval test_ns_var {
|
|
sl@0
|
354 |
variable one 1
|
|
sl@0
|
355 |
}
|
|
sl@0
|
356 |
list [info vars test_ns_var::*] [set test_ns_var::one]
|
|
sl@0
|
357 |
} {::test_ns_var::one 1}
|
|
sl@0
|
358 |
test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
|
|
sl@0
|
359 |
set two 2222222
|
|
sl@0
|
360 |
namespace eval test_ns_var {
|
|
sl@0
|
361 |
variable two
|
|
sl@0
|
362 |
}
|
|
sl@0
|
363 |
list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
|
|
sl@0
|
364 |
} {0 1 {can't read "test_ns_var::two": no such variable}}
|
|
sl@0
|
365 |
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
|
|
sl@0
|
366 |
namespace eval test_ns_var {
|
|
sl@0
|
367 |
variable two 2
|
|
sl@0
|
368 |
}
|
|
sl@0
|
369 |
list [lsort [info vars test_ns_var::*]] \
|
|
sl@0
|
370 |
[namespace eval test_ns_var {set two}]
|
|
sl@0
|
371 |
} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
|
|
sl@0
|
372 |
test var-7.4 {Tcl_VariableObjCmd, list of vars} {
|
|
sl@0
|
373 |
namespace eval test_ns_var {
|
|
sl@0
|
374 |
variable three 3 four 4
|
|
sl@0
|
375 |
}
|
|
sl@0
|
376 |
list [lsort [info vars test_ns_var::*]] \
|
|
sl@0
|
377 |
[namespace eval test_ns_var {expr $three+$four}]
|
|
sl@0
|
378 |
} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
|
|
sl@0
|
379 |
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
|
|
sl@0
|
380 |
catch {unset a}
|
|
sl@0
|
381 |
catch {unset five}
|
|
sl@0
|
382 |
catch {unset six}
|
|
sl@0
|
383 |
set a ""
|
|
sl@0
|
384 |
set five 555
|
|
sl@0
|
385 |
set six 666
|
|
sl@0
|
386 |
namespace eval test_ns_var {
|
|
sl@0
|
387 |
variable five 5 six
|
|
sl@0
|
388 |
lappend a $five
|
|
sl@0
|
389 |
}
|
|
sl@0
|
390 |
lappend a $test_ns_var::five \
|
|
sl@0
|
391 |
[set test_ns_var::six 6] [set test_ns_var::six] $six
|
|
sl@0
|
392 |
catch {unset five}
|
|
sl@0
|
393 |
catch {unset six}
|
|
sl@0
|
394 |
set a
|
|
sl@0
|
395 |
} {5 5 6 6 666}
|
|
sl@0
|
396 |
catch {unset newvar}
|
|
sl@0
|
397 |
test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
|
|
sl@0
|
398 |
namespace eval test_ns_var {
|
|
sl@0
|
399 |
variable ::newvar cheers!
|
|
sl@0
|
400 |
}
|
|
sl@0
|
401 |
set newvar
|
|
sl@0
|
402 |
} {cheers!}
|
|
sl@0
|
403 |
catch {unset newvar}
|
|
sl@0
|
404 |
test var-7.7 {Tcl_VariableObjCmd, bad var name} {
|
|
sl@0
|
405 |
namespace eval test_ns_var {
|
|
sl@0
|
406 |
list [catch {variable sev:::en 7} msg] $msg
|
|
sl@0
|
407 |
}
|
|
sl@0
|
408 |
} {1 {can't define "sev:::en": parent namespace doesn't exist}}
|
|
sl@0
|
409 |
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
|
|
sl@0
|
410 |
set a ""
|
|
sl@0
|
411 |
namespace eval test_ns_var {
|
|
sl@0
|
412 |
variable eight 8
|
|
sl@0
|
413 |
lappend a $eight
|
|
sl@0
|
414 |
variable eight
|
|
sl@0
|
415 |
lappend a $eight
|
|
sl@0
|
416 |
}
|
|
sl@0
|
417 |
set a
|
|
sl@0
|
418 |
} {8 8}
|
|
sl@0
|
419 |
test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
|
|
sl@0
|
420 |
catch {namespace delete test_ns_var2}
|
|
sl@0
|
421 |
set a ""
|
|
sl@0
|
422 |
namespace eval test_ns_var2 {
|
|
sl@0
|
423 |
variable x 123
|
|
sl@0
|
424 |
variable y
|
|
sl@0
|
425 |
variable z
|
|
sl@0
|
426 |
}
|
|
sl@0
|
427 |
lappend a [lsort [info vars test_ns_var2::*]]
|
|
sl@0
|
428 |
lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
|
|
sl@0
|
429 |
[info exists test_ns_var2::z]
|
|
sl@0
|
430 |
lappend a [list [catch {set test_ns_var2::y} msg] $msg]
|
|
sl@0
|
431 |
lappend a [lsort [info vars test_ns_var2::*]]
|
|
sl@0
|
432 |
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
|
|
sl@0
|
433 |
lappend a [set test_ns_var2::y hello]
|
|
sl@0
|
434 |
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
|
|
sl@0
|
435 |
lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
|
|
sl@0
|
436 |
lappend a [lsort [info vars test_ns_var2::*]]
|
|
sl@0
|
437 |
lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
|
|
sl@0
|
438 |
lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
|
|
sl@0
|
439 |
lappend a [namespace delete test_ns_var2]
|
|
sl@0
|
440 |
set a
|
|
sl@0
|
441 |
} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
|
|
sl@0
|
442 |
{1 {can't read "test_ns_var2::y": no such variable}}\
|
|
sl@0
|
443 |
[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
|
|
sl@0
|
444 |
hello 1 0\
|
|
sl@0
|
445 |
{0 {}}\
|
|
sl@0
|
446 |
[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
|
|
sl@0
|
447 |
{1 {can't unset "test_ns_var2::z": no such variable}}\
|
|
sl@0
|
448 |
{}]
|
|
sl@0
|
449 |
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
|
sl@0
|
450 |
namespace eval test_ns_var {
|
|
sl@0
|
451 |
proc p {} {
|
|
sl@0
|
452 |
variable eight
|
|
sl@0
|
453 |
list [set eight] [info vars]
|
|
sl@0
|
454 |
}
|
|
sl@0
|
455 |
p
|
|
sl@0
|
456 |
}
|
|
sl@0
|
457 |
} {8 eight}
|
|
sl@0
|
458 |
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
|
sl@0
|
459 |
proc p {} { ;# note this proc is at global :: scope
|
|
sl@0
|
460 |
variable test_ns_var::eight
|
|
sl@0
|
461 |
list [set eight] [info vars]
|
|
sl@0
|
462 |
}
|
|
sl@0
|
463 |
p
|
|
sl@0
|
464 |
} {8 eight}
|
|
sl@0
|
465 |
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
|
|
sl@0
|
466 |
namespace eval test_ns_var {
|
|
sl@0
|
467 |
variable {} {My name is empty}
|
|
sl@0
|
468 |
}
|
|
sl@0
|
469 |
proc p {} { ;# note this proc is at global :: scope
|
|
sl@0
|
470 |
variable test_ns_var::
|
|
sl@0
|
471 |
list [set {}] [info vars]
|
|
sl@0
|
472 |
}
|
|
sl@0
|
473 |
p
|
|
sl@0
|
474 |
} {{My name is empty} {{}}}
|
|
sl@0
|
475 |
test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
|
|
sl@0
|
476 |
namespace eval test_ns_var {
|
|
sl@0
|
477 |
variable : {My name is ":"}
|
|
sl@0
|
478 |
proc p {} {
|
|
sl@0
|
479 |
variable :
|
|
sl@0
|
480 |
list [set :] [info vars]
|
|
sl@0
|
481 |
}
|
|
sl@0
|
482 |
p
|
|
sl@0
|
483 |
}
|
|
sl@0
|
484 |
} {{My name is ":"} :}
|
|
sl@0
|
485 |
test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
|
|
sl@0
|
486 |
catch {namespace eval test_ns_var { variable arrayvar(1) }} res
|
|
sl@0
|
487 |
set res
|
|
sl@0
|
488 |
} "can't define \"arrayvar(1)\": name refers to an element in an array"
|
|
sl@0
|
489 |
test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
|
|
sl@0
|
490 |
catch {
|
|
sl@0
|
491 |
namespace eval test_ns_var {
|
|
sl@0
|
492 |
variable arrayvar
|
|
sl@0
|
493 |
set arrayvar(1) x
|
|
sl@0
|
494 |
variable arrayvar(1) y
|
|
sl@0
|
495 |
}
|
|
sl@0
|
496 |
} res
|
|
sl@0
|
497 |
set res
|
|
sl@0
|
498 |
} "can't define \"arrayvar(1)\": name refers to an element in an array"
|
|
sl@0
|
499 |
test var-7.16 {Tcl_VariableObjCmd, no args} {
|
|
sl@0
|
500 |
list [catch {variable} msg] $msg
|
|
sl@0
|
501 |
} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
|
|
sl@0
|
502 |
test var-7.17 {Tcl_VariableObjCmd, no args} {
|
|
sl@0
|
503 |
namespace eval test_ns_var {
|
|
sl@0
|
504 |
list [catch {variable} msg] $msg
|
|
sl@0
|
505 |
}
|
|
sl@0
|
506 |
} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
|
|
sl@0
|
507 |
|
|
sl@0
|
508 |
test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
|
|
sl@0
|
509 |
catch {namespace delete test_ns_var}
|
|
sl@0
|
510 |
catch {unset a}
|
|
sl@0
|
511 |
namespace eval test_ns_var {
|
|
sl@0
|
512 |
variable v 123
|
|
sl@0
|
513 |
variable info ""
|
|
sl@0
|
514 |
|
|
sl@0
|
515 |
proc traceUnset {name1 name2 op} {
|
|
sl@0
|
516 |
variable info
|
|
sl@0
|
517 |
set info [concat $info [list $name1 $name2 $op]]
|
|
sl@0
|
518 |
}
|
|
sl@0
|
519 |
|
|
sl@0
|
520 |
trace var v u [namespace code traceUnset]
|
|
sl@0
|
521 |
}
|
|
sl@0
|
522 |
list [unset test_ns_var::v] $test_ns_var::info
|
|
sl@0
|
523 |
} {{} {test_ns_var::v {} u}}
|
|
sl@0
|
524 |
|
|
sl@0
|
525 |
if {[info commands testsetnoerr] == {}} {
|
|
sl@0
|
526 |
puts "This application hasn't been compiled with the \"testsetnoerr\""
|
|
sl@0
|
527 |
puts "command, so I can't test TclSetVar etc."
|
|
sl@0
|
528 |
} else {
|
|
sl@0
|
529 |
test var-9.1 {behaviour of TclGet/SetVar simple get/set} {
|
|
sl@0
|
530 |
catch {unset u}; catch {unset v}
|
|
sl@0
|
531 |
list \
|
|
sl@0
|
532 |
[set u a; testsetnoerr u] \
|
|
sl@0
|
533 |
[testsetnoerr v b] \
|
|
sl@0
|
534 |
[testseterr u] \
|
|
sl@0
|
535 |
[unset v; testseterr v b]
|
|
sl@0
|
536 |
} [list {before get a} {before set b} {before get a} {before set b}]
|
|
sl@0
|
537 |
test var-9.2 {behaviour of TclGet/SetVar namespace get/set} {
|
|
sl@0
|
538 |
catch {namespace delete ns}
|
|
sl@0
|
539 |
namespace eval ns {variable u a; variable v}
|
|
sl@0
|
540 |
list \
|
|
sl@0
|
541 |
[testsetnoerr ns::u] \
|
|
sl@0
|
542 |
[testsetnoerr ns::v b] \
|
|
sl@0
|
543 |
[testseterr ns::u] \
|
|
sl@0
|
544 |
[unset ns::v; testseterr ns::v b]
|
|
sl@0
|
545 |
} [list {before get a} {before set b} {before get a} {before set b}]
|
|
sl@0
|
546 |
test var-9.3 {behaviour of TclGetVar no variable} {
|
|
sl@0
|
547 |
catch {unset u}
|
|
sl@0
|
548 |
list \
|
|
sl@0
|
549 |
[catch {testsetnoerr u} res] $res \
|
|
sl@0
|
550 |
[catch {testseterr u} res] $res
|
|
sl@0
|
551 |
} {1 {before get} 1 {can't read "u": no such variable}}
|
|
sl@0
|
552 |
test var-9.4 {behaviour of TclGetVar no namespace variable} {
|
|
sl@0
|
553 |
catch {namespace delete ns}
|
|
sl@0
|
554 |
namespace eval ns {}
|
|
sl@0
|
555 |
list \
|
|
sl@0
|
556 |
[catch {testsetnoerr ns::w} res] $res \
|
|
sl@0
|
557 |
[catch {testseterr ns::w} res] $res
|
|
sl@0
|
558 |
} {1 {before get} 1 {can't read "ns::w": no such variable}}
|
|
sl@0
|
559 |
test var-9.5 {behaviour of TclGetVar no namespace} {
|
|
sl@0
|
560 |
catch {namespace delete ns}
|
|
sl@0
|
561 |
list \
|
|
sl@0
|
562 |
[catch {testsetnoerr ns::u} res] $res \
|
|
sl@0
|
563 |
[catch {testseterr ns::v} res] $res
|
|
sl@0
|
564 |
} {1 {before get} 1 {can't read "ns::v": no such variable}}
|
|
sl@0
|
565 |
test var-9.6 {behaviour of TclSetVar no namespace} {
|
|
sl@0
|
566 |
catch {namespace delete ns}
|
|
sl@0
|
567 |
list \
|
|
sl@0
|
568 |
[catch {testsetnoerr ns::v 1} res] $res \
|
|
sl@0
|
569 |
[catch {testseterr ns::v 1} res] $res
|
|
sl@0
|
570 |
} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
|
|
sl@0
|
571 |
test var-9.7 {behaviour of TclGetVar array variable} {
|
|
sl@0
|
572 |
catch {unset arr}
|
|
sl@0
|
573 |
set arr(1) 1;
|
|
sl@0
|
574 |
list \
|
|
sl@0
|
575 |
[catch {testsetnoerr arr} res] $res \
|
|
sl@0
|
576 |
[catch {testseterr arr} res] $res
|
|
sl@0
|
577 |
} {1 {before get} 1 {can't read "arr": variable is array}}
|
|
sl@0
|
578 |
test var-9.8 {behaviour of TclSetVar array variable} {
|
|
sl@0
|
579 |
catch {unset arr}
|
|
sl@0
|
580 |
set arr(1) 1
|
|
sl@0
|
581 |
list \
|
|
sl@0
|
582 |
[catch {testsetnoerr arr 2} res] $res \
|
|
sl@0
|
583 |
[catch {testseterr arr 2} res] $res
|
|
sl@0
|
584 |
} {1 {before set} 1 {can't set "arr": variable is array}}
|
|
sl@0
|
585 |
test var-9.9 {behaviour of TclGetVar read trace success} {
|
|
sl@0
|
586 |
proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
|
|
sl@0
|
587 |
catch {unset u}; catch {unset v}
|
|
sl@0
|
588 |
set u 10
|
|
sl@0
|
589 |
trace var u r [list resetvar 1]
|
|
sl@0
|
590 |
trace var v r [list resetvar 2]
|
|
sl@0
|
591 |
list \
|
|
sl@0
|
592 |
[testsetnoerr u] \
|
|
sl@0
|
593 |
[testseterr v]
|
|
sl@0
|
594 |
} {{before get 1} {before get 2}}
|
|
sl@0
|
595 |
test var-9.10 {behaviour of TclGetVar read trace error} {
|
|
sl@0
|
596 |
proc writeonly args {error "write-only"}
|
|
sl@0
|
597 |
set v 456
|
|
sl@0
|
598 |
trace var v r writeonly
|
|
sl@0
|
599 |
list \
|
|
sl@0
|
600 |
[catch {testsetnoerr v} msg] $msg \
|
|
sl@0
|
601 |
[catch {testseterr v} msg] $msg
|
|
sl@0
|
602 |
} {1 {before get} 1 {can't read "v": write-only}}
|
|
sl@0
|
603 |
test var-9.11 {behaviour of TclSetVar write trace success} {
|
|
sl@0
|
604 |
proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
|
|
sl@0
|
605 |
catch {unset u}; catch {unset v}
|
|
sl@0
|
606 |
set v 1
|
|
sl@0
|
607 |
trace var v w doubleval
|
|
sl@0
|
608 |
trace var u w doubleval
|
|
sl@0
|
609 |
list \
|
|
sl@0
|
610 |
[testsetnoerr u 2] \
|
|
sl@0
|
611 |
[testseterr v 3]
|
|
sl@0
|
612 |
} {{before set 4} {before set 6}}
|
|
sl@0
|
613 |
test var-9.12 {behaviour of TclSetVar write trace error} {
|
|
sl@0
|
614 |
proc readonly args {error "read-only"}
|
|
sl@0
|
615 |
set v 456
|
|
sl@0
|
616 |
trace var v w readonly
|
|
sl@0
|
617 |
list \
|
|
sl@0
|
618 |
[catch {testsetnoerr v 2} msg] $msg $v \
|
|
sl@0
|
619 |
[catch {testseterr v 3} msg] $msg $v
|
|
sl@0
|
620 |
} {1 {before set} 2 1 {can't set "v": read-only} 3}
|
|
sl@0
|
621 |
}
|
|
sl@0
|
622 |
test var-10.1 {can't nest arrays with array set} {
|
|
sl@0
|
623 |
catch {unset arr}
|
|
sl@0
|
624 |
list [catch {array set arr(x) {a 1 b 2}} res] $res
|
|
sl@0
|
625 |
} {1 {can't set "arr(x)": variable isn't array}}
|
|
sl@0
|
626 |
|
|
sl@0
|
627 |
test var-10.2 {can't nest arrays with array set} {
|
|
sl@0
|
628 |
catch {unset arr}
|
|
sl@0
|
629 |
list [catch {array set arr(x) {}} res] $res
|
|
sl@0
|
630 |
} {1 {can't set "arr(x)": variable isn't array}}
|
|
sl@0
|
631 |
|
|
sl@0
|
632 |
test var-11.1 {array unset} {
|
|
sl@0
|
633 |
catch {unset a}
|
|
sl@0
|
634 |
array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
|
|
sl@0
|
635 |
array unset a 1,*
|
|
sl@0
|
636 |
lsort -dict [array names a]
|
|
sl@0
|
637 |
} {2,1 2,3}
|
|
sl@0
|
638 |
test var-11.2 {array unset} {
|
|
sl@0
|
639 |
catch {unset a}
|
|
sl@0
|
640 |
array set a { 1,1 a 1,2 b }
|
|
sl@0
|
641 |
array unset a
|
|
sl@0
|
642 |
array exists a
|
|
sl@0
|
643 |
} 0
|
|
sl@0
|
644 |
test var-11.3 {array unset errors} {
|
|
sl@0
|
645 |
catch {unset a}
|
|
sl@0
|
646 |
array set a { 1,1 a 1,2 b }
|
|
sl@0
|
647 |
list [catch {array unset a pattern too} msg] $msg
|
|
sl@0
|
648 |
} {1 {wrong # args: should be "array unset arrayName ?pattern?"}}
|
|
sl@0
|
649 |
|
|
sl@0
|
650 |
test var-12.1 {TclFindCompiledLocals, {} array name} {
|
|
sl@0
|
651 |
namespace eval n {
|
|
sl@0
|
652 |
proc p {} {
|
|
sl@0
|
653 |
variable {}
|
|
sl@0
|
654 |
set (0) 0
|
|
sl@0
|
655 |
set (1) 1
|
|
sl@0
|
656 |
set n 2
|
|
sl@0
|
657 |
set ($n) 2
|
|
sl@0
|
658 |
set ($n,foo) 2
|
|
sl@0
|
659 |
}
|
|
sl@0
|
660 |
p
|
|
sl@0
|
661 |
lsort -dictionary [array names {}]
|
|
sl@0
|
662 |
}
|
|
sl@0
|
663 |
} {0 1 2 2,foo}
|
|
sl@0
|
664 |
|
|
sl@0
|
665 |
test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
|
|
sl@0
|
666 |
catch {unset t}
|
|
sl@0
|
667 |
proc foo {var ind op} {
|
|
sl@0
|
668 |
global t
|
|
sl@0
|
669 |
set foo bar
|
|
sl@0
|
670 |
}
|
|
sl@0
|
671 |
namespace eval :: {
|
|
sl@0
|
672 |
set t(1) 1
|
|
sl@0
|
673 |
trace variable t(1) u foo
|
|
sl@0
|
674 |
unset t
|
|
sl@0
|
675 |
}
|
|
sl@0
|
676 |
set x "If you see this, it worked"
|
|
sl@0
|
677 |
} "If you see this, it worked"
|
|
sl@0
|
678 |
|
|
sl@0
|
679 |
test var-14.1 {array names syntax} -body {
|
|
sl@0
|
680 |
array names foo bar baz snafu
|
|
sl@0
|
681 |
} -returnCodes 1 -match glob -result *
|
|
sl@0
|
682 |
|
|
sl@0
|
683 |
test var-15.1 {segfault in [unset], [Bug 735335]} {
|
|
sl@0
|
684 |
proc A { name } {
|
|
sl@0
|
685 |
upvar $name var
|
|
sl@0
|
686 |
set var $name
|
|
sl@0
|
687 |
}
|
|
sl@0
|
688 |
#
|
|
sl@0
|
689 |
# Note that the variable name has to be
|
|
sl@0
|
690 |
# unused previously for the segfault to
|
|
sl@0
|
691 |
# be triggered.
|
|
sl@0
|
692 |
#
|
|
sl@0
|
693 |
namespace eval test A useSomeUnlikelyNameHere
|
|
sl@0
|
694 |
namespace eval test unset useSomeUnlikelyNameHere
|
|
sl@0
|
695 |
} {}
|
|
sl@0
|
696 |
|
|
sl@0
|
697 |
test var-16.1 {CallVarTraces: save/restore interp error state: 1038021} {
|
|
sl@0
|
698 |
trace add variable errorCode write { ;#}
|
|
sl@0
|
699 |
catch {error foo bar baz}
|
|
sl@0
|
700 |
trace remove variable errorCode write { ;#}
|
|
sl@0
|
701 |
set errorInfo
|
|
sl@0
|
702 |
} bar
|
|
sl@0
|
703 |
|
|
sl@0
|
704 |
test var-17.1 {TclArraySet [Bug 1669489]} -setup {
|
|
sl@0
|
705 |
unset -nocomplain ::a
|
|
sl@0
|
706 |
} -body {
|
|
sl@0
|
707 |
namespace eval :: {
|
|
sl@0
|
708 |
set elements {1 2 3 4}
|
|
sl@0
|
709 |
trace add variable a write {string length $elements ;#}
|
|
sl@0
|
710 |
array set a $elements
|
|
sl@0
|
711 |
}
|
|
sl@0
|
712 |
} -cleanup {
|
|
sl@0
|
713 |
unset -nocomplain ::a ::elements
|
|
sl@0
|
714 |
} -result {}
|
|
sl@0
|
715 |
|
|
sl@0
|
716 |
catch {namespace delete ns}
|
|
sl@0
|
717 |
catch {unset arr}
|
|
sl@0
|
718 |
catch {unset v}
|
|
sl@0
|
719 |
|
|
sl@0
|
720 |
catch {rename p ""}
|
|
sl@0
|
721 |
catch {namespace delete test_ns_var}
|
|
sl@0
|
722 |
catch {namespace delete test_ns_var2}
|
|
sl@0
|
723 |
catch {unset xx}
|
|
sl@0
|
724 |
catch {unset x}
|
|
sl@0
|
725 |
catch {unset y}
|
|
sl@0
|
726 |
catch {unset i}
|
|
sl@0
|
727 |
catch {unset a}
|
|
sl@0
|
728 |
catch {unset xxxxx}
|
|
sl@0
|
729 |
catch {unset aaaaa}
|
|
sl@0
|
730 |
|
|
sl@0
|
731 |
# cleanup
|
|
sl@0
|
732 |
::tcltest::cleanupTests
|
|
sl@0
|
733 |
return
|