util/src/TclTk/tcl8.6.12/tests/set-old.test

   1 # Commands covered:  set, unset, array
   2 #
   3 # This file includes the original set of tests for Tcl's set command.
   4 # Since the set command is now compiled, a new set of tests covering
   5 # the new implementation is in the file "set.test". Sourcing this file
   6 # into Tcl runs the tests and generates output for errors.
   7 # No output means no errors were found.
   8 #
   9 # Copyright (c) 1991-1993 The Regents of the University of California.
  10 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  11 # Copyright (c) 1998-1999 by Scriptics Corporation.
  12 #
  13 # See the file "license.terms" for information on usage and redistribution
  14 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15
  16 if {"::tcltest" ni [namespace children]} {
  17     package require tcltest 2.5
  18     namespace import -force ::tcltest::*
  19 }
  20
  21 proc ignore args {}
  22 \f
  23 # Simple variable operations.
  24
  25 catch {unset a}
  26 test set-old-1.1 {basic variable setting and unsetting} {
  27     set a 22
  28 } 22
  29 test set-old-1.2 {basic variable setting and unsetting} {
  30     set a 123
  31     set a
  32 } 123
  33 test set-old-1.3 {basic variable setting and unsetting} {
  34     set a xxx
  35     format %s $a
  36 } xxx
  37 test set-old-1.4 {basic variable setting and unsetting} {
  38     set a 44
  39     unset a
  40     list [catch {set a} msg] $msg
  41 } {1 {can't read "a": no such variable}}
  42
  43 # Basic array operations.
  44
  45 catch {unset a}
  46 set a(xyz) 2
  47 set a(44) 3
  48 set {a(a long name)} test
  49 test set-old-2.1 {basic array operations} {
  50     lsort [array names a]
  51 } {44 {a long name} xyz}
  52 test set-old-2.2 {basic array operations} {
  53     set a(44)
  54 } 3
  55 test set-old-2.3 {basic array operations} {
  56     set a(xyz)
  57 } 2
  58 test set-old-2.4 {basic array operations} {
  59     set "a(a long name)"
  60 } test
  61 test set-old-2.5 {basic array operations} {
  62     list [catch {set a(other)} msg] $msg
  63 } {1 {can't read "a(other)": no such element in array}}
  64 test set-old-2.6 {basic array operations} {
  65     list [catch {set a} msg] $msg
  66 } {1 {can't read "a": variable is array}}
  67 test set-old-2.7 {basic array operations} {
  68     format %s $a(44)
  69 } 3
  70 test set-old-2.8 {basic array operations} {
  71     format %s $a(a long name)
  72 } test
  73 unset a(44)
  74 test set-old-2.9 {basic array operations} {
  75     lsort [array names a]
  76 } {{a long name} xyz}
  77 test set-old-2.10 {basic array operations} {
  78     catch {unset b}
  79     list [catch {set b(123)} msg] $msg
  80 } {1 {can't read "b(123)": no such variable}}
  81 test set-old-2.11 {basic array operations} {
  82     catch {unset b}
  83     set b 44
  84     list [catch {set b(123)} msg] $msg
  85 } {1 {can't read "b(123)": variable isn't array}}
  86 test set-old-2.12 {basic array operations} {
  87     list [catch {set a 14} msg] $msg
  88 } {1 {can't set "a": variable is array}}
  89 unset a
  90 test set-old-2.13 {basic array operations} {
  91     list [catch {set a(xyz)} msg] $msg
  92 } {1 {can't read "a(xyz)": no such variable}}
  93
  94 # Test the set commands, and exercise the corner cases of the code
  95 # that parses array references into two parts.
  96
  97 test set-old-3.1 {set command} {
  98     list [catch {set} msg] $msg
  99 } {1 {wrong # args: should be "set varName ?newValue?"}}
 100 test set-old-3.2 {set command} {
 101     list [catch {set x y z} msg] $msg
 102 } {1 {wrong # args: should be "set varName ?newValue?"}}
 103 test set-old-3.3 {set command} {
 104     catch {unset a}
 105     list [catch {set a} msg] $msg
 106 } {1 {can't read "a": no such variable}}
 107 test set-old-3.4 {set command} {
 108     catch {unset a}
 109     set a(14) 83
 110     list [catch {set a 22} msg] $msg
 111 } {1 {can't set "a": variable is array}}
 112
 113 # Test the corner-cases of parsing array names, using set and unset.
 114
 115 test set-old-4.1 {parsing array names} {
 116     catch {unset a}
 117     set a(()) 44
 118     list [catch {array names a} msg] $msg
 119 } {0 ()}
 120 test set-old-4.2 {parsing array names} {
 121     catch {unset a a(abcd}
 122     set a(abcd 33
 123     info exists a(abcd
 124 } 1
 125 test set-old-4.3 {parsing array names} {
 126     catch {unset a a(abcd}
 127     set a(abcd 33
 128     list [catch {array names a} msg] $msg
 129 } {0 {}}
 130 test set-old-4.4 {parsing array names} {
 131     catch {unset a abcd)}
 132     set abcd) 33
 133     info exists abcd)
 134 } 1
 135 test set-old-4.5 {parsing array names} {
 136     set a(bcd yyy
 137     catch {unset a}
 138     list [catch {set a(bcd} msg] $msg
 139 } {0 yyy}
 140 test set-old-4.6 {parsing array names} {
 141     catch {unset a}
 142     set a 44
 143     list [catch {set a(bcd test} msg] $msg
 144 } {0 test}
 145
 146 # Errors in reading variables
 147
 148 test set-old-5.1 {errors in reading variables} {
 149     catch {unset a}
 150     list [catch {set a} msg] $msg
 151 } {1 {can't read "a": no such variable}}
 152 test set-old-5.2 {errors in reading variables} {
 153     catch {unset a}
 154     set a 44
 155     list [catch {set a(18)} msg] $msg
 156 } {1 {can't read "a(18)": variable isn't array}}
 157 test set-old-5.3 {errors in reading variables} {
 158     catch {unset a}
 159     set a(6) 44
 160     list [catch {set a(18)} msg] $msg
 161 } {1 {can't read "a(18)": no such element in array}}
 162 test set-old-5.4 {errors in reading variables} {
 163     catch {unset a}
 164     set a(6) 44
 165     list [catch {set a} msg] $msg
 166 } {1 {can't read "a": variable is array}}
 167
 168 # Errors and other special cases in writing variables
 169
 170 test set-old-6.1 {creating array during write} {
 171     catch {unset a}
 172     trace var a rwu ignore
 173     list [catch {set a(14) 186} msg] $msg [array names a]
 174 } {0 186 14}
 175 test set-old-6.2 {errors in writing variables} {
 176     catch {unset a}
 177     set a xxx
 178     list [catch {set a(14) 186} msg] $msg
 179 } {1 {can't set "a(14)": variable isn't array}}
 180 test set-old-6.3 {errors in writing variables} {
 181     catch {unset a}
 182     set a(100) yyy
 183     list [catch {set a 2} msg] $msg
 184 } {1 {can't set "a": variable is array}}
 185 test set-old-6.4 {expanding variable size} {
 186     catch {unset a}
 187     list [set a short] [set a "longer name"] [set a "even longer name"] \
 188             [set a "a much much truly longer name"]
 189 } {short {longer name} {even longer name} {a much much truly longer name}}
 190
 191 # Unset command, Tcl_UnsetVar procedures
 192
 193 test set-old-7.1 {unset command} {
 194     catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
 195     set a 44
 196     set b 55
 197     set c 66
 198     set d 77
 199     unset a b c
 200     list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
 201             [catch {set d(0) 0}]
 202 } {0 0 0 1}
 203 test set-old-7.2 {unset command} {
 204     list [catch {unset} msg] $msg
 205 } {0 {}}
 206 # Used to return:
 207 #{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}}
 208 test set-old-7.3 {unset command} {
 209     catch {unset a}
 210     list [catch {unset a} msg] $msg
 211 } {1 {can't unset "a": no such variable}}
 212 test set-old-7.4 {unset command} {
 213     catch {unset a}
 214     set a 44
 215     list [catch {unset a(14)} msg] $msg
 216 } {1 {can't unset "a(14)": variable isn't array}}
 217 test set-old-7.5 {unset command} {
 218     catch {unset a}
 219     set a(0) xx
 220     list [catch {unset a(14)} msg] $msg
 221 } {1 {can't unset "a(14)": no such element in array}}
 222 test set-old-7.6 {unset command} {
 223     catch {unset a}; catch {unset b}; catch {unset c}
 224     set a foo
 225     set c gorp
 226     list [catch {unset a a a(14)} msg] $msg [info exists c]
 227 } {1 {can't unset "a": no such variable} 1}
 228 test set-old-7.7 {unsetting globals from within procedures} {
 229     set y 0
 230     proc p1 {} {
 231         global y
 232         set z [p2]
 233         return [list $z [catch {set y} msg] $msg]
 234     }
 235     proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
 236     p1
 237 } {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
 238 test set-old-7.8 {unsetting globals from within procedures} {
 239     set y 0
 240     proc p1 {} {
 241         global y
 242         p2
 243         return [list [catch {set y 44} msg] $msg]
 244     }
 245     proc p2 {} {global y; unset y}
 246     concat [p1] [list [catch {set y} msg] $msg]
 247 } {0 44 0 44}
 248 test set-old-7.9 {unsetting globals from within procedures} {
 249     set y 0
 250     proc p1 {} {
 251         global y
 252         unset y
 253         return [list [catch {set y 55} msg] $msg]
 254     }
 255     concat [p1] [list [catch {set y} msg] $msg]
 256 } {0 55 0 55}
 257 test set-old-7.10 {unset command} {
 258     catch {unset a}
 259     set a(14) 22
 260     unset a(14)
 261     list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
 262 } {1 {can't read "a(14)": no such element in array} 0 {}}
 263 test set-old-7.11 {unset command} {
 264     catch {unset a}
 265     set a(14) 22
 266     unset a
 267     list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
 268 } {1 {can't read "a(14)": no such variable} 0 {}}
 269 test set-old-7.12 {unset command, -nocomplain} {
 270     catch {unset a}
 271     list [info exists a] [catch {unset -nocomplain a}] [info exists a]
 272 } {0 0 0}
 273 test set-old-7.13 {unset command, -nocomplain} {
 274     set -nocomplain abc
 275     list [info exists -nocomplain] [catch {unset -nocomplain}] \
 276             [info exists -nocomplain] [catch {unset -- -nocomplain}] \
 277             [info exists -nocomplain]
 278 } {1 0 1 0 0}
 279 test set-old-7.14 {unset command, --} {
 280     set -- abc
 281     list [info exists --] [catch {unset --}] \
 282             [info exists --] [catch {unset -- --}] \
 283             [info exists --]
 284 } {1 0 1 0 0}
 285 test set-old-7.15 {unset command, -nocomplain} {
 286     set -nocomplain abc
 287     set -- abc
 288     list [info exists -nocomplain] [catch {unset -- -nocomplain}] \
 289             [info exists -nocomplain] [info exists --] \
 290             [catch {unset -- -nocomplain}] [info exists --] \
 291             [catch {unset -- --}] [info exists --]
 292 } {1 0 0 1 1 1 0 0}
 293 test set-old-7.16 {unset command, -nocomplain} {
 294     set -nocomplain abc
 295     set var abc
 296     list [info exists bogus] [catch {unset -nocomplain bogus var bogus}] \
 297             [info exists -nocomplain] [info exists var] \
 298             [catch {unset -nocomplain -nocomplain}] [info exists -nocomplain]
 299 } {0 0 1 0 0 0}
 300 test set-old-7.17 {unset command, -nocomplain (no abbreviation)} {
 301     set -nocomp abc
 302     list [info exists -nocomp] [catch {unset -nocomp}] [info exists -nocomp]
 303 } {1 0 0}
 304 test set-old-7.18 {unset command, -nocomplain (no abbreviation)} {
 305     catch {unset -nocomp}
 306     list [info exists -nocomp] [catch {unset -nocomp}]
 307 } {0 1}
 308 test set-old-7.19 {unset command, both switches} {
 309     set -- val
 310     list [info exists --] [catch {unset -nocomplain --}] [info exists --]\
 311         [catch {unset -nocomplain -- --}] [info exists --]
 312 } {1 0 1 0 0}
 313
 314 # Array command.
 315
 316 test set-old-8.1 {array command} {
 317     list [catch {array} msg] $msg
 318 } {1 {wrong # args: should be "array subcommand ?arg ...?"}}
 319 test set-old-8.2 {array command} {
 320     list [catch {array a} msg] $msg
 321 } {1 {wrong # args: should be "array anymore arrayName searchId"}}
 322 test set-old-8.3 {array command} {
 323     catch {unset a}
 324     list [catch {array anymore a b} msg] $msg
 325 } {1 {"a" isn't an array}}
 326 test set-old-8.4 {array command} {
 327     catch {unset a}
 328     set a 44
 329     list [catch {array anymore a b} msg] $msg
 330 } {1 {"a" isn't an array}}
 331 test set-old-8.5 {array command} {
 332     proc foo {} {
 333         set a 44
 334         upvar 0 a x
 335         list [catch {array anymore x b} msg] $msg
 336     }
 337     foo
 338 } {1 {"x" isn't an array}}
 339 test set-old-8.6 {array command} {
 340     catch {unset a}
 341     set a(22) 3
 342     list [catch {array gorp a} msg] $msg
 343 } {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
 344 test set-old-8.7 {array command, anymore option} {
 345     catch {unset a}
 346     list [catch {array anymore a x} msg] $msg
 347 } {1 {"a" isn't an array}}
 348 test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
 349     proc foo {x} {
 350         if {$x==1} {
 351             return [array anymore a x]
 352         }
 353         set a(x) 123
 354     }
 355     list [catch {foo 1} msg] $msg
 356 } {1 {"a" isn't an array}}
 357 test set-old-8.9 {array command, donesearch option} {
 358     catch {unset a}
 359     list [catch {array donesearch a x} msg] $msg
 360 } {1 {"a" isn't an array}}
 361 test set-old-8.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
 362     proc foo {x} {
 363         if {$x==1} {
 364             return [array donesearch a x]
 365         }
 366         set a(x) 123
 367     }
 368     list [catch {foo 1} msg] $msg
 369 } {1 {"a" isn't an array}}
 370 test set-old-8.11 {array command, exists option} {
 371     list [catch {array exists a b} msg] $msg
 372 } {1 {wrong # args: should be "array exists arrayName"}}
 373 test set-old-8.12 {array command, exists option} {
 374     catch {unset a}
 375     array exists a
 376 } {0}
 377 test set-old-8.13 {array command, exists option} {
 378     catch {unset a}
 379     set a(0) 1
 380     array exists a
 381 } {1}
 382 test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
 383     proc foo {x} {
 384         if {$x==1} {
 385             return [array exists a]
 386         }
 387         set a(x) 123
 388     }
 389     list [catch {foo 1} msg] $msg
 390 } {0 0}
 391 test set-old-8.15 {array command, get option} {
 392     list [catch {array get} msg] $msg
 393 } {1 {wrong # args: should be "array get arrayName ?pattern?"}}
 394 test set-old-8.16 {array command, get option} {
 395     list [catch {array get a b c} msg] $msg
 396 } {1 {wrong # args: should be "array get arrayName ?pattern?"}}
 397 test set-old-8.17 {array command, get option} {
 398     catch {unset a}
 399     array get a
 400 } {}
 401 test set-old-8.18 {array command, get option} {
 402     catch {unset a}
 403     set a(22) 3
 404     set {a(long name)} {}
 405     lsort [array get a]
 406 } {{} 22 3 {long name}}
 407 test set-old-8.19 {array command, get option (unset variable)} {
 408     catch {unset a}
 409     set a(x) 3
 410     trace var a(y) w ignore
 411     array get a
 412 } {x 3}
 413 test set-old-8.20 {array command, get option, with pattern} {
 414     catch {unset a}
 415     set a(x1) 3
 416     set a(x2) 4
 417     set a(x3) 5
 418     set a(b1) 24
 419     set a(b2) 25
 420     lsort [array get a x*]
 421 } {3 4 5 x1 x2 x3}
 422 test set-old-8.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} {
 423     proc foo {x} {
 424         if {$x==1} {
 425             return [array get a]
 426         }
 427         set a(x) 123
 428     }
 429     list [catch {foo 1} msg] $msg
 430 } {0 {}}
 431 test set-old-8.22 {array command, names option} {
 432     catch {unset a}
 433     set a(22) 3
 434     list [catch {array names a 4 5} msg] $msg
 435 } {1 {bad option "4": must be -exact, -glob, or -regexp}}
 436 test set-old-8.23 {array command, names option} {
 437     catch {unset a}
 438     array names a
 439 } {}
 440 test set-old-8.24 {array command, names option} {
 441     catch {unset a}
 442     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
 443     list [catch {lsort [array names a]} msg] $msg
 444 } {0 {22 Textual_name {name with spaces}}}
 445 test set-old-8.25 {array command, names option} {
 446     catch {unset a}
 447     set a(22) 3; set a(33) 44;
 448     trace var a(xxx) w ignore
 449     list [catch {lsort [array names a]} msg] $msg
 450 } {0 {22 33}}
 451 test set-old-8.26 {array command, names option} {
 452     catch {unset a}
 453     set a(22) 3; set a(33) 44;
 454     trace var a(xxx) w ignore
 455     set a(xxx) value
 456     list [catch {lsort [array names a]} msg] $msg
 457 } {0 {22 33 xxx}}
 458 test set-old-8.27 {array command, names option} {
 459     catch {unset a}
 460     set a(axy) 3
 461     set a(bxy) 44
 462     set a(no) yes
 463     set a(xxx) value
 464     list [lsort [array names a *xy]] [lsort [array names a]]
 465 } {{axy bxy} {axy bxy no xxx}}
 466 test set-old-8.28 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} {
 467     proc foo {x} {
 468         if {$x==1} {
 469             return [array names a]
 470         }
 471         set a(x) 123
 472     }
 473     list [catch {foo 1} msg] $msg
 474 } {0 {}}
 475 test set-old-8.29 {array command, nextelement option} {
 476     list [catch {array nextelement a} msg] $msg
 477 } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
 478 test set-old-8.30 {array command, nextelement option} {
 479     catch {unset a}
 480     list [catch {array nextelement a b} msg] $msg
 481 } {1 {"a" isn't an array}}
 482 test set-old-8.31 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} {
 483     proc foo {x} {
 484         if {$x==1} {
 485             return [array nextelement a b]
 486         }
 487         set a(x) 123
 488     }
 489     list [catch {foo 1} msg] $msg
 490 } {1 {"a" isn't an array}}
 491 test set-old-8.32 {array command, set option} {
 492     list [catch {array set a} msg] $msg
 493 } {1 {wrong # args: should be "array set arrayName list"}}
 494 test set-old-8.33 {array command, set option} {
 495     list [catch {array set a 1 2} msg] $msg
 496 } {1 {wrong # args: should be "array set arrayName list"}}
 497 test set-old-8.34 {array command, set option} {
 498     list [catch {array set a "a \{ c"} msg] $msg
 499 } {1 {unmatched open brace in list}}
 500 test set-old-8.35 {array command, set option} {
 501     catch {unset a}
 502     set a 44
 503     list [catch {array set a {a b c d}} msg] $msg
 504 } {1 {can't set "a(a)": variable isn't array}}
 505 test set-old-8.36 {array command, set option} {
 506     catch {unset a}
 507     set a(xx) yy
 508     array set a {b c d e}
 509     lsort [array get a]
 510 } {b c d e xx yy}
 511 test set-old-8.37 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
 512     proc foo {x} {
 513         if {$x==1} {
 514             return [array set a {x 0}]
 515         }
 516         set a(x)
 517     }
 518     list [catch {foo 1} msg] $msg
 519 } {0 {}}
 520 test set-old-8.38 {array command, set option} {
 521     catch {unset aVaRnAmE}
 522     array set aVaRnAmE {}
 523     list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
 524 } {1 1 {can't read "aVaRnAmE": variable is array}}
 525 test set-old-8.38.1 {array command, set scalar} {
 526     catch {unset aVaRnAmE}
 527     set aVaRnAmE 1
 528     list [catch {array set aVaRnAmE {}} msg] $msg
 529 } {1 {can't array set "aVaRnAmE": variable isn't array}}
 530 test set-old-8.38.2 {array command, set alias} {
 531     catch {unset aVaRnAmE}
 532     upvar 0 aVaRnAmE anAliAs
 533     array set anAliAs {}
 534     list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg
 535 } {1 1 {can't read "anAliAs": variable is array}}
 536 test set-old-8.38.3 {array command, set element alias} {
 537     catch {unset aVaRnAmE}
 538     list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \
 539             [catch {array set elemAliAs {}} msg] $msg
 540 } {0 1 {can't array set "elemAliAs": variable isn't array}}
 541 test set-old-8.38.4 {array command, empty set with populated array} {
 542     catch {unset aVaRnAmE}
 543     array set aVaRnAmE [list e1 v1 e2 v2]
 544     array set aVaRnAmE {}
 545     array set aVaRnAmE [list e3 v3]
 546     list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
 547 } {{e1 e2 e3} 0 v2}
 548 test set-old-8.38.5 {array command, set with non-existent namespace} {
 549     list [catch {array set bogusnamespace::var {}} msg] $msg
 550 } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
 551 test set-old-8.38.6 {array command, set with non-existent namespace} {
 552     list [catch {array set bogusnamespace::var {a b}} msg] $msg
 553 } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
 554 test set-old-8.38.7 {array command, set with non-existent namespace} {
 555     list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
 556 } {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}}
 557 test set-old-8.39 {array command, size option} {
 558     catch {unset a}
 559     array size a
 560 } {0}
 561 test set-old-8.40 {array command, size option} {
 562     list [catch {array size a 4} msg] $msg
 563 } {1 {wrong # args: should be "array size arrayName"}}
 564 test set-old-8.41 {array command, size option} {
 565     catch {unset a}
 566     array size a
 567 } {0}
 568 test set-old-8.42 {array command, size option} {
 569     catch {unset a}
 570     set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
 571     list [catch {array size a} msg] $msg
 572 } {0 3}
 573 test set-old-8.43 {array command, size option} {
 574     catch {unset a}
 575     set a(22) 3; set a(xx) 44; set a(y) xxx
 576     unset a(22) a(y) a(xx)
 577     list [catch {array size a} msg] $msg
 578 } {0 0}
 579 test set-old-8.44 {array command, size option} {
 580     catch {unset a}
 581     set a(22) 3;
 582     trace var a(33) rwu ignore
 583     list [catch {array size a} msg] $msg
 584 } {0 1}
 585 test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
 586     proc foo {x} {
 587         if {$x==1} {
 588             return [array size a]
 589         }
 590         set a(x) 123
 591     }
 592     list [catch {foo 1} msg] $msg
 593 } {0 0}
 594 test set-old-8.46 {array command, startsearch option} {
 595     list [catch {array startsearch a b} msg] $msg
 596 } {1 {wrong # args: should be "array startsearch arrayName"}}
 597 test set-old-8.47 {array command, startsearch option} {
 598     catch {unset a}
 599     list [catch {array startsearch a} msg] $msg
 600 } {1 {"a" isn't an array}}
 601 test set-old-8.48 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
 602     catch {rename p ""}
 603     proc p {x} {
 604         if {$x==1} {
 605             return [array startsearch a]
 606         }
 607         set a(x) 123
 608     }
 609     list [catch {p 1} msg] $msg
 610 } {1 {"a" isn't an array}}
 611 test set-old-8.49 {array command, statistics option} {
 612     catch {unset a}
 613     set a(abc) 1
 614     set a(def) 2
 615     set a(ghi) 3
 616     set a(jkl) 4
 617     set a(mno) 5
 618     set a(pqr) 6
 619     set a(stu) 7
 620     set a(vwx) 8
 621     set a(yz) 9
 622     array statistics a
 623 } "9 entries in table, 4 buckets
 624 number of buckets with 0 entries: 0
 625 number of buckets with 1 entries: 0
 626 number of buckets with 2 entries: 3
 627 number of buckets with 3 entries: 1
 628 number of buckets with 4 entries: 0
 629 number of buckets with 5 entries: 0
 630 number of buckets with 6 entries: 0
 631 number of buckets with 7 entries: 0
 632 number of buckets with 8 entries: 0
 633 number of buckets with 9 entries: 0
 634 number of buckets with 10 or more entries: 0
 635 average search distance for entry: 1.7"
 636 test set-old-8.50 {array command, array names -exact on glob pattern} {
 637     catch {unset a}
 638     set a(1*2) 1
 639     list [catch {array names a -exact 1*2} msg] $msg
 640 } {0 1*2}
 641 test set-old-8.51 {array command, array names -glob on glob pattern} {
 642     catch {unset a}
 643     set a(1*2) 1
 644     set a(12) 1
 645     set a(11) 1
 646     list [catch {lsort [array names a -glob 1*2]} msg] $msg
 647 } {0 {1*2 12}}
 648 test set-old-8.52 {array command, array names -regexp on regexp pattern} {
 649     catch {unset a}
 650     set a(1*2) 1
 651     set a(12) 1
 652     set a(11) 1
 653     list [catch {lsort [array names a -regexp ^1]} msg] $msg
 654 } {0 {1*2 11 12}}
 655 test set-old-8.52.1 {array command, array names -regexp, backrefs} {
 656     catch {unset a}
 657     set a(1*2) 1
 658     set a(12) 1
 659     set a(11) 1
 660     list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg
 661 } {0 11}
 662 test set-old-8.53 {array command, array names -regexp} {
 663     catch {unset a}
 664     set a(-glob) 1
 665     set a(-regexp) 1
 666     set a(-exact) 1
 667     list [catch {array names a -regexp} msg] $msg
 668 } {0 -regexp}
 669 test set-old-8.54 {array command, array names -exact} {
 670     catch {unset a}
 671     set a(-glob) 1
 672     set a(-regexp) 1
 673     set a(-exact) 1
 674     list [catch {array names a -exact} msg] $msg
 675 } {0 -exact}
 676 test set-old-8.55 {array command, array names -glob} {
 677     catch {unset a}
 678     set a(-glob) 1
 679     set a(-regexp) 1
 680     set a(-exact) 1
 681     list [catch {array names a -glob} msg] $msg
 682 } {0 -glob}
 683 test set-old-8.56 {array command, array statistics on a non-array} {
 684     catch {unset a}
 685     list [catch {array statistics a} msg] $msg
 686 } [list 1 "\"a\" isn't an array"]
 687 test set-old-8.57 {array command, array get with trivial pattern} {
 688     catch {unset a}
 689     set a(x) 1
 690     set a(y) 2
 691     array get a x
 692 } {x 1}
 693 test set-old-8.58 {array command, array set with LVT and odd length literal} {
 694     list [catch {apply {{} {
 695         array set a {b c d}
 696     }}} msg] $msg
 697 } {1 {list must have an even number of elements}}
 698
 699 test set-old-9.1 {ids for array enumeration} {
 700     catch {unset a}
 701     set a(a) 1
 702     list [array star a] [array star a] [array done a s-1-a; array star a] \
 703             [array done a s-2-a; array d a s-3-a; array start a]
 704 } {s-1-a s-2-a s-3-a s-1-a}
 705 test set-old-9.2 {array enumeration} {
 706     catch {unset a}
 707     set a(a) 1
 708     set a(b) 1
 709     set a(c) 1
 710     set x [array startsearch a]
 711     lsort [list [array nextelement a $x] [array ne a $x] [array next a $x] \
 712             [array next a $x] [array next a $x]]
 713 } {{} {} a b c}
 714 test set-old-9.3 {array enumeration} {
 715     catch {unset a}
 716     set a(a) 1
 717     set a(b) 1
 718     set a(c) 1
 719     set x [array startsearch a]
 720     set y [array startsearch a]
 721     set z [array startsearch a]
 722     lsort [list [array nextelement a $x] [array ne a $x] \
 723             [array next a $y] [array next a $z] [array next a $y] \
 724             [array next a $z] [array next a $y] [array next a $z] \
 725             [array next a $y] [array next a $z] [array next a $x] \
 726             [array next a $x]]
 727 } {{} {} {} a a a b b b c c c}
 728 test set-old-9.4 {array enumeration: stopping searches} {
 729     catch {unset a}
 730     set a(a) 1
 731     set a(b) 1
 732     set a(c) 1
 733     set x [array startsearch a]
 734     set y [array startsearch a]
 735     set z [array startsearch a]
 736     lsort [list [array next a $x] [array next a $x] [array next a $y] \
 737             [array done a $z; array next a $x] \
 738             [array done a $x; array next a $y] [array next a $y]]
 739 } {a a b b c c}
 740 test set-old-9.5 {array enumeration: stopping searches} {
 741     catch {unset a}
 742     set a(a) 1
 743     set x [array startsearch a]
 744     array done a $x
 745     list [catch {array next a $x} msg] $msg
 746 } {1 {couldn't find search "s-1-a"}}
 747 test set-old-9.6 {array enumeration: searches automatically stopped} {
 748     catch {unset a}
 749     set a(a) 1
 750     set x [array startsearch a]
 751     set y [array startsearch a]
 752     set a(b) 1
 753     list [catch {array next a $x} msg] $msg \
 754             [catch {array next a $y} msg2] $msg2
 755 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
 756 test set-old-9.7 {array enumeration: searches automatically stopped} {
 757     catch {unset a}
 758     set a(a) 1
 759     set x [array startsearch a]
 760     set y [array startsearch a]
 761     set a(a) 2
 762     list [catch {array next a $x} msg] $msg \
 763             [catch {array next a $y} msg2] $msg2
 764 } {0 a 0 a}
 765 test set-old-9.8 {array enumeration: searches automatically stopped} {
 766     catch {unset a}
 767     set a(a) 1
 768     set a(c) 2
 769     set x [array startsearch a]
 770     set y [array startsearch a]
 771     catch {unset a(c)}
 772     list [catch {array next a $x} msg] $msg \
 773             [catch {array next a $y} msg2] $msg2
 774 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
 775 test set-old-9.9 {array enumeration: searches automatically stopped} {
 776     catch {unset a}
 777     set a(a) 1
 778     set x [array startsearch a]
 779     set y [array startsearch a]
 780     catch {unset a(c)}
 781     list [catch {array next a $x} msg] $msg \
 782             [catch {array next a $y} msg2] $msg2
 783 } {0 a 0 a}
 784 test set-old-9.10 {array enumeration: searches automatically stopped} {
 785     catch {unset a}
 786     set a(a) 1
 787     set x [array startsearch a]
 788     set y [array startsearch a]
 789     trace var a(b) r {}
 790     list [catch {array next a $x} msg] $msg \
 791             [catch {array next a $y} msg2] $msg2
 792 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
 793 test set-old-9.11 {array enumeration: searches automatically stopped} {
 794     catch {unset a}
 795     set a(a) 1
 796     set x [array startsearch a]
 797     set y [array startsearch a]
 798     trace var a(a) r {}
 799     list [catch {array next a $x} msg] $msg \
 800             [catch {array next a $y} msg2] $msg2
 801 } {0 a 0 a}
 802 test set-old-9.12 {array enumeration with traced undefined elements} {
 803     catch {unset a}
 804     set a(a) 1
 805     trace var a(b) r {}
 806     set x [array startsearch a]
 807     lsort [list [array next a $x] [array next a $x]]
 808 } {{} a}
 809
 810 test set-old-10.1 {array enumeration errors} {
 811     list [catch {array start} msg] $msg
 812 } {1 {wrong # args: should be "array startsearch arrayName"}}
 813 test set-old-10.2 {array enumeration errors} {
 814     list [catch {array start a b} msg] $msg
 815 } {1 {wrong # args: should be "array startsearch arrayName"}}
 816 test set-old-10.3 {array enumeration errors} {
 817     catch {unset a}
 818     list [catch {array start a} msg] $msg
 819 } {1 {"a" isn't an array}}
 820 test set-old-10.4 {array enumeration errors} {
 821     catch {unset a}
 822     set a(a) 1
 823     set x [array startsearch a]
 824     list [catch {array next a} msg] $msg
 825 } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
 826 test set-old-10.5 {array enumeration errors} {
 827     catch {unset a}
 828     set a(a) 1
 829     set x [array startsearch a]
 830     list [catch {array next a b c} msg] $msg
 831 } {1 {wrong # args: should be "array nextelement arrayName searchId"}}
 832 test set-old-10.6 {array enumeration errors} {
 833     catch {unset a}
 834     set a(a) 1
 835     set x [array startsearch a]
 836     list [catch {array next a a-1-a} msg] $msg
 837 } {1 {illegal search identifier "a-1-a"}}
 838 test set-old-10.7 {array enumeration errors} {
 839     catch {unset a}
 840     set a(a) 1
 841     set x [array startsearch a]
 842     list [catch {array next a sx1-a} msg] $msg
 843 } {1 {illegal search identifier "sx1-a"}}
 844 test set-old-10.8 {array enumeration errors} {
 845     catch {unset a}
 846     set a(a) 1
 847     set x [array startsearch a]
 848     list [catch {array next a s--a} msg] $msg
 849 } {1 {illegal search identifier "s--a"}}
 850 test set-old-10.9 {array enumeration errors} {
 851     catch {unset a}
 852     set a(a) 1
 853     set x [array startsearch a]
 854     list [catch {array next a s-1-b} msg] $msg
 855 } {1 {search identifier "s-1-b" isn't for variable "a"}}
 856 test set-old-10.10 {array enumeration errors} {
 857     catch {unset a}
 858     set a(a) 1
 859     set x [array startsearch a]
 860     list [catch {array next a s-1ba} msg] $msg
 861 } {1 {illegal search identifier "s-1ba"}}
 862 test set-old-10.11 {array enumeration errors} {
 863     catch {unset a}
 864     set a(a) 1
 865     set x [array startsearch a]
 866     list [catch {array next a s-2-a} msg] $msg
 867 } {1 {couldn't find search "s-2-a"}}
 868 test set-old-10.12 {array enumeration errors} {
 869     list [catch {array done a} msg] $msg
 870 } {1 {wrong # args: should be "array donesearch arrayName searchId"}}
 871 test set-old-10.13 {array enumeration errors} {
 872     list [catch {array done a b c} msg] $msg
 873 } {1 {wrong # args: should be "array donesearch arrayName searchId"}}
 874 test set-old-10.14 {array enumeration errors} {
 875     catch {unset a}
 876     set a(a) a
 877     list [catch {array done a b} msg] $msg
 878 } {1 {illegal search identifier "b"}}
 879 test set-old-10.15 {array enumeration errors} {
 880     list [catch {array anymore a} msg] $msg
 881 } {1 {wrong # args: should be "array anymore arrayName searchId"}}
 882 test set-old-10.16 {array enumeration errors} {
 883     list [catch {array any a b c} msg] $msg
 884 } {1 {wrong # args: should be "array anymore arrayName searchId"}}
 885 test set-old-10.17 {array enumeration errors} {
 886     catch {unset a}
 887     set a(0) 44
 888     list [catch {array any a bogus} msg] $msg
 889 } {1 {illegal search identifier "bogus"}}
 890
 891 # Array enumeration with "anymore" option
 892
 893 test set-old-11.1 {array anymore option} {
 894     catch {unset a}
 895     set a(a) 1
 896     set a(b) 2
 897     set a(c) 3
 898     array startsearch a
 899     lsort [list [array anymore a s-1-a] [array next a s-1-a] \
 900             [array anymore a s-1-a] [array next a s-1-a] \
 901             [array anymore a s-1-a] [array next a s-1-a] \
 902             [array anymore a s-1-a] [array next a s-1-a]]
 903 } {{} 0 1 1 1 a b c}
 904 test set-old-11.2 {array anymore option} {
 905     catch {unset a}
 906     set a(a) 1
 907     set a(b) 2
 908     set a(c) 3
 909     array startsearch a
 910     lsort [list [array next a s-1-a] [array next a s-1-a] \
 911             [array anymore a s-1-a] [array next a s-1-a] \
 912             [array next a s-1-a] [array anymore a s-1-a]]
 913 } {{} 0 1 a b c}
 914
 915 # Special check to see that the value of a variable is handled correctly
 916 # if it is returned as the result of a procedure (must not free the variable
 917 # string while deleting the call frame).  Errors will only be detected if
 918 # a memory consistency checker such as Purify is being used.
 919
 920 test set-old-12.1 {cleanup on procedure return} {
 921     proc foo {} {
 922         set x 12345
 923     }
 924     foo
 925 } 12345
 926 test set-old-12.2 {cleanup on procedure return} {
 927     proc foo {} {
 928         set x(1) 23456
 929     }
 930     foo
 931 } 23456
 932 \f
 933 # Must delete variables when done, since these arrays get used as
 934 # scalars by other tests.
 935 catch {unset a}
 936 catch {unset b}
 937 catch {unset c}
 938 catch {unset aVaRnAmE}
 939 catch {rename foo {}}
 940
 941 # cleanup
 942 ::tcltest::cleanupTests
 943 return
 944
 945 # Local Variables:
 946 # mode: tcl
 947 # End: