os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/set-old.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/set-old.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,919 @@
1.4 +# Commands covered: set, unset, array
1.5 +#
1.6 +# This file includes the original set of tests for Tcl's set command.
1.7 +# Since the set command is now compiled, a new set of tests covering
1.8 +# the new implementation is in the file "set.test". Sourcing this file
1.9 +# into Tcl runs the tests and generates output for errors.
1.10 +# No output means no errors were found.
1.11 +#
1.12 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.13 +# Copyright (c) 1994-1997 Sun Microsystems, Inc.
1.14 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.15 +#
1.16 +# See the file "license.terms" for information on usage and redistribution
1.17 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.18 +#
1.19 +# RCS: @(#) $Id: set-old.test,v 1.16.2.1 2003/03/27 21:46:32 msofer Exp $
1.20 +
1.21 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.22 + package require tcltest
1.23 + namespace import -force ::tcltest::*
1.24 +}
1.25 +
1.26 +proc ignore args {}
1.27 +
1.28 +# Simple variable operations.
1.29 +
1.30 +catch {unset a}
1.31 +test set-old-1.1 {basic variable setting and unsetting} {
1.32 + set a 22
1.33 +} 22
1.34 +test set-old-1.2 {basic variable setting and unsetting} {
1.35 + set a 123
1.36 + set a
1.37 +} 123
1.38 +test set-old-1.3 {basic variable setting and unsetting} {
1.39 + set a xxx
1.40 + format %s $a
1.41 +} xxx
1.42 +test set-old-1.4 {basic variable setting and unsetting} {
1.43 + set a 44
1.44 + unset a
1.45 + list [catch {set a} msg] $msg
1.46 +} {1 {can't read "a": no such variable}}
1.47 +
1.48 +# Basic array operations.
1.49 +
1.50 +catch {unset a}
1.51 +set a(xyz) 2
1.52 +set a(44) 3
1.53 +set {a(a long name)} test
1.54 +test set-old-2.1 {basic array operations} {
1.55 + lsort [array names a]
1.56 +} {44 {a long name} xyz}
1.57 +test set-old-2.2 {basic array operations} {
1.58 + set a(44)
1.59 +} 3
1.60 +test set-old-2.3 {basic array operations} {
1.61 + set a(xyz)
1.62 +} 2
1.63 +test set-old-2.4 {basic array operations} {
1.64 + set "a(a long name)"
1.65 +} test
1.66 +test set-old-2.5 {basic array operations} {
1.67 + list [catch {set a(other)} msg] $msg
1.68 +} {1 {can't read "a(other)": no such element in array}}
1.69 +test set-old-2.6 {basic array operations} {
1.70 + list [catch {set a} msg] $msg
1.71 +} {1 {can't read "a": variable is array}}
1.72 +test set-old-2.7 {basic array operations} {
1.73 + format %s $a(44)
1.74 +} 3
1.75 +test set-old-2.8 {basic array operations} {
1.76 + format %s $a(a long name)
1.77 +} test
1.78 +unset a(44)
1.79 +test set-old-2.9 {basic array operations} {
1.80 + lsort [array names a]
1.81 +} {{a long name} xyz}
1.82 +test set-old-2.10 {basic array operations} {
1.83 + catch {unset b}
1.84 + list [catch {set b(123)} msg] $msg
1.85 +} {1 {can't read "b(123)": no such variable}}
1.86 +test set-old-2.11 {basic array operations} {
1.87 + catch {unset b}
1.88 + set b 44
1.89 + list [catch {set b(123)} msg] $msg
1.90 +} {1 {can't read "b(123)": variable isn't array}}
1.91 +test set-old-2.12 {basic array operations} {
1.92 + list [catch {set a 14} msg] $msg
1.93 +} {1 {can't set "a": variable is array}}
1.94 +unset a
1.95 +test set-old-2.13 {basic array operations} {
1.96 + list [catch {set a(xyz)} msg] $msg
1.97 +} {1 {can't read "a(xyz)": no such variable}}
1.98 +
1.99 +# Test the set commands, and exercise the corner cases of the code
1.100 +# that parses array references into two parts.
1.101 +
1.102 +test set-old-3.1 {set command} {
1.103 + list [catch {set} msg] $msg
1.104 +} {1 {wrong # args: should be "set varName ?newValue?"}}
1.105 +test set-old-3.2 {set command} {
1.106 + list [catch {set x y z} msg] $msg
1.107 +} {1 {wrong # args: should be "set varName ?newValue?"}}
1.108 +test set-old-3.3 {set command} {
1.109 + catch {unset a}
1.110 + list [catch {set a} msg] $msg
1.111 +} {1 {can't read "a": no such variable}}
1.112 +test set-old-3.4 {set command} {
1.113 + catch {unset a}
1.114 + set a(14) 83
1.115 + list [catch {set a 22} msg] $msg
1.116 +} {1 {can't set "a": variable is array}}
1.117 +
1.118 +# Test the corner-cases of parsing array names, using set and unset.
1.119 +
1.120 +test set-old-4.1 {parsing array names} {
1.121 + catch {unset a}
1.122 + set a(()) 44
1.123 + list [catch {array names a} msg] $msg
1.124 +} {0 ()}
1.125 +test set-old-4.2 {parsing array names} {
1.126 + catch {unset a a(abcd}
1.127 + set a(abcd 33
1.128 + info exists a(abcd
1.129 +} 1
1.130 +test set-old-4.3 {parsing array names} {
1.131 + catch {unset a a(abcd}
1.132 + set a(abcd 33
1.133 + list [catch {array names a} msg] $msg
1.134 +} {0 {}}
1.135 +test set-old-4.4 {parsing array names} {
1.136 + catch {unset a abcd)}
1.137 + set abcd) 33
1.138 + info exists abcd)
1.139 +} 1
1.140 +test set-old-4.5 {parsing array names} {
1.141 + set a(bcd yyy
1.142 + catch {unset a}
1.143 + list [catch {set a(bcd} msg] $msg
1.144 +} {0 yyy}
1.145 +test set-old-4.6 {parsing array names} {
1.146 + catch {unset a}
1.147 + set a 44
1.148 + list [catch {set a(bcd test} msg] $msg
1.149 +} {0 test}
1.150 +
1.151 +# Errors in reading variables
1.152 +
1.153 +test set-old-5.1 {errors in reading variables} {
1.154 + catch {unset a}
1.155 + list [catch {set a} msg] $msg
1.156 +} {1 {can't read "a": no such variable}}
1.157 +test set-old-5.2 {errors in reading variables} {
1.158 + catch {unset a}
1.159 + set a 44
1.160 + list [catch {set a(18)} msg] $msg
1.161 +} {1 {can't read "a(18)": variable isn't array}}
1.162 +test set-old-5.3 {errors in reading variables} {
1.163 + catch {unset a}
1.164 + set a(6) 44
1.165 + list [catch {set a(18)} msg] $msg
1.166 +} {1 {can't read "a(18)": no such element in array}}
1.167 +test set-old-5.4 {errors in reading variables} {
1.168 + catch {unset a}
1.169 + set a(6) 44
1.170 + list [catch {set a} msg] $msg
1.171 +} {1 {can't read "a": variable is array}}
1.172 +
1.173 +# Errors and other special cases in writing variables
1.174 +
1.175 +test set-old-6.1 {creating array during write} {
1.176 + catch {unset a}
1.177 + trace var a rwu ignore
1.178 + list [catch {set a(14) 186} msg] $msg [array names a]
1.179 +} {0 186 14}
1.180 +test set-old-6.2 {errors in writing variables} {
1.181 + catch {unset a}
1.182 + set a xxx
1.183 + list [catch {set a(14) 186} msg] $msg
1.184 +} {1 {can't set "a(14)": variable isn't array}}
1.185 +test set-old-6.3 {errors in writing variables} {
1.186 + catch {unset a}
1.187 + set a(100) yyy
1.188 + list [catch {set a 2} msg] $msg
1.189 +} {1 {can't set "a": variable is array}}
1.190 +test set-old-6.4 {expanding variable size} {
1.191 + catch {unset a}
1.192 + list [set a short] [set a "longer name"] [set a "even longer name"] \
1.193 + [set a "a much much truly longer name"]
1.194 +} {short {longer name} {even longer name} {a much much truly longer name}}
1.195 +
1.196 +# Unset command, Tcl_UnsetVar procedures
1.197 +
1.198 +test set-old-7.1 {unset command} {
1.199 + catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
1.200 + set a 44
1.201 + set b 55
1.202 + set c 66
1.203 + set d 77
1.204 + unset a b c
1.205 + list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
1.206 + [catch {set d(0) 0}]
1.207 +} {0 0 0 1}
1.208 +test set-old-7.2 {unset command} {
1.209 + list [catch {unset} msg] $msg
1.210 +} {0 {}}
1.211 +# Used to return:
1.212 +#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}}
1.213 +test set-old-7.3 {unset command} {
1.214 + catch {unset a}
1.215 + list [catch {unset a} msg] $msg
1.216 +} {1 {can't unset "a": no such variable}}
1.217 +test set-old-7.4 {unset command} {
1.218 + catch {unset a}
1.219 + set a 44
1.220 + list [catch {unset a(14)} msg] $msg
1.221 +} {1 {can't unset "a(14)": variable isn't array}}
1.222 +test set-old-7.5 {unset command} {
1.223 + catch {unset a}
1.224 + set a(0) xx
1.225 + list [catch {unset a(14)} msg] $msg
1.226 +} {1 {can't unset "a(14)": no such element in array}}
1.227 +test set-old-7.6 {unset command} {
1.228 + catch {unset a}; catch {unset b}; catch {unset c}
1.229 + set a foo
1.230 + set c gorp
1.231 + list [catch {unset a a a(14)} msg] $msg [info exists c]
1.232 +} {1 {can't unset "a": no such variable} 1}
1.233 +test set-old-7.7 {unsetting globals from within procedures} {
1.234 + set y 0
1.235 + proc p1 {} {
1.236 + global y
1.237 + set z [p2]
1.238 + return [list $z [catch {set y} msg] $msg]
1.239 + }
1.240 + proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
1.241 + p1
1.242 +} {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
1.243 +test set-old-7.8 {unsetting globals from within procedures} {
1.244 + set y 0
1.245 + proc p1 {} {
1.246 + global y
1.247 + p2
1.248 + return [list [catch {set y 44} msg] $msg]
1.249 + }
1.250 + proc p2 {} {global y; unset y}
1.251 + concat [p1] [list [catch {set y} msg] $msg]
1.252 +} {0 44 0 44}
1.253 +test set-old-7.9 {unsetting globals from within procedures} {
1.254 + set y 0
1.255 + proc p1 {} {
1.256 + global y
1.257 + unset y
1.258 + return [list [catch {set y 55} msg] $msg]
1.259 + }
1.260 + concat [p1] [list [catch {set y} msg] $msg]
1.261 +} {0 55 0 55}
1.262 +test set-old-7.10 {unset command} {
1.263 + catch {unset a}
1.264 + set a(14) 22
1.265 + unset a(14)
1.266 + list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
1.267 +} {1 {can't read "a(14)": no such element in array} 0 {}}
1.268 +test set-old-7.11 {unset command} {
1.269 + catch {unset a}
1.270 + set a(14) 22
1.271 + unset a
1.272 + list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
1.273 +} {1 {can't read "a(14)": no such variable} 0 {}}
1.274 +test set-old-7.12 {unset command, -nocomplain} {
1.275 + catch {unset a}
1.276 + list [info exists a] [catch {unset -nocomplain a}] [info exists a]
1.277 +} {0 0 0}
1.278 +test set-old-7.13 {unset command, -nocomplain} {
1.279 + set -nocomplain abc
1.280 + list [info exists -nocomplain] [catch {unset -nocomplain}] \
1.281 + [info exists -nocomplain] [catch {unset -- -nocomplain}] \
1.282 + [info exists -nocomplain]
1.283 +} {1 0 1 0 0}
1.284 +test set-old-7.14 {unset command, --} {
1.285 + set -- abc
1.286 + list [info exists --] [catch {unset --}] \
1.287 + [info exists --] [catch {unset -- --}] \
1.288 + [info exists --]
1.289 +} {1 0 1 0 0}
1.290 +test set-old-7.15 {unset command, -nocomplain} {
1.291 + set -nocomplain abc
1.292 + set -- abc
1.293 + list [info exists -nocomplain] [catch {unset -- -nocomplain}] \
1.294 + [info exists -nocomplain] [info exists --] \
1.295 + [catch {unset -- -nocomplain}] [info exists --] \
1.296 + [catch {unset -- --}] [info exists --]
1.297 +} {1 0 0 1 1 1 0 0}
1.298 +test set-old-7.16 {unset command, -nocomplain} {
1.299 + set -nocomplain abc
1.300 + set var abc
1.301 + list [info exists bogus] [catch {unset -nocomplain bogus var bogus}] \
1.302 + [info exists -nocomplain] [info exists var] \
1.303 + [catch {unset -nocomplain -nocomplain}] [info exists -nocomplain]
1.304 +} {0 0 1 0 0 0}
1.305 +test set-old-7.17 {unset command, -nocomplain (no abbreviation)} {
1.306 + set -nocomp abc
1.307 + list [info exists -nocomp] [catch {unset -nocomp}] [info exists -nocomp]
1.308 +} {1 0 0}
1.309 +test set-old-7.18 {unset command, -nocomplain (no abbreviation)} {
1.310 + catch {unset -nocomp}
1.311 + list [info exists -nocomp] [catch {unset -nocomp}]
1.312 +} {0 1}
1.313 +
1.314 +# Array command.
1.315 +
1.316 +test set-old-8.1 {array command} {
1.317 + list [catch {array} msg] $msg
1.318 +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
1.319 +test set-old-8.2 {array command} {
1.320 + list [catch {array a} msg] $msg
1.321 +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
1.322 +test set-old-8.3 {array command} {
1.323 + catch {unset a}
1.324 + list [catch {array anymore a b} msg] $msg
1.325 +} {1 {"a" isn't an array}}
1.326 +test set-old-8.4 {array command} {
1.327 + catch {unset a}
1.328 + set a 44
1.329 + list [catch {array anymore a b} msg] $msg
1.330 +} {1 {"a" isn't an array}}
1.331 +test set-old-8.5 {array command} {
1.332 + proc foo {} {
1.333 + set a 44
1.334 + upvar 0 a x
1.335 + list [catch {array anymore x b} msg] $msg
1.336 + }
1.337 + foo
1.338 +} {1 {"x" isn't an array}}
1.339 +test set-old-8.6 {array command} {
1.340 + catch {unset a}
1.341 + set a(22) 3
1.342 + list [catch {array gorp a} msg] $msg
1.343 +} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
1.344 +test set-old-8.7 {array command, anymore option} {
1.345 + catch {unset a}
1.346 + list [catch {array anymore a x} msg] $msg
1.347 +} {1 {"a" isn't an array}}
1.348 +test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.349 + proc foo {x} {
1.350 + if {$x==1} {
1.351 + return [array anymore a x]
1.352 + }
1.353 + set a(x) 123
1.354 + }
1.355 + list [catch {foo 1} msg] $msg
1.356 +} {1 {"a" isn't an array}}
1.357 +test set-old-8.9 {array command, donesearch option} {
1.358 + catch {unset a}
1.359 + list [catch {array donesearch a x} msg] $msg
1.360 +} {1 {"a" isn't an array}}
1.361 +test set-old-8.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.362 + proc foo {x} {
1.363 + if {$x==1} {
1.364 + return [array donesearch a x]
1.365 + }
1.366 + set a(x) 123
1.367 + }
1.368 + list [catch {foo 1} msg] $msg
1.369 +} {1 {"a" isn't an array}}
1.370 +test set-old-8.11 {array command, exists option} {
1.371 + list [catch {array exists a b} msg] $msg
1.372 +} {1 {wrong # args: should be "array exists arrayName"}}
1.373 +test set-old-8.12 {array command, exists option} {
1.374 + catch {unset a}
1.375 + array exists a
1.376 +} {0}
1.377 +test set-old-8.13 {array command, exists option} {
1.378 + catch {unset a}
1.379 + set a(0) 1
1.380 + array exists a
1.381 +} {1}
1.382 +test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.383 + proc foo {x} {
1.384 + if {$x==1} {
1.385 + return [array exists a]
1.386 + }
1.387 + set a(x) 123
1.388 + }
1.389 + list [catch {foo 1} msg] $msg
1.390 +} {0 0}
1.391 +test set-old-8.15 {array command, get option} {
1.392 + list [catch {array get} msg] $msg
1.393 +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
1.394 +test set-old-8.16 {array command, get option} {
1.395 + list [catch {array get a b c} msg] $msg
1.396 +} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
1.397 +test set-old-8.17 {array command, get option} {
1.398 + catch {unset a}
1.399 + array get a
1.400 +} {}
1.401 +test set-old-8.18 {array command, get option} {
1.402 + catch {unset a}
1.403 + set a(22) 3
1.404 + set {a(long name)} {}
1.405 + lsort [array get a]
1.406 +} {{} 22 3 {long name}}
1.407 +test set-old-8.19 {array command, get option (unset variable)} {
1.408 + catch {unset a}
1.409 + set a(x) 3
1.410 + trace var a(y) w ignore
1.411 + array get a
1.412 +} {x 3}
1.413 +test set-old-8.20 {array command, get option, with pattern} {
1.414 + catch {unset a}
1.415 + set a(x1) 3
1.416 + set a(x2) 4
1.417 + set a(x3) 5
1.418 + set a(b1) 24
1.419 + set a(b2) 25
1.420 + lsort [array get a x*]
1.421 +} {3 4 5 x1 x2 x3}
1.422 +test set-old-8.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.423 + proc foo {x} {
1.424 + if {$x==1} {
1.425 + return [array get a]
1.426 + }
1.427 + set a(x) 123
1.428 + }
1.429 + list [catch {foo 1} msg] $msg
1.430 +} {0 {}}
1.431 +test set-old-8.22 {array command, names option} {
1.432 + catch {unset a}
1.433 + set a(22) 3
1.434 + list [catch {array names a 4 5} msg] $msg
1.435 +} {1 {bad option "4": must be -exact, -glob, or -regexp}}
1.436 +test set-old-8.23 {array command, names option} {
1.437 + catch {unset a}
1.438 + array names a
1.439 +} {}
1.440 +test set-old-8.24 {array command, names option} {
1.441 + catch {unset a}
1.442 + set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
1.443 + list [catch {lsort [array names a]} msg] $msg
1.444 +} {0 {22 Textual_name {name with spaces}}}
1.445 +test set-old-8.25 {array command, names option} {
1.446 + catch {unset a}
1.447 + set a(22) 3; set a(33) 44;
1.448 + trace var a(xxx) w ignore
1.449 + list [catch {lsort [array names a]} msg] $msg
1.450 +} {0 {22 33}}
1.451 +test set-old-8.26 {array command, names option} {
1.452 + catch {unset a}
1.453 + set a(22) 3; set a(33) 44;
1.454 + trace var a(xxx) w ignore
1.455 + set a(xxx) value
1.456 + list [catch {lsort [array names a]} msg] $msg
1.457 +} {0 {22 33 xxx}}
1.458 +test set-old-8.27 {array command, names option} {
1.459 + catch {unset a}
1.460 + set a(axy) 3
1.461 + set a(bxy) 44
1.462 + set a(no) yes
1.463 + set a(xxx) value
1.464 + list [lsort [array names a *xy]] [lsort [array names a]]
1.465 +} {{axy bxy} {axy bxy no xxx}}
1.466 +test set-old-8.28 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.467 + proc foo {x} {
1.468 + if {$x==1} {
1.469 + return [array names a]
1.470 + }
1.471 + set a(x) 123
1.472 + }
1.473 + list [catch {foo 1} msg] $msg
1.474 +} {0 {}}
1.475 +test set-old-8.29 {array command, nextelement option} {
1.476 + list [catch {array nextelement a} msg] $msg
1.477 +} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
1.478 +test set-old-8.30 {array command, nextelement option} {
1.479 + catch {unset a}
1.480 + list [catch {array nextelement a b} msg] $msg
1.481 +} {1 {"a" isn't an array}}
1.482 +test set-old-8.31 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.483 + proc foo {x} {
1.484 + if {$x==1} {
1.485 + return [array nextelement a b]
1.486 + }
1.487 + set a(x) 123
1.488 + }
1.489 + list [catch {foo 1} msg] $msg
1.490 +} {1 {"a" isn't an array}}
1.491 +test set-old-8.32 {array command, set option} {
1.492 + list [catch {array set a} msg] $msg
1.493 +} {1 {wrong # args: should be "array set arrayName list"}}
1.494 +test set-old-8.33 {array command, set option} {
1.495 + list [catch {array set a 1 2} msg] $msg
1.496 +} {1 {wrong # args: should be "array set arrayName list"}}
1.497 +test set-old-8.34 {array command, set option} {
1.498 + list [catch {array set a "a \{ c"} msg] $msg
1.499 +} {1 {unmatched open brace in list}}
1.500 +test set-old-8.35 {array command, set option} {
1.501 + catch {unset a}
1.502 + set a 44
1.503 + list [catch {array set a {a b c d}} msg] $msg
1.504 +} {1 {can't set "a(a)": variable isn't array}}
1.505 +test set-old-8.36 {array command, set option} {
1.506 + catch {unset a}
1.507 + set a(xx) yy
1.508 + array set a {b c d e}
1.509 + lsort [array get a]
1.510 +} {b c d e xx yy}
1.511 +test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.512 + proc foo {x} {
1.513 + if {$x==1} {
1.514 + return [array set a {x 0}]
1.515 + }
1.516 + set a(x)
1.517 + }
1.518 + list [catch {foo 1} msg] $msg
1.519 +} {0 {}}
1.520 +test set-old-8.38 {array command, set option} {
1.521 + catch {unset aVaRnAmE}
1.522 + array set aVaRnAmE {}
1.523 + list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
1.524 +} {1 1 {can't read "aVaRnAmE": variable is array}}
1.525 +test set-old-8.38.1 {array command, set scalar} {
1.526 + catch {unset aVaRnAmE}
1.527 + set aVaRnAmE 1
1.528 + list [catch {array set aVaRnAmE {}} msg] $msg
1.529 +} {1 {can't array set "aVaRnAmE": variable isn't array}}
1.530 +test set-old-8.38.2 {array command, set alias} {
1.531 + catch {unset aVaRnAmE}
1.532 + upvar 0 aVaRnAmE anAliAs
1.533 + array set anAliAs {}
1.534 + list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg
1.535 +} {1 1 {can't read "anAliAs": variable is array}}
1.536 +test set-old-8.38.3 {array command, set element alias} {
1.537 + catch {unset aVaRnAmE}
1.538 + list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \
1.539 + [catch {array set elemAliAs {}} msg] $msg
1.540 +} {0 1 {can't array set "elemAliAs": variable isn't array}}
1.541 +test set-old-8.38.4 {array command, empty set with populated array} {
1.542 + catch {unset aVaRnAmE}
1.543 + array set aVaRnAmE [list e1 v1 e2 v2]
1.544 + array set aVaRnAmE {}
1.545 + array set aVaRnAmE [list e3 v3]
1.546 + list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
1.547 +} {{e1 e2 e3} 0 v2}
1.548 +test set-old-8.38.5 {array command, set with non-existent namespace} {
1.549 + list [catch {array set bogusnamespace::var {}} msg] $msg
1.550 +} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
1.551 +test set-old-8.38.6 {array command, set with non-existent namespace} {
1.552 + list [catch {array set bogusnamespace::var {a b}} msg] $msg
1.553 +} {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
1.554 +test set-old-8.38.7 {array command, set with non-existent namespace} {
1.555 + list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
1.556 +} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
1.557 +test set-old-8.39 {array command, size option} {
1.558 + catch {unset a}
1.559 + array size a
1.560 +} {0}
1.561 +test set-old-8.40 {array command, size option} {
1.562 + list [catch {array size a 4} msg] $msg
1.563 +} {1 {wrong # args: should be "array size arrayName"}}
1.564 +test set-old-8.41 {array command, size option} {
1.565 + catch {unset a}
1.566 + array size a
1.567 +} {0}
1.568 +test set-old-8.42 {array command, size option} {
1.569 + catch {unset a}
1.570 + set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
1.571 + list [catch {array size a} msg] $msg
1.572 +} {0 3}
1.573 +test set-old-8.43 {array command, size option} {
1.574 + catch {unset a}
1.575 + set a(22) 3; set a(xx) 44; set a(y) xxx
1.576 + unset a(22) a(y) a(xx)
1.577 + list [catch {array size a} msg] $msg
1.578 +} {0 0}
1.579 +test set-old-8.44 {array command, size option} {
1.580 + catch {unset a}
1.581 + set a(22) 3;
1.582 + trace var a(33) rwu ignore
1.583 + list [catch {array size a} msg] $msg
1.584 +} {0 1}
1.585 +test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.586 + proc foo {x} {
1.587 + if {$x==1} {
1.588 + return [array size a]
1.589 + }
1.590 + set a(x) 123
1.591 + }
1.592 + list [catch {foo 1} msg] $msg
1.593 +} {0 0}
1.594 +test set-old-8.46 {array command, startsearch option} {
1.595 + list [catch {array startsearch a b} msg] $msg
1.596 +} {1 {wrong # args: should be "array startsearch arrayName"}}
1.597 +test set-old-8.47 {array command, startsearch option} {
1.598 + catch {unset a}
1.599 + list [catch {array startsearch a} msg] $msg
1.600 +} {1 {"a" isn't an array}}
1.601 +test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
1.602 + catch {rename p ""}
1.603 + proc p {x} {
1.604 + if {$x==1} {
1.605 + return [array startsearch a]
1.606 + }
1.607 + set a(x) 123
1.608 + }
1.609 + list [catch {p 1} msg] $msg
1.610 +} {1 {"a" isn't an array}}
1.611 +test set-old-8.49 {array command, statistics option} {
1.612 + catch {unset a}
1.613 + set a(abc) 1
1.614 + set a(def) 2
1.615 + set a(ghi) 3
1.616 + set a(jkl) 4
1.617 + set a(mno) 5
1.618 + set a(pqr) 6
1.619 + set a(stu) 7
1.620 + set a(vwx) 8
1.621 + set a(yz) 9
1.622 + array statistics a
1.623 +} "9 entries in table, 4 buckets
1.624 +number of buckets with 0 entries: 0
1.625 +number of buckets with 1 entries: 0
1.626 +number of buckets with 2 entries: 3
1.627 +number of buckets with 3 entries: 1
1.628 +number of buckets with 4 entries: 0
1.629 +number of buckets with 5 entries: 0
1.630 +number of buckets with 6 entries: 0
1.631 +number of buckets with 7 entries: 0
1.632 +number of buckets with 8 entries: 0
1.633 +number of buckets with 9 entries: 0
1.634 +number of buckets with 10 or more entries: 0
1.635 +average search distance for entry: 1.7"
1.636 +test set-old-8.50 {array command, array names -exact on glob pattern} {
1.637 + catch {unset a}
1.638 + set a(1*2) 1
1.639 + list [catch {array names a -exact 1*2} msg] $msg
1.640 +} {0 1*2}
1.641 +test set-old-8.51 {array command, array names -glob on glob pattern} {
1.642 + catch {unset a}
1.643 + set a(1*2) 1
1.644 + set a(12) 1
1.645 + set a(11) 1
1.646 + list [catch {lsort [array names a -glob 1*2]} msg] $msg
1.647 +} {0 {1*2 12}}
1.648 +test set-old-8.52 {array command, array names -regexp on regexp pattern} {
1.649 + catch {unset a}
1.650 + set a(1*2) 1
1.651 + set a(12) 1
1.652 + set a(11) 1
1.653 + list [catch {lsort [array names a -regexp ^1]} msg] $msg
1.654 +} {0 {1*2 11 12}}
1.655 +test set-old-8.53 {array command, array names -regexp} {
1.656 + catch {unset a}
1.657 + set a(-glob) 1
1.658 + set a(-regexp) 1
1.659 + set a(-exact) 1
1.660 + list [catch {array names a -regexp} msg] $msg
1.661 +} {0 -regexp}
1.662 +test set-old-8.54 {array command, array names -exact} {
1.663 + catch {unset a}
1.664 + set a(-glob) 1
1.665 + set a(-regexp) 1
1.666 + set a(-exact) 1
1.667 + list [catch {array names a -exact} msg] $msg
1.668 +} {0 -exact}
1.669 +test set-old-8.55 {array command, array names -glob} {
1.670 + catch {unset a}
1.671 + set a(-glob) 1
1.672 + set a(-regexp) 1
1.673 + set a(-exact) 1
1.674 + list [catch {array names a -glob} msg] $msg
1.675 +} {0 -glob}
1.676 +test set-old-8.56 {array command, array statistics on a non-array} {
1.677 + catch {unset a}
1.678 + list [catch {array statistics a} msg] $msg
1.679 +} [list 1 "\"a\" isn't an array"]
1.680 +
1.681 +test set-old-9.1 {ids for array enumeration} {
1.682 + catch {unset a}
1.683 + set a(a) 1
1.684 + list [array star a] [array star a] [array done a s-1-a; array star a] \
1.685 + [array done a s-2-a; array d a s-3-a; array start a]
1.686 +} {s-1-a s-2-a s-3-a s-1-a}
1.687 +test set-old-9.2 {array enumeration} {
1.688 + catch {unset a}
1.689 + set a(a) 1
1.690 + set a(b) 1
1.691 + set a(c) 1
1.692 + set x [array startsearch a]
1.693 + lsort [list [array nextelement a $x] [array ne a $x] [array next a $x] \
1.694 + [array next a $x] [array next a $x]]
1.695 +} {{} {} a b c}
1.696 +test set-old-9.3 {array enumeration} {
1.697 + catch {unset a}
1.698 + set a(a) 1
1.699 + set a(b) 1
1.700 + set a(c) 1
1.701 + set x [array startsearch a]
1.702 + set y [array startsearch a]
1.703 + set z [array startsearch a]
1.704 + lsort [list [array nextelement a $x] [array ne a $x] \
1.705 + [array next a $y] [array next a $z] [array next a $y] \
1.706 + [array next a $z] [array next a $y] [array next a $z] \
1.707 + [array next a $y] [array next a $z] [array next a $x] \
1.708 + [array next a $x]]
1.709 +} {{} {} {} a a a b b b c c c}
1.710 +test set-old-9.4 {array enumeration: stopping searches} {
1.711 + catch {unset a}
1.712 + set a(a) 1
1.713 + set a(b) 1
1.714 + set a(c) 1
1.715 + set x [array startsearch a]
1.716 + set y [array startsearch a]
1.717 + set z [array startsearch a]
1.718 + lsort [list [array next a $x] [array next a $x] [array next a $y] \
1.719 + [array done a $z; array next a $x] \
1.720 + [array done a $x; array next a $y] [array next a $y]]
1.721 +} {a a b b c c}
1.722 +test set-old-9.5 {array enumeration: stopping searches} {
1.723 + catch {unset a}
1.724 + set a(a) 1
1.725 + set x [array startsearch a]
1.726 + array done a $x
1.727 + list [catch {array next a $x} msg] $msg
1.728 +} {1 {couldn't find search "s-1-a"}}
1.729 +test set-old-9.6 {array enumeration: searches automatically stopped} {
1.730 + catch {unset a}
1.731 + set a(a) 1
1.732 + set x [array startsearch a]
1.733 + set y [array startsearch a]
1.734 + set a(b) 1
1.735 + list [catch {array next a $x} msg] $msg \
1.736 + [catch {array next a $y} msg2] $msg2
1.737 +} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
1.738 +test set-old-9.7 {array enumeration: searches automatically stopped} {
1.739 + catch {unset a}
1.740 + set a(a) 1
1.741 + set x [array startsearch a]
1.742 + set y [array startsearch a]
1.743 + set a(a) 2
1.744 + list [catch {array next a $x} msg] $msg \
1.745 + [catch {array next a $y} msg2] $msg2
1.746 +} {0 a 0 a}
1.747 +test set-old-9.8 {array enumeration: searches automatically stopped} {
1.748 + catch {unset a}
1.749 + set a(a) 1
1.750 + set a(c) 2
1.751 + set x [array startsearch a]
1.752 + set y [array startsearch a]
1.753 + catch {unset a(c)}
1.754 + list [catch {array next a $x} msg] $msg \
1.755 + [catch {array next a $y} msg2] $msg2
1.756 +} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
1.757 +test set-old-9.9 {array enumeration: searches automatically stopped} {
1.758 + catch {unset a}
1.759 + set a(a) 1
1.760 + set x [array startsearch a]
1.761 + set y [array startsearch a]
1.762 + catch {unset a(c)}
1.763 + list [catch {array next a $x} msg] $msg \
1.764 + [catch {array next a $y} msg2] $msg2
1.765 +} {0 a 0 a}
1.766 +test set-old-9.10 {array enumeration: searches automatically stopped} {
1.767 + catch {unset a}
1.768 + set a(a) 1
1.769 + set x [array startsearch a]
1.770 + set y [array startsearch a]
1.771 + trace var a(b) r {}
1.772 + list [catch {array next a $x} msg] $msg \
1.773 + [catch {array next a $y} msg2] $msg2
1.774 +} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
1.775 +test set-old-9.11 {array enumeration: searches automatically stopped} {
1.776 + catch {unset a}
1.777 + set a(a) 1
1.778 + set x [array startsearch a]
1.779 + set y [array startsearch a]
1.780 + trace var a(a) r {}
1.781 + list [catch {array next a $x} msg] $msg \
1.782 + [catch {array next a $y} msg2] $msg2
1.783 +} {0 a 0 a}
1.784 +test set-old-9.12 {array enumeration with traced undefined elements} {
1.785 + catch {unset a}
1.786 + set a(a) 1
1.787 + trace var a(b) r {}
1.788 + set x [array startsearch a]
1.789 + lsort [list [array next a $x] [array next a $x]]
1.790 +} {{} a}
1.791 +
1.792 +test set-old-10.1 {array enumeration errors} {
1.793 + list [catch {array start} msg] $msg
1.794 +} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
1.795 +test set-old-10.2 {array enumeration errors} {
1.796 + list [catch {array start a b} msg] $msg
1.797 +} {1 {wrong # args: should be "array startsearch arrayName"}}
1.798 +test set-old-10.3 {array enumeration errors} {
1.799 + catch {unset a}
1.800 + list [catch {array start a} msg] $msg
1.801 +} {1 {"a" isn't an array}}
1.802 +test set-old-10.4 {array enumeration errors} {
1.803 + catch {unset a}
1.804 + set a(a) 1
1.805 + set x [array startsearch a]
1.806 + list [catch {array next a} msg] $msg
1.807 +} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
1.808 +test set-old-10.5 {array enumeration errors} {
1.809 + catch {unset a}
1.810 + set a(a) 1
1.811 + set x [array startsearch a]
1.812 + list [catch {array next a b c} msg] $msg
1.813 +} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
1.814 +test set-old-10.6 {array enumeration errors} {
1.815 + catch {unset a}
1.816 + set a(a) 1
1.817 + set x [array startsearch a]
1.818 + list [catch {array next a a-1-a} msg] $msg
1.819 +} {1 {illegal search identifier "a-1-a"}}
1.820 +test set-old-10.7 {array enumeration errors} {
1.821 + catch {unset a}
1.822 + set a(a) 1
1.823 + set x [array startsearch a]
1.824 + list [catch {array next a sx1-a} msg] $msg
1.825 +} {1 {illegal search identifier "sx1-a"}}
1.826 +test set-old-10.8 {array enumeration errors} {
1.827 + catch {unset a}
1.828 + set a(a) 1
1.829 + set x [array startsearch a]
1.830 + list [catch {array next a s--a} msg] $msg
1.831 +} {1 {illegal search identifier "s--a"}}
1.832 +test set-old-10.9 {array enumeration errors} {
1.833 + catch {unset a}
1.834 + set a(a) 1
1.835 + set x [array startsearch a]
1.836 + list [catch {array next a s-1-b} msg] $msg
1.837 +} {1 {search identifier "s-1-b" isn't for variable "a"}}
1.838 +test set-old-10.10 {array enumeration errors} {
1.839 + catch {unset a}
1.840 + set a(a) 1
1.841 + set x [array startsearch a]
1.842 + list [catch {array next a s-1ba} msg] $msg
1.843 +} {1 {illegal search identifier "s-1ba"}}
1.844 +test set-old-10.11 {array enumeration errors} {
1.845 + catch {unset a}
1.846 + set a(a) 1
1.847 + set x [array startsearch a]
1.848 + list [catch {array next a s-2-a} msg] $msg
1.849 +} {1 {couldn't find search "s-2-a"}}
1.850 +test set-old-10.12 {array enumeration errors} {
1.851 + list [catch {array done a} msg] $msg
1.852 +} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
1.853 +test set-old-10.13 {array enumeration errors} {
1.854 + list [catch {array done a b c} msg] $msg
1.855 +} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
1.856 +test set-old-10.14 {array enumeration errors} {
1.857 + list [catch {array done a b} msg] $msg
1.858 +} {1 {illegal search identifier "b"}}
1.859 +test set-old-10.15 {array enumeration errors} {
1.860 + list [catch {array anymore a} msg] $msg
1.861 +} {1 {wrong # args: should be "array anymore arrayName searchId"}}
1.862 +test set-old-10.16 {array enumeration errors} {
1.863 + list [catch {array any a b c} msg] $msg
1.864 +} {1 {wrong # args: should be "array anymore arrayName searchId"}}
1.865 +test set-old-10.17 {array enumeration errors} {
1.866 + catch {unset a}
1.867 + set a(0) 44
1.868 + list [catch {array any a bogus} msg] $msg
1.869 +} {1 {illegal search identifier "bogus"}}
1.870 +
1.871 +# Array enumeration with "anymore" option
1.872 +
1.873 +test set-old-11.1 {array anymore option} {
1.874 + catch {unset a}
1.875 + set a(a) 1
1.876 + set a(b) 2
1.877 + set a(c) 3
1.878 + array startsearch a
1.879 + lsort [list [array anymore a s-1-a] [array next a s-1-a] \
1.880 + [array anymore a s-1-a] [array next a s-1-a] \
1.881 + [array anymore a s-1-a] [array next a s-1-a] \
1.882 + [array anymore a s-1-a] [array next a s-1-a]]
1.883 +} {{} 0 1 1 1 a b c}
1.884 +test set-old-11.2 {array anymore option} {
1.885 + catch {unset a}
1.886 + set a(a) 1
1.887 + set a(b) 2
1.888 + set a(c) 3
1.889 + array startsearch a
1.890 + lsort [list [array next a s-1-a] [array next a s-1-a] \
1.891 + [array anymore a s-1-a] [array next a s-1-a] \
1.892 + [array next a s-1-a] [array anymore a s-1-a]]
1.893 +} {{} 0 1 a b c}
1.894 +
1.895 +# Special check to see that the value of a variable is handled correctly
1.896 +# if it is returned as the result of a procedure (must not free the variable
1.897 +# string while deleting the call frame). Errors will only be detected if
1.898 +# a memory consistency checker such as Purify is being used.
1.899 +
1.900 +test set-old-12.1 {cleanup on procedure return} {
1.901 + proc foo {} {
1.902 + set x 12345
1.903 + }
1.904 + foo
1.905 +} 12345
1.906 +test set-old-12.2 {cleanup on procedure return} {
1.907 + proc foo {} {
1.908 + set x(1) 23456
1.909 + }
1.910 + foo
1.911 +} 23456
1.912 +
1.913 +# Must delete variables when done, since these arrays get used as
1.914 +# scalars by other tests.
1.915 +catch {unset a}
1.916 +catch {unset b}
1.917 +catch {unset c}
1.918 +catch {unset aVaRnAmE}
1.919 +
1.920 +# cleanup
1.921 +::tcltest::cleanupTests
1.922 +return