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