150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
-
+
+
-
+
-
-
+
+
+
-
-
-
+
+
+
+
+
+
-
-
+
-
+
-
+
-
-
+
+
-
+
-
+
+
-
-
+
+
+
|
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} {
test var-1.16 {TclLookupVar, resurrect variable via upvar to deleted namespace: uncompiled code path} -body {
variable result
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
lappend [namespace parent]::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
lappend [namespace parent]::result [catch {set foo 3} msg] $msg
lappend [namespace parent]::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}}
set result
} -cleanup {
unset result
} -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} {
variable result {}
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
lappend [namespace parent]::result [catch {set foo} msg] $msg
unset x
lappend result [catch {set foo 3} msg] $msg
lappend [namespace parent]::result [catch {set foo 3} msg] $msg
}
set result [p]
namespace delete [namespace current]
set result
}
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 result {}
namespace eval test_ns_var {
variable x
array set x {1 2 3 4}
upvar 0 x(1) foo
lappend result [catch {set foo} msg] $msg
lappend [namespace parent]::result [catch {set foo} msg] $msg
unset x
lappend result [catch {set foo 3} msg] $msg
lappend [namespace parent]::result [catch {set foo 3} msg] $msg
namespace delete [namespace current]
}
set result
}
set result
} -cleanup {
unset result
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
[format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
test var-2.1 {Tcl_LappendObjCmd, create var if new} {
catch {unset x}
|
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
|
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
} -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
test var-23.0 {Look up command from deleted namespace} -body {
variable msg
set result [namespace eval test_ns_var {
namespace delete [namespace current]
# Doesn't result in a panic with message called Tcl_FindHashEntry on
# deleted table when Tcl_FindCommand is called to find resolve "catch"
catch {lindex success} [namespace parent]::msg
}]
list $result $msg
} -result {0 success}
test var-23.1 {set a variable after deleting current namespace} {
variable msg {}
set result [namespace eval test_ns_var {
variable var1
namespace delete [namespace current]
set var1 one
namespace which -variable var1
}]
} {::var1}
test var-23.3 {The current namespace after deleting the current namespace} {
variable msg {}
namespace eval test_ns_var {
variable var1
namespace delete [namespace current]
namespace current
}
} ::
test var-23.4 {
declare a namespace variable after deleting the current namespace
} {
variable msg {}
namespace eval test_ns_var {
variable var1
namespace delete [namespace current]
variable var1
set var1 one
namespace which -variable var1
}
} {::var1}
test var-23.5 {
create a procedure after deleting the current namespace
} {
namespace eval test_ns_var {
namespace delete [namespace current]
proc p1 {} {return hello}
list [namespace which p1] [p1]
} $msg
} {::p1 hello}
test var-23.6 {
create a namespace after deleting the current namespace
} {
namespace eval test_ns_var {
namespace delete [namespace current]
namespace eval one {namespace current}
}
} {::one}
catch {namespace delete ns}
catch {unset arr}
catch {unset v}
catch {rename getbytes ""}
|