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 © 1991-1993 The Regents of the University of California. 10# Copyright © 1994-1997 Sun Microsystems, Inc. 11# Copyright © 1998-1999 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 16if {"::tcltest" ni [namespace children]} { 17 package require tcltest 2.5 18 namespace import -force ::tcltest::* 19} 20 21proc ignore args {} 22 23# Simple variable operations. 24 25catch {unset a} 26test set-old-1.1 {basic variable setting and unsetting} { 27 set a 22 28} 22 29test set-old-1.2 {basic variable setting and unsetting} { 30 set a 123 31 set a 32} 123 33test set-old-1.3 {basic variable setting and unsetting} { 34 set a xxx 35 format %s $a 36} xxx 37test 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 45catch {unset a} 46set a(xyz) 2 47set a(44) 3 48set {a(a long name)} test 49test set-old-2.1 {basic array operations} { 50 lsort [array names a] 51} {44 {a long name} xyz} 52test set-old-2.2 {basic array operations} { 53 set a(44) 54} 3 55test set-old-2.3 {basic array operations} { 56 set a(xyz) 57} 2 58test set-old-2.4 {basic array operations} { 59 set "a(a long name)" 60} test 61test 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}} 64test set-old-2.6 {basic array operations} { 65 list [catch {set a} msg] $msg 66} {1 {can't read "a": variable is array}} 67test set-old-2.7 {basic array operations} { 68 format %s $a(44) 69} 3 70test set-old-2.8 {basic array operations} { 71 format %s $a(a long name) 72} test 73unset a(44) 74test set-old-2.9 {basic array operations} { 75 lsort [array names a] 76} {{a long name} xyz} 77test 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}} 81test 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}} 86test set-old-2.12 {basic array operations} { 87 list [catch {set a 14} msg] $msg 88} {1 {can't set "a": variable is array}} 89unset a 90test 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 97test set-old-3.1 {set command} { 98 list [catch {set} msg] $msg 99} {1 {wrong # args: should be "set varName ?newValue?"}} 100test set-old-3.2 {set command} { 101 list [catch {set x y z} msg] $msg 102} {1 {wrong # args: should be "set varName ?newValue?"}} 103test 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}} 107test 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 115test 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 ()} 120test 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 125test 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 {}} 130test set-old-4.4 {parsing array names} { 131 catch {unset a abcd)} 132 set abcd) 33 133 info exists abcd) 134} 1 135test 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} 140test 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 148test 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}} 152test 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}} 157test 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}} 162test 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 170test 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} 175test 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}} 180test 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}} 185test 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 193test 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} 203test 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 ...?"}} 208test 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}} 212test 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}} 217test 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}} 222test 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} 228test 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}} 238test 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} 248test 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} 257test 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 {}} 263test 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 {}} 269test 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} 273test 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} 279test 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} 285test 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} 293test 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} 300test 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} 304test set-old-7.18 {unset command, -nocomplain (no abbreviation)} { 305 catch {unset -nocomp} 306 list [info exists -nocomp] [catch {unset -nocomp}] 307} {0 1} 308test 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 316test set-old-8.1 {array command} { 317 list [catch {array} msg] $msg 318} {1 {wrong # args: should be "array subcommand ?arg ...?"}} 319test set-old-8.2 {array command} { 320 list [catch {array a} msg] $msg 321} {1 {wrong # args: should be "array anymore arrayName searchId"}} 322test 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}} 326test 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}} 331test 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}} 339test 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, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}} 344test 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}} 348test 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}} 357test 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}} 361test 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}} 370test 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"}} 373test set-old-8.12 {array command, exists option} { 374 catch {unset a} 375 array exists a 376} {0} 377test set-old-8.13 {array command, exists option} { 378 catch {unset a} 379 set a(0) 1 380 array exists a 381} {1} 382test 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} 391test 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?"}} 394test 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?"}} 397test set-old-8.17 {array command, get option} { 398 catch {unset a} 399 array get a 400} {} 401test 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}} 407test 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} 413test 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} 422test 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 {}} 431test 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}} 436test set-old-8.23 {array command, names option} { 437 catch {unset a} 438 array names a 439} {} 440test 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}}} 445test 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}} 451test 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}} 458test 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}} 466test 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 {}} 475test 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"}} 478test 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}} 482test 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}} 491test 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"}} 494test 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"}} 497test 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}} 500test 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}} 505test 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} 511test 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 {}} 520test 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}} 525test 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}} 530test 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}} 536test 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}} 541test 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} 548test 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}} 551test 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}} 554test 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}} 557test set-old-8.39 {array command, size option} { 558 catch {unset a} 559 array size a 560} {0} 561test 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"}} 564test set-old-8.41 {array command, size option} { 565 catch {unset a} 566 array size a 567} {0} 568test 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} 573test 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} 579test 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} 585test 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} 594test 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"}} 597test 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}} 601test 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}} 611test 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 624number of buckets with 0 entries: 0 625number of buckets with 1 entries: 0 626number of buckets with 2 entries: 3 627number of buckets with 3 entries: 1 628number of buckets with 4 entries: 0 629number of buckets with 5 entries: 0 630number of buckets with 6 entries: 0 631number of buckets with 7 entries: 0 632number of buckets with 8 entries: 0 633number of buckets with 9 entries: 0 634number of buckets with 10 or more entries: 0 635average search distance for entry: 1.7" 636test 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} 641test 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}} 648test 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}} 655test 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} 662test 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} 669test 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} 676test 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} 683test 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"] 687test 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} 693test 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 699test 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 do a s-3-a; array start a] 704} {s-1-a s-2-a s-3-a s-1-a} 705test 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} 714test 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} 728test 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} 740test 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"}} 747test 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"}} 756test 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} 765test 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"}} 775test 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} 784test 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"}} 793test 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} 802test 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 810test set-old-10.1 {array enumeration errors} { 811 list [catch {array start} msg] $msg 812} {1 {wrong # args: should be "array startsearch arrayName"}} 813test 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"}} 816test 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}} 820test 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"}} 826test 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"}} 832test 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"}} 838test 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"}} 844test 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"}} 850test 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"}} 856test 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"}} 862test 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"}} 868test 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"}} 871test 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"}} 874test 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"}} 879test 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"}} 882test 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"}} 885test 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 893test 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} 904test 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 920test set-old-12.1 {cleanup on procedure return} { 921 proc foo {} { 922 set x 12345 923 } 924 foo 925} 12345 926test set-old-12.2 {cleanup on procedure return} { 927 proc foo {} { 928 set x(1) 23456 929 } 930 foo 931} 23456 932 933# Must delete variables when done, since these arrays get used as 934# scalars by other tests. 935catch {unset a} 936catch {unset b} 937catch {unset c} 938catch {unset aVaRnAmE} 939catch {rename foo {}} 940 941# cleanup 942::tcltest::cleanupTests 943return 944 945# Local Variables: 946# mode: tcl 947# End: 948