1# tree.test: tests for the tree structure. -*- tcl -*- 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1998-2000 by Ajuba Solutions. 8# Copyright (c) 2000-2008 by Andreas Kupries 9# All rights reserved. 10# 11# RCS: @(#) $Id: tree.testsuite,v 1.9 2009/09/24 22:22:28 andreas_kupries Exp $ 12 13::tcltest::testConstraint tree_critcl [string equal $impl critcl] 14 15############################################################ 16# I. Tree object construction and destruction ... 17############################################################ 18 19test tree-${impl}-1.1 {tree errors} { 20 tree mytree 21 catch {tree mytree} msg 22 mytree destroy 23 set msg 24} {command "::mytree" already exists, unable to create tree} 25 26test tree-${impl}-1.2 {tree errors} { 27 tree mytree 28 catch {mytree} msg 29 mytree destroy 30 set msg 31} "wrong # args: should be \"$MY option ?arg arg ...?\"" 32 33test tree-${impl}-1.3 {tree errors} { 34 tree mytree 35 catch {mytree foo} msg 36 mytree destroy 37 set msg 38} {bad option "foo": must be -->, =, ancestors, append, attr, children, cut, delete, depth, descendants, deserialize, destroy, exists, get, getall, height, index, insert, isleaf, keyexists, keys, lappend, leaves, move, next, nodes, numchildren, parent, previous, rename, rootname, serialize, set, size, splice, swap, unset, walk, or walkproc} 39 40test tree-${impl}-1.4 {tree errors} { 41 catch {tree set} msg 42 set msg 43} {command "::set" already exists, unable to create tree} 44 45test tree-${impl}-1.5 {tree construction errors} { 46 catch {tree mytree foo} msg 47 set msg 48} {wrong # args: should be "tree ?name ?=|:=|as|deserialize source??"} 49 50test tree-${impl}-1.6 {tree construction errors} { 51 catch {tree mytree foo far} msg 52 set msg 53} {wrong # args: should be "tree ?name ?=|:=|as|deserialize source??"} 54 55# Copy constructor errors are tested as part of 'deserialize'. 56# See 5.5.x at the bottom. 57 58test tree-${impl}-1.7 {create} { 59 tree mytree 60 set result [string equal [info commands ::mytree] "::mytree"] 61 mytree destroy 62 set result 63} 1 64test tree-${impl}-1.8 {create} { 65 set name [tree] 66 set result [list \ 67 [regexp {^::tree\d+$} $name] \ 68 [string equal [info commands $name] "$name"]] 69 $name destroy 70 set result 71} {1 1} 72 73test tree-${impl}-1.9 {destroy} { 74 tree mytree 75 mytree destroy 76 string equal [info commands ::mytree] "" 77} 1 78 79############################################################ 80# II. Node attributes ... 81# - set, append, lappend 82# - get, getall 83# - unset 84# - keys, keyexists 85# 86# All operations on the root node, there is no 87# special case to think about. 88############################################################ 89 90############################################################ 91 92test tree-${impl}-2.1.1 {set, wrong # args} { 93 tree mytree 94 catch {mytree set root data foo far} msg 95 mytree destroy 96 set msg 97} "wrong # args: should be \"$MY set node key ?value?\"" 98 99test tree-${impl}-2.1.2 {set gives error on bogus node} { 100 tree mytree 101 catch {mytree set snarf data} msg 102 mytree destroy 103 set msg 104} "node \"snarf\" does not exist in tree \"$MY\"" 105 106test tree-${impl}-2.1.3 {set retrieves and/or sets value} { 107 tree mytree 108 mytree set root baz foobar 109 set result [mytree set root baz] 110 mytree destroy 111 set result 112} foobar 113 114test tree-${impl}-2.1.4 {set with bad key gives error} { 115 tree mytree 116 catch {mytree set root foo} msg 117 mytree destroy 118 set msg 119} {invalid key "foo" for node "root"} 120 121test tree-${impl}-2.1.5 {set with bad key gives error} { 122 tree mytree 123 mytree set root data "" 124 catch {mytree set root foo} msg 125 mytree destroy 126 set msg 127} {invalid key "foo" for node "root"} 128 129############################################################ 130 131test tree-${impl}-2.2.1 {append with too many args gives error} { 132 tree mytree 133 catch {mytree append root foo bar baz boo} msg 134 mytree destroy 135 set msg 136} [tmTooMany append {node key value}] 137 138test tree-${impl}-2.2.2 {append gives error on bogus node} { 139 tree mytree 140 catch {mytree append {IT::EM 0} data foo} msg 141 mytree destroy 142 set msg 143} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 144 145test tree-${impl}-2.2.3 {append creates missing attribute} { 146 tree mytree 147 set result [list] 148 lappend result [mytree keyexists root data] 149 lappend result [mytree append root data bar] 150 lappend result [mytree keyexists root data] 151 lappend result [mytree get root data] 152 mytree destroy 153 set result 154} {0 bar 1 bar} 155 156test tree-${impl}-2.2.4 {append appends to attribute value} { 157 tree mytree 158 set result [list] 159 lappend result [mytree set root data foo] 160 lappend result [mytree append root data bar] 161 lappend result [mytree get root data] 162 mytree destroy 163 set result 164} {foo foobar foobar} 165 166############################################################ 167 168test tree-${impl}-2.3.1 {lappend with too many args gives error} { 169 tree mytree 170 catch {mytree lappend root foo bar baz boo} msg 171 mytree destroy 172 set msg 173} [tmTooMany lappend {node key value}] 174 175test tree-${impl}-2.3.2 {lappend gives error on bogus node} { 176 tree mytree 177 catch {mytree lappend {IT::EM 0} data foo} msg 178 mytree destroy 179 set msg 180} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 181 182test tree-${impl}-2.3.3 {lappend creates missing attribute} { 183 tree mytree 184 set result [list] 185 lappend result [mytree keyexists root data] 186 lappend result [mytree lappend root data bar] 187 lappend result [mytree keyexists root data] 188 lappend result [mytree get root data] 189 mytree destroy 190 set result 191} {0 bar 1 bar} 192 193test tree-${impl}-2.3.4 {lappend appends to attribute value} { 194 tree mytree 195 set result [list] 196 lappend result [mytree set root data foo] 197 lappend result [mytree lappend root data bar] 198 lappend result [mytree get root data] 199 mytree destroy 200 set result 201} {foo {foo bar} {foo bar}} 202 203############################################################ 204 205test tree-${impl}-2.4.1 {get gives error on bogus node} { 206 tree mytree 207 catch {mytree get {IT::EM 0} data} msg 208 mytree destroy 209 set msg 210} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 211 212test tree-${impl}-2.4.2 {get gives error on bogus key} { 213 tree mytree 214 catch {mytree get root bogus} msg 215 mytree destroy 216 set msg 217} {invalid key "bogus" for node "root"} 218 219test tree-${impl}-2.4.3 {get gives error on bogus key} { 220 tree mytree 221 mytree set root foo far 222 catch {mytree get root bogus} msg 223 mytree destroy 224 set msg 225} {invalid key "bogus" for node "root"} 226 227test tree-${impl}-2.4.4 {get} { 228 tree mytree 229 mytree set root boom foobar 230 set result [mytree get root boom] 231 mytree destroy 232 set result 233} foobar 234 235############################################################ 236 237test tree-${impl}-2.5.1 {getall, wrong # args} { 238 tree mytree 239 catch {mytree getall root data foo} msg 240 mytree destroy 241 set msg 242} [tmTooMany getall {node ?pattern?}] 243 244test tree-${impl}-2.5.2 {getall gives error on bogus node} { 245 tree mytree 246 catch {mytree getall {IT::EM 0}} msg 247 mytree destroy 248 set msg 249} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 250 251test tree-${impl}-2.5.3 {getall without attributes returns empty string} { 252 tree mytree 253 set results [mytree getall root] 254 mytree destroy 255 set results 256} {} 257 258test tree-${impl}-2.5.4 {getall returns dictionary} { 259 tree mytree 260 mytree set root data foobar 261 mytree set root other thing 262 set results [dictsort [mytree getall root]] 263 mytree destroy 264 set results 265} {data foobar other thing} 266 267test tree-${impl}-2.5.5 {getall matches key pattern} { 268 tree mytree 269 mytree set root data foobar 270 mytree set root other thing 271 set results [dictsort [mytree getall root d*]] 272 mytree destroy 273 set results 274} {data foobar} 275 276############################################################ 277 278test tree-${impl}-2.6.1 {unset, wrong # args} { 279 tree mytree 280 catch {mytree unset root flaboozle foobar} msg 281 mytree destroy 282 set msg 283} [tmTooMany unset {node key}] 284 285test tree-${impl}-2.6.2 {unset gives error on bogus node} { 286 tree mytree 287 catch {mytree unset {IT::EM 0} data} msg 288 mytree destroy 289 set msg 290} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 291 292test tree-${impl}-2.6.3 {unset does not give error on bogus key} { 293 tree mytree 294 set result [catch {mytree unset root bogus}] 295 mytree destroy 296 set result 297} 0 298 299test tree-${impl}-2.6.4 {unset does not give error on bogus key} { 300 tree mytree 301 mytree set root foo "" 302 set result [catch {mytree unset root bogus}] 303 mytree destroy 304 set result 305} 0 306 307test tree-${impl}-2.6.5 {unset removes attribute from node} { 308 tree mytree 309 set result [list] 310 lappend result [mytree keyexists root foobar] 311 mytree set root foobar foobar 312 lappend result [mytree keyexists root foobar] 313 mytree unset root foobar 314 lappend result [mytree keyexists root foobar] 315 mytree destroy 316 set result 317} {0 1 0} 318 319test tree-${impl}-2.6.6 {unset followed by node delete} { 320 tree mytree 321 set result [list] 322 set n [mytree insert root end] 323 mytree set $n foo bar 324 mytree unset $n foo 325 mytree delete $n 326 set result [mytree exists $n] 327 mytree destroy 328 set result 329} 0 330 331############################################################ 332 333test tree-${impl}-2.7.1 {keys, wrong # args} { 334 tree mytree 335 catch {mytree keys root flaboozle foobar} msg 336 mytree destroy 337 set msg 338} [tmTooMany keys {node ?pattern?}] 339 340test tree-${impl}-2.7.2 {keys gives error on bogus node} { 341 tree mytree 342 catch {mytree keys {IT::EM 0}} msg 343 mytree destroy 344 set msg 345} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 346 347test tree-${impl}-2.7.3 {keys returns empty list for nodes without attributes} { 348 tree mytree 349 set results [mytree keys root] 350 mytree destroy 351 set results 352} {} 353 354test tree-${impl}-2.7.4 {keys returns list of keys} { 355 tree mytree 356 mytree set root data foobar 357 mytree set root other thing 358 set results [mytree keys root] 359 mytree destroy 360 lsort $results 361} {data other} 362 363test tree-${impl}-2.7.5 {keys matches pattern} { 364 tree mytree 365 mytree set root data foobar 366 mytree set root other thing 367 set results [mytree keys root d*] 368 mytree destroy 369 set results 370} data 371 372############################################################ 373 374test tree-${impl}-2.8.1 {keyexists, wrong # args} { 375 tree mytree 376 catch {mytree keyexists root} msg 377 mytree destroy 378 set msg 379} [tmWrong keyexists {node key} 1] 380 381test tree-${impl}-2.8.2 {keyexists, wrong # args} { 382 tree mytree 383 catch {mytree keyexists root foo far} msg 384 mytree destroy 385 set msg 386} [tmTooMany keyexists {node key}] 387 388test tree-${impl}-2.8.3 {keyexists gives error on bogus node} { 389 tree mytree 390 catch {mytree keyexists {IT::EM 0} foo} msg 391 mytree destroy 392 set msg 393} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 394 395test tree-${impl}-2.8.4 {keyexists returns false on non-existant key} { 396 tree mytree 397 set result [mytree keyexists root bogus] 398 mytree destroy 399 set result 400} 0 401 402test tree-${impl}-2.8.5 {keyexists returns false on non-existant key} { 403 tree mytree 404 mytree set root ok "" 405 set result [mytree keyexists root bogus] 406 mytree destroy 407 set result 408} 0 409 410test tree-${impl}-2.8.6 {keyexists returns true for existing key} { 411 tree mytree 412 mytree set root ok "" 413 set result [mytree keyexists root ok] 414 mytree destroy 415 set result 416} 1 417 418############################################################ 419# III. Structural operations ... 420# - isleaf, parent, children, numchildren, ancestors, descendants 421# - nodes, leaves 422# - exists, size, depth, height 423# - insert, delete, move, cut, splice, swap 424# - rename, rootname 425############################################################ 426 427############################################################ 428 429test tree-${impl}-3.1.1 {isleaf, wrong # args} { 430 tree mytree 431 catch {mytree isleaf {IT::EM 0} foo} msg 432 mytree destroy 433 set msg 434} [tmTooMany isleaf {node}] 435 436test tree-${impl}-3.1.2 {isleaf} { 437 tree mytree 438 catch {mytree isleaf {IT::EM 0}} msg 439 mytree destroy 440 set msg 441} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 442 443test tree-${impl}-3.1.3 {isleaf} { 444 tree mytree 445 set result [mytree isleaf root] 446 447 mytree insert root end {IT::EM 0} 448 lappend result [mytree isleaf root] 449 lappend result [mytree isleaf {IT::EM 0}] 450 mytree destroy 451 set result 452} {1 0 1} 453 454############################################################ 455 456test tree-${impl}-3.2.1 {parent, wrong # args} { 457 tree mytree 458 catch {mytree parent {IT::EM 0} foo} msg 459 mytree destroy 460 set msg 461} [tmTooMany parent {node}] 462 463test tree-${impl}-3.2.2 {parent gives error on fake node} { 464 tree mytree 465 catch {mytree parent {IT::EM 0}} msg 466 mytree destroy 467 set msg 468} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 469 470test tree-${impl}-3.2.3 {parent gives correct value} { 471 tree mytree 472 mytree insert root end {IT::EM 0} 473 set result [mytree parent {IT::EM 0}] 474 mytree destroy 475 set result 476} {root} 477 478test tree-${impl}-3.2.4 {parent of root is empty string} { 479 tree mytree 480 set result [mytree parent root] 481 mytree destroy 482 set result 483} {} 484 485############################################################ 486 487test tree-${impl}-3.3.1 {children, wrong # args} { 488 tree mytree 489 catch {mytree children {IT::EM 0} foo} result 490 mytree destroy 491 set result 492} "wrong # args: should be \"$MY children ?-all? node ?filter cmd?\"" 493 494test tree-${impl}-3.3.2 {children, bad node} { 495 tree mytree 496 catch {mytree children {IT::EM 0}} result 497 mytree destroy 498 set result 499} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 500 501test tree-${impl}-3.3.3 {children of root, initial} { 502 tree mytree 503 set result [mytree children root] 504 mytree destroy 505 set result 506} {} 507 508test tree-${impl}-3.3.4 {children} { 509 tree mytree 510 set result [list] 511 512 lappend result [mytree children root] 513 514 mytree insert root end {IT::EM 0} 515 mytree insert root end {IT::EM 1} 516 mytree insert root end {IT::EM 2} 517 mytree insert {IT::EM 0} end {IT::EM 3} 518 mytree insert {IT::EM 0} end {IT::EM 4} 519 520 lappend result [mytree children root] 521 lappend result [mytree children {IT::EM 0}] 522 lappend result [mytree children {IT::EM 1}] 523 mytree destroy 524 set result 525} {{} {{IT::EM 0} {IT::EM 1} {IT::EM 2}} {{IT::EM 3} {IT::EM 4}} {}} 526 527test tree-${impl}-3.3.5 {children, -all} { 528 tree mytree 529 set result [list] 530 531 mytree insert root end 0 532 mytree insert root end 1 533 mytree insert root end 2 534 mytree insert 0 end 3 535 mytree insert 0 end 4 536 mytree insert 4 end 5 537 mytree insert 4 end 6 538 539 set result {} 540 lappend result [lsort [mytree children -all root]] 541 lappend result [lsort [mytree children -all 0]] 542 mytree destroy 543 set result 544} {{0 1 2 3 4 5 6} {3 4 5 6}} 545 546test tree-${impl}-3.3.6 {children, filtering} { 547 tree mytree 548 set result [list] 549 550 mytree insert root end 0 ; mytree set 0 volume 30 551 mytree insert root end 1 552 mytree insert root end 2 553 mytree insert 0 end 3 554 mytree insert 0 end 4 555 mytree insert 4 end 5 ; mytree set 5 volume 50 556 mytree insert 4 end 6 557 558 proc vol {t n} { 559 $t keyexists $n volume 560 } 561 proc vgt40 {t n} { 562 if {![$t keyexists $n volume]} {return 0} 563 expr {[$t get $n volume] > 40} 564 } 565 566 set result {} 567 lappend result [lsort [mytree children -all root filter vol]] 568 lappend result [lsort [mytree children -all root filter vgt40]] 569 lappend result [lsort [mytree children root filter vol]] 570 lappend result [lsort [mytree children root filter vgt40]] 571 mytree destroy 572 rename vol {} 573 rename vgt40 {} 574 set result 575} {{0 5} 5 0 {}} 576 577test tree-${impl}-3.3.7 {children, bad filter keyword} { 578 tree mytree 579 mytree insert root end a 580 mytree insert root end b 581 proc ff {t n} {return 1} 582 583 catch {mytree children root snarf ff} msg 584 585 mytree destroy 586 rename ff {} 587 set msg 588} "wrong # args: should be \"$MY children ?-all? node ?filter cmd?\"" 589 590test tree-${impl}-3.3.8 {children, bad filter keyword, -all case} { 591 tree mytree 592 mytree insert root end a 593 mytree insert root end b 594 proc ff {t n} {return 1} 595 596 catch {mytree children -all root snarf ff} msg 597 598 mytree destroy 599 rename ff {} 600 set msg 601} "wrong # args: should be \"$MY children ?-all? node ?filter cmd?\"" 602 603test tree-${impl}-3.3.9 {children, empty filter} { 604 tree mytree 605 mytree insert root end a 606 mytree insert root end b 607 608 catch {mytree children root filter {}} msg 609 610 mytree destroy 611 set msg 612} "wrong # args: should be \"$MY children ?-all? node ?filter cmd?\"" 613 614test tree-${impl}-3.3.10 {children, empty filter, -all case} { 615 tree mytree 616 mytree insert root end a 617 mytree insert root end b 618 619 catch {mytree children -all root filter {}} msg 620 621 mytree destroy 622 set msg 623} "wrong # args: should be \"$MY children ?-all? node ?filter cmd?\"" 624 625test tree-${impl}-3.3.11 {children, filter cmdprefix not a list} { 626 tree mytree 627 mytree insert root end a 628 mytree insert root end b 629 630 catch {mytree children root filter "\{"} msg 631 632 mytree destroy 633 set msg 634} {unmatched open brace in list} 635 636test tree-${impl}-3.3.12 {children, filter cmdprefix not a list, -all case} { 637 tree mytree 638 mytree insert root end a 639 mytree insert root end b 640 641 catch {mytree children -all root filter "\{"} msg 642 643 mytree destroy 644 set msg 645} {unmatched open brace in list} 646 647test tree-${impl}-3.3.13 {children, filter, unknown command} { 648 tree mytree 649 mytree insert root end a 650 mytree insert root end b 651 652 catch {mytree children root filter ::bogus} msg 653 654 mytree destroy 655 set msg 656} {invalid command name "::bogus"} 657 658test tree-${impl}-3.3.14 {children, filter, unknown command, -all case} { 659 tree mytree 660 mytree insert root end a 661 mytree insert root end b 662 663 catch {mytree children -all root filter ::bogus} msg 664 665 mytree destroy 666 set msg 667} {invalid command name "::bogus"} 668 669test tree-${impl}-3.3.15 {children, filter returning error} { 670 tree mytree 671 mytree insert root end a 672 mytree insert root end b 673 proc ff {t n} {return -code error "boo"} 674 675 catch {mytree children root filter ::ff} msg 676 677 mytree destroy 678 rename ff {} 679 set msg 680} {boo} 681 682test tree-${impl}-3.3.16 {children, filter returning error, -all case} { 683 tree mytree 684 mytree insert root end a 685 mytree insert root end b 686 proc ff {t n} {return -code error "boo"} 687 688 catch {mytree children -all root filter ::ff} msg 689 690 mytree destroy 691 rename ff {} 692 set msg 693} {boo} 694 695test tree-${impl}-3.3.17 {children, filter result not boolean} { 696 tree mytree 697 mytree insert root end a 698 mytree insert root end b 699 proc ff {t n} {return "boo"} 700 701 catch {mytree children root filter ::ff} msg 702 703 mytree destroy 704 rename ff {} 705 set msg 706} {expected boolean value but got "boo"} 707 708test tree-${impl}-3.3.18 {children, filter result not boolean, -all case} { 709 tree mytree 710 mytree insert root end a 711 mytree insert root end b 712 proc ff {t n} {return "boo"} 713 714 catch {mytree children -all root filter ::ff} msg 715 716 mytree destroy 717 rename ff {} 718 set msg 719} {expected boolean value but got "boo"} 720 721############################################################ 722 723test tree-${impl}-3.4.1 {numchildren, wrong #args} { 724 tree mytree 725 catch {mytree numchildren {IT::EM 0} foo} msg 726 mytree destroy 727 set msg 728} [tmTooMany numchildren {node}] 729 730test tree-${impl}-3.4.2 {numchildren, bogus node} { 731 tree mytree 732 catch {mytree numchildren {IT::EM 0}} msg 733 mytree destroy 734 set msg 735} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 736 737test tree-${impl}-3.4.3 {numchildren} { 738 tree mytree 739 set result [mytree numchildren root] 740 mytree insert root end {IT::EM 0} 741 lappend result [mytree numchildren root] 742 lappend result [mytree numchildren {IT::EM 0}] 743 mytree destroy 744 set result 745} {0 1 0} 746 747test tree-${impl}-3.4.4 {numchildren} { 748 tree mytree 749 set result [list] 750 lappend result [mytree numchildren root] 751 752 mytree insert root end {IT::EM 0} 753 mytree insert root end {IT::EM 1} 754 mytree insert root end {IT::EM 2} 755 mytree insert {IT::EM 0} end {IT::EM 3} 756 mytree insert {IT::EM 0} end {IT::EM 4} 757 758 lappend result [mytree numchildren root] 759 lappend result [mytree numchildren {IT::EM 0}] 760 lappend result [mytree numchildren {IT::EM 1}] 761 mytree destroy 762 set result 763} {0 3 2 0} 764 765############################################################ 766 767test tree-${impl}-3.5.1 {exists, wrong #args} { 768 tree mytree 769 catch {mytree exists {IT::EM 0} foo} msg 770 mytree destroy 771 set msg 772} [tmTooMany exists {node}] 773 774test tree-${impl}-3.5.2 {exists} { 775 tree mytree 776 set result [list] 777 lappend result [mytree exists root] 778 lappend result [mytree exists {IT::EM 0}] 779 780 mytree insert root end {IT::EM 0} 781 lappend result [mytree exists {IT::EM 0}] 782 783 mytree delete {IT::EM 0} 784 lappend result [mytree exists {IT::EM 0}] 785 786 mytree destroy 787 set result 788} {1 0 1 0} 789 790############################################################ 791 792test tree-${impl}-3.6.1 {size, wrong # args} { 793 tree mytree 794 catch {mytree size foo far} msg 795 mytree destroy 796 set msg 797} "wrong # args: should be \"$MY size ?node?\"" 798 799test tree-${impl}-3.6.2 {size gives error on bogus node} { 800 tree mytree 801 catch {mytree size {IT::EM 0}} msg 802 mytree destroy 803 set msg 804} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 805 806test tree-${impl}-3.6.3 {size uses root node as default} { 807 tree mytree 808 set result [mytree size] 809 mytree destroy 810 set result 811} 0 812 813test tree-${impl}-3.6.4 {size gives correct value} { 814 tree mytree 815 mytree insert root end {IT::EM 0} 816 mytree insert root end {IT::EM 1} 817 mytree insert root end {IT::EM 2} 818 mytree insert root end {IT::EM 3} 819 mytree insert root end {IT::EM 4} 820 mytree insert root end {IT::EM 5} 821 set result [mytree size] 822 mytree destroy 823 set result 824} 6 825 826test tree-${impl}-3.6.5 {size gives correct value} { 827 tree mytree 828 mytree insert root end {IT::EM 0} 829 mytree insert {IT::EM 0} end {IT::EM 1} 830 mytree insert {IT::EM 0} end {IT::EM 2} 831 mytree insert {IT::EM 0} end {IT::EM 3} 832 mytree insert {IT::EM 1} end {IT::EM 4} 833 mytree insert {IT::EM 1} end {IT::EM 5} 834 set result [mytree size {IT::EM 0}] 835 mytree destroy 836 set result 837} 5 838 839test tree-${impl}-3.6.6 {size gives correct value} { 840 tree mytree 841 mytree insert root end {IT::EM 0} 842 mytree insert {IT::EM 0} end {IT::EM 1} 843 mytree insert {IT::EM 0} end {IT::EM 2} 844 mytree insert {IT::EM 0} end {IT::EM 3} 845 mytree insert {IT::EM 1} end {IT::EM 4} 846 mytree insert {IT::EM 1} end {IT::EM 5} 847 set result [mytree size {IT::EM 1}] 848 mytree destroy 849 set result 850} 2 851 852############################################################ 853 854test tree-${impl}-3.7.1 {depth, wrong # args} { 855 tree mytree 856 catch {mytree depth {IT::EM 0} foo} msg 857 mytree destroy 858 set msg 859} [tmTooMany depth {node}] 860 861test tree-${impl}-3.7.2 {depth} { 862 tree mytree 863 catch {mytree depth {IT::EM 0}} msg 864 mytree destroy 865 set msg 866} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 867 868test tree-${impl}-3.7.3 {depth of root is 0} { 869 tree mytree 870 set result [mytree depth root] 871 mytree destroy 872 set result 873} 0 874 875test tree-${impl}-3.7.4 {depth is computed correctly} { 876 tree mytree 877 mytree insert root end {IT::EM 0} 878 mytree insert {IT::EM 0} end {IT::EM 1} 879 mytree insert {IT::EM 1} end {IT::EM 2} 880 mytree insert {IT::EM 2} end {IT::EM 3} 881 set result [mytree depth {IT::EM 3}] 882 mytree destroy 883 set result 884} 4 885 886############################################################ 887 888test tree-${impl}-3.8.1 {height, wrong # args} { 889 tree mytree 890 catch {mytree height {IT::EM 0} foo} msg 891 mytree destroy 892 set msg 893} [tmTooMany height {node}] 894 895test tree-${impl}-3.8.2 {height for bogus node fails} { 896 tree mytree 897 catch {mytree height {IT::EM 0}} msg 898 mytree destroy 899 set msg 900} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 901 902test tree-${impl}-3.8.3 {height of root alone is 0} { 903 tree mytree 904 set result [mytree height root] 905 mytree destroy 906 set result 907} 0 908 909test tree-${impl}-3.8.4 {height is computed correctly} { 910 tree mytree 911 mytree insert root end 0 912 mytree insert 0 end 1 913 mytree insert 1 end 2 914 mytree insert 2 end 3 915 set result [mytree height root] 916 mytree destroy 917 set result 918} 4 919 920############################################################ 921 922test tree-${impl}-3.9.1 {insert creates and initializes node} { 923 tree mytree 924 mytree insert root end {IT::EM 0} 925 set result [list ] 926 lappend result [mytree exists {IT::EM 0}] 927 lappend result [mytree parent {IT::EM 0}] 928 lappend result [mytree children {IT::EM 0}] 929 lappend result [mytree set {IT::EM 0} data ""] 930 lappend result [mytree children root] 931 mytree destroy 932 set result 933} {1 root {} {} {{IT::EM 0}}} 934 935test tree-${impl}-3.9.2 {insert insert nodes in correct location} { 936 tree mytree 937 mytree insert root end {IT::EM 0} 938 mytree insert root end {IT::EM 1} 939 mytree insert root 0 {IT::EM 2} 940 set result [mytree children root] 941 mytree destroy 942 set result 943} {{IT::EM 2} {IT::EM 0} {IT::EM 1}} 944 945test tree-${impl}-3.9.3 {insert gives error when trying to insert to a fake parent} { 946 tree mytree 947 catch {mytree insert {IT::EM 0} end {IT::EM 1}} msg 948 mytree destroy 949 set msg 950} "parent node \"IT::EM 0\" does not exist in tree \"$MY\"" 951 952test tree-${impl}-3.9.4 {insert generates node name when none is given} { 953 tree mytree 954 set result [list [mytree insert root end]] 955 lappend result [mytree insert root end] 956 mytree insert root end {IT::EM 3} 957 lappend result [mytree insert root end] 958 mytree destroy 959 set result 960} {node1 node2 node3} 961 962test tree-${impl}-3.9.5 {insert inserts multiple nodes properly} { 963 tree mytree 964 mytree insert root end a b c d e f 965 set result [mytree children root] 966 mytree destroy 967 set result 968} {a b c d e f} 969 970test tree-${impl}-3.9.6 {insert moves nodes that exist} { 971 tree mytree 972 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 973 mytree insert {IT::EM 0} end {IT::EM 4} {IT::EM 5} {IT::EM 6} 974 mytree insert root end {IT::EM 4} 975 set result [list [mytree children root] [mytree children {IT::EM 0}]] 976 mytree destroy 977 set result 978} [list [list {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} {IT::EM 4}] [list {IT::EM 5} {IT::EM 6}]] 979 980test tree-${impl}-3.9.7 {insert moves nodes that already exist properly} { 981 tree mytree 982 mytree insert root end {IT::EM 0} 983 mytree insert {IT::EM 0} end {IT::EM 1} 984 mytree insert {IT::EM 1} end {IT::EM 2} 985 mytree insert root end {IT::EM 1} {IT::EM 2} 986 set result [list \ 987 [mytree children root] \ 988 [mytree children {IT::EM 0}] \ 989 [mytree children {IT::EM 1}] \ 990 [mytree parent {IT::EM 1}] \ 991 [mytree parent {IT::EM 2}] \ 992 ] 993 mytree destroy 994 set result 995} [list [list {IT::EM 0} {IT::EM 1} {IT::EM 2}] {} {} root root] 996 997test tree-${impl}-3.9.8 {insert moves multiple nodes properly} { 998 tree mytree 999 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} 1000 mytree insert root 0 {IT::EM 1} {IT::EM 2} 1001 set result [list \ 1002 [mytree children root] \ 1003 ] 1004 mytree destroy 1005 set result 1006} {{{IT::EM 1} {IT::EM 2} {IT::EM 0}}} 1007 1008test tree-${impl}-3.9.9 {insert moves multiple nodes properly} { 1009 tree mytree 1010 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} 1011 mytree insert root 1 {IT::EM 0} {IT::EM 1} 1012 set result [mytree children root] 1013 mytree destroy 1014 set result 1015} {{IT::EM 0} {IT::EM 1} {IT::EM 2}} 1016 1017test tree-${impl}-3.9.10 {insert moves node within parent properly} { 1018 tree mytree 1019 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1020 mytree insert root 2 {IT::EM 1} 1021 set result [mytree children root] 1022 mytree destroy 1023 set result 1024} {{IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3}} 1025 1026test tree-${impl}-3.9.11 {insert moves node within parent properly} { 1027 tree mytree 1028 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1029 mytree insert {IT::EM 3} end {IT::EM 4} {IT::EM 5} {IT::EM 6} 1030 mytree insert root 2 {IT::EM 0} {IT::EM 4} {IT::EM 5} {IT::EM 6} 1031 set result [mytree children root] 1032 mytree destroy 1033 set result 1034} {{IT::EM 1} {IT::EM 0} {IT::EM 4} {IT::EM 5} {IT::EM 6} {IT::EM 2} {IT::EM 3}} 1035 1036test tree-${impl}-3.9.12 {insert moves node in parent properly when oldInd < newInd} { 1037 tree mytree 1038 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1039 mytree insert root 2 {IT::EM 0} 1040 set result [mytree children root] 1041 mytree destroy 1042 set result 1043} {{IT::EM 1} {IT::EM 0} {IT::EM 2} {IT::EM 3}} 1044 1045test tree-${impl}-3.9.13 {insert gives error when trying to move root} { 1046 tree mytree 1047 catch {mytree insert root end root} msg 1048 mytree destroy 1049 set msg 1050} {cannot move root node} 1051 1052test tree-${impl}-3.9.14 {insert gives error when trying to make node its descendant} { 1053 tree mytree 1054 mytree insert root end {IT::EM 0} 1055 catch {mytree insert {IT::EM 0} end {IT::EM 0}} msg 1056 mytree destroy 1057 set msg 1058} {node "IT::EM 0" cannot be its own descendant} 1059 1060test tree-${impl}-3.9.15 {insert gives error when trying to make node its descendant} { 1061 tree mytree 1062 mytree insert root end {IT::EM 0} 1063 mytree insert {IT::EM 0} end {IT::EM 1} 1064 mytree insert {IT::EM 1} end {IT::EM 2} 1065 catch {mytree insert {IT::EM 2} end {IT::EM 0}} msg 1066 mytree destroy 1067 set msg 1068} {node "IT::EM 0" cannot be its own descendant} 1069 1070test tree-${impl}-3.9.17 {check node names with spaces} { 1071 tree mytree 1072 catch {mytree insert root end ":\n\t "} msg 1073 mytree destroy 1074 set msg 1075} [list ":\n\t "] 1076 1077test tree-${impl}-3.9.18 {extended node names with spaces check} { 1078 tree mytree 1079 set node ":\n\t " 1080 set msg [mytree insert root end $node] 1081 lappend msg [mytree isleaf $node] 1082 mytree insert $node end yummy 1083 lappend msg [mytree size $node] 1084 lappend msg [mytree isleaf $node] 1085 mytree set $node data foo 1086 set ::FOO {} 1087 mytree walk root n {walker $n} 1088 lappend msg $::FOO 1089 lappend msg [mytree keys $node] 1090 lappend msg [mytree parent $node] 1091 lappend msg [mytree set $node data] 1092 mytree destroy 1093 set msg 1094} [list ":\n\t " 1 1 0 [list root ":\n\t " yummy] data root foo] 1095 1096test tree-${impl}-3.9.19a {insert fails for a bad index} {!tcl8.5plus||tree_critcl} { 1097 tree mytree 1098 catch {mytree insert root foo new-node} msg 1099 mytree destroy 1100 set msg 1101} {bad index "foo": must be integer or end?-integer?} 1102 1103test tree-${impl}-3.9.19b {insert fails for a bad index} {tcl8.5plus&&!tree_critcl} { 1104 tree mytree 1105 catch {mytree insert root foo new-node} msg 1106 mytree destroy 1107 set msg 1108} {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?} 1109 1110test tree-${impl}-3.9.20 {insert insert nodes in correct location} { 1111 tree mytree 1112 mytree insert root end a 1113 mytree insert root end b 1114 mytree insert root 0 c 1115 mytree insert root end-1 d 1116 set result [mytree children root] 1117 mytree destroy 1118 set result 1119} {c a d b} 1120 1121############################################################ 1122 1123test tree-${impl}-3.10.1 {delete} { 1124 tree mytree 1125 catch {mytree delete root} msg 1126 mytree destroy 1127 set msg 1128} {cannot delete root node} 1129 1130test tree-${impl}-3.10.2 {delete} { 1131 tree mytree 1132 catch {mytree delete {IT::EM 0}} msg 1133 mytree destroy 1134 set msg 1135} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 1136 1137test tree-${impl}-3.10.3 {delete, only this node} { 1138 tree mytree 1139 mytree insert root end {IT::EM 0} 1140 mytree delete {IT::EM 0} 1141 set result [list [mytree exists {IT::EM 0}] [mytree children root]] 1142 mytree destroy 1143 set result 1144} {0 {}} 1145 1146test tree-${impl}-3.10.4 {delete, node and children} { 1147 tree mytree 1148 mytree insert root end {IT::EM 0} 1149 mytree insert {IT::EM 0} end {IT::EM 1} 1150 mytree insert {IT::EM 1} end {IT::EM 2} 1151 mytree delete {IT::EM 0} 1152 set result [list [mytree exists {IT::EM 0}] \ 1153 [mytree exists {IT::EM 1}] \ 1154 [mytree exists {IT::EM 2}]] 1155 mytree destroy 1156 set result 1157} {0 0 0} 1158 1159############################################################ 1160 1161test tree-${impl}-3.11.1 {move gives error when trying to move root} { 1162 tree mytree 1163 mytree insert root end {IT::EM 0} 1164 catch {mytree move {IT::EM 0} end root} msg 1165 mytree destroy 1166 set msg 1167} {cannot move root node} 1168 1169test tree-${impl}-3.11.2 {move gives error when trying to move non existant node} { 1170 tree mytree 1171 catch {mytree move root end {IT::EM 0}} msg 1172 mytree destroy 1173 set msg 1174} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 1175 1176test tree-${impl}-3.11.3 {move gives error when trying to move to non existant parent} { 1177 tree mytree 1178 catch {mytree move {IT::EM 0} end {IT::EM 0}} msg 1179 mytree destroy 1180 set msg 1181} "parent node \"IT::EM 0\" does not exist in tree \"$MY\"" 1182 1183test tree-${impl}-3.11.4 {move gives error when trying to make node its own descendant} { 1184 tree mytree 1185 mytree insert root end {IT::EM 0} 1186 catch {mytree move {IT::EM 0} end {IT::EM 0}} msg 1187 mytree destroy 1188 set msg 1189} {node "IT::EM 0" cannot be its own descendant} 1190 1191test tree-${impl}-3.11.5 {move gives error when trying to make node its own descendant} { 1192 tree mytree 1193 mytree insert root end {IT::EM 0} 1194 mytree insert {IT::EM 0} end {IT::EM 1} 1195 mytree insert {IT::EM 1} end {IT::EM 2} 1196 catch {mytree move {IT::EM 2} end {IT::EM 0}} msg 1197 mytree destroy 1198 set msg 1199} {node "IT::EM 0" cannot be its own descendant} 1200 1201test tree-${impl}-3.11.6 {move correctly moves a node} { 1202 tree mytree 1203 mytree insert root end {IT::EM 0} 1204 mytree insert {IT::EM 0} end {IT::EM 1} 1205 mytree insert {IT::EM 1} end {IT::EM 2} 1206 mytree move {IT::EM 0} end {IT::EM 2} 1207 set result [list [mytree children {IT::EM 0}] [mytree children {IT::EM 1}]] 1208 lappend result [mytree parent {IT::EM 2}] 1209 mytree destroy 1210 set result 1211} {{{IT::EM 1} {IT::EM 2}} {} {IT::EM 0}} 1212 1213test tree-${impl}-3.11.7 {move moves multiple nodes properly} { 1214 tree mytree 1215 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} 1216 mytree move root 0 {IT::EM 1} {IT::EM 2} 1217 set result [list \ 1218 [mytree children root] \ 1219 ] 1220 mytree destroy 1221 set result 1222} {{{IT::EM 1} {IT::EM 2} {IT::EM 0}}} 1223 1224test tree-${impl}-3.11.8 {move moves multiple nodes properly} { 1225 tree mytree 1226 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} 1227 mytree move root 1 {IT::EM 0} {IT::EM 1} 1228 set result [mytree children root] 1229 mytree destroy 1230 set result 1231} {{IT::EM 2} {IT::EM 0} {IT::EM 1}} 1232 1233test tree-${impl}-3.11.9 {move moves node within parent properly} { 1234 tree mytree 1235 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1236 mytree move root 2 {IT::EM 1} 1237 set result [mytree children root] 1238 mytree destroy 1239 set result 1240} {{IT::EM 0} {IT::EM 2} {IT::EM 1} {IT::EM 3}} 1241 1242test tree-${impl}-3.11.10 {move moves node within parent properly} { 1243 tree mytree 1244 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1245 mytree insert {IT::EM 3} end {IT::EM 4} {IT::EM 5} {IT::EM 6} 1246 mytree move root 2 {IT::EM 0} {IT::EM 4} {IT::EM 5} {IT::EM 6} 1247 set result [mytree children root] 1248 mytree destroy 1249 set result 1250} {{IT::EM 1} {IT::EM 2} {IT::EM 0} {IT::EM 4} {IT::EM 5} {IT::EM 6} {IT::EM 3}} 1251 1252test tree-${impl}-3.11.11 {move moves node in parent properly when oldInd < newInd} { 1253 tree mytree 1254 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1255 mytree move root 2 {IT::EM 0} 1256 set result [mytree children root] 1257 mytree destroy 1258 set result 1259} {{IT::EM 1} {IT::EM 2} {IT::EM 0} {IT::EM 3}} 1260 1261test tree-${impl}-3.11.12 {move node up one} { 1262 tree mytree 1263 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1264 mytree move root [mytree index [mytree next {IT::EM 0}]] {IT::EM 0} 1265 set result [mytree children root] 1266 mytree destroy 1267 set result 1268} {{IT::EM 1} {IT::EM 0} {IT::EM 2} {IT::EM 3}} 1269 1270test tree-${impl}-3.11.13 {move node down one} { 1271 tree mytree 1272 mytree insert root end {IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} 1273 mytree move root [mytree index [mytree previous {IT::EM 2}]] {IT::EM 2} 1274 set result [mytree children root] 1275 mytree destroy 1276 set result 1277} {{IT::EM 0} {IT::EM 2} {IT::EM 1} {IT::EM 3}} 1278 1279test tree-${impl}-3.11.14a {move fails for a bad index} {!tcl8.5plus||tree_critcl} { 1280 tree mytree 1281 mytree insert root end node-to-move 1282 catch {mytree move root foo node-to-move} msg 1283 mytree destroy 1284 set msg 1285} {bad index "foo": must be integer or end?-integer?} 1286 1287test tree-${impl}-3.11.14b {move fails for a bad index} {tcl8.5plus&&!tree_critcl} { 1288 tree mytree 1289 mytree insert root end node-to-move 1290 catch {mytree move root foo node-to-move} msg 1291 mytree destroy 1292 set msg 1293} {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?} 1294 1295test tree-${impl}-3.11.15 {move correctly moves a node} { 1296 tree mytree 1297 mytree insert root end a 1298 mytree insert a end b 1299 mytree insert a end d 1300 mytree insert a end e 1301 mytree insert b end c 1302 1303 mytree move a end-1 c 1304 set result {} 1305 lappend result [mytree children a] 1306 lappend result [mytree children b] 1307 lappend result [mytree parent c] 1308 mytree destroy 1309 set result 1310} {{b d c e} {} a} 1311 1312############################################################ 1313 1314test tree-${impl}-3.12.1 {cutting nodes} { 1315 tree mytree 1316 mytree insert root end {IT::EM 0} 1317 mytree insert root end {IT::EM 1} 1318 mytree insert root end {IT::EM 2} 1319 mytree insert {IT::EM 1} end {IT::EM 1.0} 1320 mytree insert {IT::EM 1} end {IT::EM 1.1} 1321 mytree insert {IT::EM 1} end {IT::EM 1.2} 1322 mytree cut {IT::EM 1} 1323 set t [list ] 1324 mytree walk root {a n} {lappend t $a $n} 1325 mytree destroy 1326 set t 1327} {enter root enter {IT::EM 0} enter {IT::EM 1.0} enter {IT::EM 1.1} enter {IT::EM 1.2} enter {IT::EM 2}} 1328 1329test tree-${impl}-3.12.2 {cutting nodes} { 1330 tree mytree 1331 catch {mytree cut root} msg 1332 mytree destroy 1333 set msg 1334} {cannot cut root node} 1335 1336test tree-${impl}-3.12.3 {cut sets parent values of relocated nodes} { 1337 tree mytree 1338 mytree insert root end {IT::EM 0} 1339 mytree insert root end {IT::EM 1} 1340 mytree insert root end {IT::EM 2} 1341 mytree insert {IT::EM 1} end {IT::EM 1.0} 1342 mytree insert {IT::EM 1} end {IT::EM 1.1} 1343 mytree insert {IT::EM 1} end {IT::EM 1.2} 1344 mytree cut {IT::EM 1} 1345 set res [list \ 1346 [mytree parent {IT::EM 1.0}] \ 1347 [mytree parent {IT::EM 1.1}] \ 1348 [mytree parent {IT::EM 1.2}]] 1349 mytree destroy 1350 set res 1351} {root root root} 1352 1353test tree-${impl}-3.12.4 {cut removes node} { 1354 tree mytree 1355 mytree insert root end {IT::EM 0} 1356 mytree insert root end {IT::EM 1} 1357 mytree insert root end {IT::EM 2} 1358 mytree insert {IT::EM 1} end {IT::EM 1.0} 1359 mytree insert {IT::EM 1} end {IT::EM 1.1} 1360 mytree insert {IT::EM 1} end {IT::EM 1.2} 1361 mytree cut {IT::EM 1} 1362 set res [mytree exists {IT::EM 1}] 1363 mytree destroy 1364 set res 1365} 0 1366 1367test tree-${impl}-3.12.5 {cut removes node} { 1368 tree mytree 1369 catch {mytree cut {IT::EM 0}} msg 1370 mytree destroy 1371 set msg 1372} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 1373 1374############################################################ 1375 1376test tree-${impl}-3.13.0 {splicing nodes with bad parent node} { 1377 tree mytree 1378 catch {mytree splice foo 0 end} msg 1379 mytree destroy 1380 set msg 1381} "node \"foo\" does not exist in tree \"$MY\"" 1382 1383test tree-${impl}-3.13.1 {splicing nodes} { 1384 tree mytree 1385 mytree insert root end {IT::EM 0} 1386 mytree insert root end {IT::EM 1.0} 1387 mytree insert root end {IT::EM 1.1} 1388 mytree insert root end {IT::EM 1.2} 1389 mytree insert root end {IT::EM 2} 1390 1391 # root --> root 1392 # - 0 - 0 1393 # * 1.0 - 1 1394 # * 1.1 - 1.0 1395 # * 1.2 - 1.1 1396 # - 2 - 1.2 1397 # - 2 1398 1399 mytree splice root 1 3 {IT::EM 1} 1400 set t [list ] 1401 mytree walk root -order both {a n} {lappend t $a $n} 1402 mytree destroy 1403 set t 1404} [list \ 1405 enter root \ 1406 enter {IT::EM 0} \ 1407 leave {IT::EM 0} \ 1408 enter {IT::EM 1} \ 1409 enter {IT::EM 1.0} \ 1410 leave {IT::EM 1.0} \ 1411 enter {IT::EM 1.1} \ 1412 leave {IT::EM 1.1} \ 1413 enter {IT::EM 1.2} \ 1414 leave {IT::EM 1.2} \ 1415 leave {IT::EM 1} \ 1416 enter {IT::EM 2} \ 1417 leave {IT::EM 2} \ 1418 leave root \ 1419 ] 1420 1421test tree-${impl}-3.13.2 {splicing nodes with no node name given} { 1422 tree mytree 1423 mytree insert root end {IT::EM 0} 1424 mytree insert root end {IT::EM 1.0} 1425 mytree insert root end {IT::EM 1.1} 1426 mytree insert root end {IT::EM 1.2} 1427 mytree insert root end {IT::EM 2} 1428 1429 # root --> root 1430 # - 0 - 0 1431 # * 1.0 - node1 1432 # * 1.1 - 1.0 1433 # * 1.2 - 1.1 1434 # - 2 - 1.2 1435 # - 2 1436 1437 set res [mytree splice root 1 3] 1438 set t [list ] 1439 mytree walk root -order both {a n} {lappend t $a $n} 1440 mytree destroy 1441 list $res $t 1442} [list node1 [list \ 1443 enter root \ 1444 enter {IT::EM 0} \ 1445 leave {IT::EM 0} \ 1446 enter node1 \ 1447 enter {IT::EM 1.0} \ 1448 leave {IT::EM 1.0} \ 1449 enter {IT::EM 1.1} \ 1450 leave {IT::EM 1.1} \ 1451 enter {IT::EM 1.2} \ 1452 leave {IT::EM 1.2} \ 1453 leave node1 \ 1454 enter {IT::EM 2} \ 1455 leave {IT::EM 2} \ 1456 leave root \ 1457 ]] 1458 1459test tree-${impl}-3.13.3 {splicing nodes errors on duplicate node name} { 1460 tree mytree 1461 mytree insert root end {IT::EM 0} 1462 mytree insert root end {IT::EM 1.0} 1463 mytree insert root end {IT::EM 1.1} 1464 mytree insert root end {IT::EM 1.2} 1465 mytree insert root end {IT::EM 2} 1466 catch {mytree splice root 1 3 {IT::EM 0}} msg 1467 mytree destroy 1468 set msg 1469} "node \"IT::EM 0\" already exists in tree \"$MY\"" 1470 1471test tree-${impl}-3.13.4 {splicing node sets parent values correctly} { 1472 tree mytree 1473 mytree insert root end {IT::EM 0} 1474 mytree insert root end {IT::EM 1.0} 1475 mytree insert root end {IT::EM 1.1} 1476 mytree insert root end {IT::EM 1.2} 1477 mytree insert root end {IT::EM 2} 1478 1479 # root --> root 1480 # - 0 - 0 1481 # * 1.0 - 1 1482 # * 1.1 - 1.0 1483 # * 1.2 - 1.1 1484 # - 2 - 1.2 1485 # - 2 1486 1487 mytree splice root 1 3 {IT::EM 1} 1488 set res [list \ 1489 [mytree parent {IT::EM 1}] \ 1490 [mytree parent {IT::EM 1.0}] \ 1491 [mytree parent {IT::EM 1.1}] \ 1492 [mytree parent {IT::EM 1.2}]] 1493 mytree destroy 1494 set res 1495} {root {IT::EM 1} {IT::EM 1} {IT::EM 1}} 1496 1497test tree-${impl}-3.13.5 {splicing node works with strange index} { 1498 tree mytree 1499 mytree insert root end {IT::EM 0} 1500 mytree insert root end {IT::EM 1.0} 1501 mytree insert root end {IT::EM 1.1} 1502 mytree insert root end {IT::EM 1.2} 1503 mytree insert root end {IT::EM 2} 1504 1505 # root --> root 1506 # - 0 - 1 1507 # * 1.0 - 0 1508 # * 1.1 - 1.0 1509 # * 1.2 - 1.1 1510 # - 2 - 1.2 1511 # - 2 1512 1513 mytree splice root -5 12 {IT::EM 1} 1514 set t [list ] 1515 mytree walk root -order both {a n} {lappend t $a $n} 1516 mytree destroy 1517 set t 1518} [list \ 1519 enter root \ 1520 enter {IT::EM 1} \ 1521 enter {IT::EM 0} \ 1522 leave {IT::EM 0} \ 1523 enter {IT::EM 1.0} \ 1524 leave {IT::EM 1.0} \ 1525 enter {IT::EM 1.1} \ 1526 leave {IT::EM 1.1} \ 1527 enter {IT::EM 1.2} \ 1528 leave {IT::EM 1.2} \ 1529 enter {IT::EM 2} \ 1530 leave {IT::EM 2} \ 1531 leave {IT::EM 1} \ 1532 leave root \ 1533 ] 1534 1535test tree-${impl}-3.13.6 {splicing nodes with no node name and no "to" index given} { 1536 tree mytree 1537 mytree insert root end {IT::EM 0} 1538 mytree insert root end {IT::EM 1.0} 1539 mytree insert root end {IT::EM 1.1} 1540 mytree insert root end {IT::EM 1.2} 1541 mytree insert root end {IT::EM 2} 1542 1543 # root --> root 1544 # - 0 - 0 1545 # - 1.0 - node1 1546 # - 1.1 - 1.0 1547 # - 1.2 - 1.1 1548 # - 2 - 1.2 1549 # - 2 1550 1551 mytree splice root 1 1552 set t [list ] 1553 mytree walk root -order both {a n} {lappend t $a $n} 1554 mytree destroy 1555 set t 1556} [list \ 1557 enter root \ 1558 enter {IT::EM 0} \ 1559 leave {IT::EM 0} \ 1560 enter node1 \ 1561 enter {IT::EM 1.0} \ 1562 leave {IT::EM 1.0} \ 1563 enter {IT::EM 1.1} \ 1564 leave {IT::EM 1.1} \ 1565 enter {IT::EM 1.2} \ 1566 leave {IT::EM 1.2} \ 1567 enter {IT::EM 2} \ 1568 leave {IT::EM 2} \ 1569 leave node1 \ 1570 leave root \ 1571 ] 1572 1573test tree-${impl}-3.13.7 {splicing nodes with to == end} { 1574 tree mytree 1575 mytree insert root end {IT::EM 0} 1576 mytree insert root end {IT::EM 1.0} 1577 mytree insert root end {IT::EM 1.1} 1578 mytree insert root end {IT::EM 1.2} 1579 mytree insert root end {IT::EM 2} 1580 1581 # root --> root 1582 # - 0 - 0 1583 # - 1.0 - node1 1584 # - 1.1 - 1.0 1585 # - 1.2 - 1.1 1586 # - 2 - 1.2 1587 # - 2 1588 1589 mytree splice root 1 end 1590 set t [list ] 1591 mytree walk root -order both {a n} {lappend t $a $n} 1592 mytree destroy 1593 set t 1594} [list \ 1595 enter root \ 1596 enter {IT::EM 0} \ 1597 leave {IT::EM 0} \ 1598 enter node1 \ 1599 enter {IT::EM 1.0} \ 1600 leave {IT::EM 1.0} \ 1601 enter {IT::EM 1.1} \ 1602 leave {IT::EM 1.1} \ 1603 enter {IT::EM 1.2} \ 1604 leave {IT::EM 1.2} \ 1605 enter {IT::EM 2} \ 1606 leave {IT::EM 2} \ 1607 leave node1 \ 1608 leave root \ 1609 ] 1610 1611test tree-${impl}-3.13.8 {splicing nodes with to == end-1} { 1612 tree mytree 1613 mytree insert root end {IT::EM 0} 1614 mytree insert root end {IT::EM 1.0} 1615 mytree insert root end {IT::EM 1.1} 1616 mytree insert root end {IT::EM 1.2} 1617 mytree insert root end {IT::EM 2} 1618 1619 # root --> root 1620 # - 0 - 0 1621 # - 1.0 - node1 1622 # - 1.1 - 1.0 1623 # - 1.2 - 1.1 1624 # - 2 - 1.2 1625 # - 2 1626 1627 mytree splice root 1 end-1 1628 set t [list ] 1629 mytree walk root -order both {a n} {lappend t $a $n} 1630 mytree destroy 1631 set t 1632} [list \ 1633 enter root \ 1634 enter {IT::EM 0} \ 1635 leave {IT::EM 0} \ 1636 enter node1 \ 1637 enter {IT::EM 1.0} \ 1638 leave {IT::EM 1.0} \ 1639 enter {IT::EM 1.1} \ 1640 leave {IT::EM 1.1} \ 1641 enter {IT::EM 1.2} \ 1642 leave {IT::EM 1.2} \ 1643 leave node1 \ 1644 enter {IT::EM 2} \ 1645 leave {IT::EM 2} \ 1646 leave root \ 1647 ] 1648 1649test tree-${impl}-3.13.9 {splicing nodes} { 1650 tree mytree 1651 mytree insert root end {IT::EM 0} 1652 mytree insert root end {IT::EM 1.0} 1653 mytree insert root end {IT::EM 1.1} 1654 mytree insert root end {IT::EM 1.2} 1655 mytree insert root end {IT::EM 2} 1656 1657 # root --> root 1658 # - 0 - 0 1659 # - 1.0 - node1 1660 # - 1.1 - 1.0 1661 # - 1.2 - 1.1 1662 # - 2 - 1.2 1663 # - 2 1664 1665 mytree splice root end-3 end 1666 set t [list ] 1667 mytree walk root -order both {a n} {lappend t $a $n} 1668 mytree destroy 1669 set t 1670} [list \ 1671 enter root \ 1672 enter {IT::EM 0} \ 1673 leave {IT::EM 0} \ 1674 enter node1 \ 1675 enter {IT::EM 1.0} \ 1676 leave {IT::EM 1.0} \ 1677 enter {IT::EM 1.1} \ 1678 leave {IT::EM 1.1} \ 1679 enter {IT::EM 1.2} \ 1680 leave {IT::EM 1.2} \ 1681 enter {IT::EM 2} \ 1682 leave {IT::EM 2} \ 1683 leave node1 \ 1684 leave root \ 1685 ] 1686 1687test tree-${impl}-3.13.10 {splicing nodes} { 1688 tree mytree 1689 mytree insert root end {IT::EM 0} 1690 mytree insert root end {IT::EM 1.0} 1691 mytree insert root end {IT::EM 1.1} 1692 mytree insert root end {IT::EM 1.2} 1693 mytree insert root end {IT::EM 2} 1694 1695 # root --> root 1696 # - 0 - 0 1697 # - 1.0 - node1 1698 # - 1.1 - 1.0 1699 # - 1.2 - 1.1 1700 # - 2 - 1.2 1701 # - 2 1702 1703 mytree splice root end-3 end-1 1704 set t [list ] 1705 mytree walk root -order both {a n} {lappend t $a $n} 1706 mytree destroy 1707 set t 1708} [list \ 1709 enter root \ 1710 enter {IT::EM 0} \ 1711 leave {IT::EM 0} \ 1712 enter node1 \ 1713 enter {IT::EM 1.0} \ 1714 leave {IT::EM 1.0} \ 1715 enter {IT::EM 1.1} \ 1716 leave {IT::EM 1.1} \ 1717 enter {IT::EM 1.2} \ 1718 leave {IT::EM 1.2} \ 1719 leave node1 \ 1720 enter {IT::EM 2} \ 1721 leave {IT::EM 2} \ 1722 leave root \ 1723 ] 1724 1725############################################################ 1726 1727test tree-${impl}-3.14.1 {swap gives error when trying to swap root} { 1728 tree mytree 1729 catch {mytree swap root {IT::EM 0}} msg 1730 mytree destroy 1731 set msg 1732} {cannot swap root node} 1733 1734test tree-${impl}-3.14.2 {swap gives error when trying to swap non existant node} { 1735 tree mytree 1736 catch {mytree swap {IT::EM 0} {IT::EM 1}} msg 1737 mytree destroy 1738 set msg 1739} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 1740 1741test tree-${impl}-3.14.3 {swap gives error when trying to swap non existant node} { 1742 tree mytree 1743 mytree insert root end {IT::EM 0} 1744 catch {mytree swap {IT::EM 0} {IT::EM 1}} msg 1745 mytree destroy 1746 set msg 1747} "node \"IT::EM 1\" does not exist in tree \"$MY\"" 1748 1749test tree-${impl}-3.14.4 {swap gives error when trying to swap node with self} { 1750 tree mytree 1751 mytree insert root end {IT::EM 0} 1752 catch {mytree swap {IT::EM 0} {IT::EM 0}} msg 1753 mytree destroy 1754 set msg 1755} {cannot swap node "IT::EM 0" with itself} 1756 1757test tree-${impl}-3.14.5 {swap swaps node relationships correctly} { 1758 tree mytree 1759 mytree insert root end 0 1760 mytree insert 0 end 0.1 1761 mytree insert 0 end 0.2 1762 mytree insert 0.1 end 0.1.1 1763 mytree insert 0.1 end 0.1.2 1764 1765 # root --> root 1766 # * 0 * 0.1 1767 # * 0.1 * 0 1768 # - 0.1.1 - 0.1.1 1769 # - 0.1.2 - 0.1.2 1770 # - 0.2 - 0.2 1771 1772 mytree swap 0 0.1 1773 set t [list] 1774 mytree walk root -order both {a n} {lappend t $a $n} 1775 mytree destroy 1776 set t 1777} [list enter root \ 1778 enter 0.1 \ 1779 enter 0 \ 1780 enter 0.1.1 \ 1781 leave 0.1.1 \ 1782 enter 0.1.2 \ 1783 leave 0.1.2 \ 1784 leave 0 \ 1785 enter 0.2 \ 1786 leave 0.2 \ 1787 leave 0.1 \ 1788 leave root \ 1789 ] 1790 1791test tree-${impl}-3.14.6 {swap swaps node relationships correctly} { 1792 tree mytree 1793 mytree insert root end 0 1794 mytree insert 0 end 0.1 1795 mytree insert 0 end 0.2 1796 mytree insert 0.1 end 0.1.1 1797 mytree insert 0.1 end 0.1.2 1798 1799 # root --> root 1800 # * 0 * 0.1.1 1801 # - 0.1 - 0.1 1802 # * 0.1.1 * 0 1803 # - 0.1.2 - 0.1.2 1804 # - 0.2 - 0.2 1805 1806 mytree swap 0 0.1.1 1807 set t [list ] 1808 mytree walk root -order both {a n} {lappend t $a $n} 1809 mytree destroy 1810 set t 1811} [list enter root \ 1812 enter 0.1.1 \ 1813 enter 0.1 \ 1814 enter 0 \ 1815 leave 0 \ 1816 enter 0.1.2 \ 1817 leave 0.1.2 \ 1818 leave 0.1 \ 1819 enter 0.2 \ 1820 leave 0.2 \ 1821 leave 0.1.1 \ 1822 leave root \ 1823 ] 1824 1825test tree-${impl}-3.14.7 {swap swaps node relationships correctly} { 1826 tree mytree 1827 mytree insert root end 0 1828 mytree insert root end 1 1829 mytree insert 0 end 0.1 1830 mytree insert 1 end 1.1 1831 1832 # root --> root 1833 # * 0 * 1 1834 # - 0.1 - 0.1 1835 # * 1 * 0 1836 # - 1.1 - 1.1 1837 1838 mytree swap 0 1 1839 set t [list ] 1840 mytree walk root -order both {a n} {lappend t $a $n} 1841 mytree destroy 1842 set t 1843} [list enter root \ 1844 enter 1 \ 1845 enter 0.1 \ 1846 leave 0.1 \ 1847 leave 1 \ 1848 enter 0 \ 1849 enter 1.1 \ 1850 leave 1.1 \ 1851 leave 0 \ 1852 leave root \ 1853 ] 1854 1855test tree-${impl}-3.14.8 {swap swaps node relationships correctly} { 1856 tree mytree 1857 mytree insert root end 0 1858 mytree insert 0 end 0.1 1859 mytree insert 0 end 0.2 1860 mytree insert 0.1 end 0.1.1 1861 mytree insert 0.1 end 0.1.2 1862 1863 # root --> root 1864 # * 0 * 0.1 1865 # * 0.1 * 0 1866 # - 0.1.1 - 0.1.1 1867 # - 0.1.2 - 0.1.2 1868 # - 0.2 - 0.2 1869 1870 mytree swap 0.1 0 1871 set t [list ] 1872 mytree walk root -order both {a n} {lappend t $a $n} 1873 mytree destroy 1874 set t 1875} [list enter root \ 1876 enter 0.1 \ 1877 enter 0 \ 1878 enter 0.1.1 \ 1879 leave 0.1.1 \ 1880 enter 0.1.2 \ 1881 leave 0.1.2 \ 1882 leave 0 \ 1883 enter 0.2 \ 1884 leave 0.2 \ 1885 leave 0.1 \ 1886 leave root \ 1887 ] 1888 1889test tree-${impl}-3.14.9 {swap keeps attributes with their nodes} { 1890 tree mytree 1891 mytree insert root end 0 1 2 3 1892 mytree set 0 attr a 1893 mytree set 1 attr b 1894 mytree set 2 attr c 1895 mytree set 3 attr d 1896 1897 mytree swap 0 3 1898 1899 set res [list \ 1900 [mytree children root] \ 1901 [mytree get 0 attr] \ 1902 [mytree get 1 attr] \ 1903 [mytree get 2 attr] \ 1904 [mytree get 3 attr]] 1905 1906 mytree destroy 1907 set res 1908} {{3 1 2 0} a b c d} 1909 1910############################################################ 1911 1912test tree-${impl}-3.15.1 {rootname, wrong # args} { 1913 tree mytree 1914 catch {mytree rootname foo far} result 1915 mytree destroy 1916 set result 1917} [tmTooMany rootname {}] 1918 1919test tree-${impl}-3.15.2 {rootname} { 1920 tree mytree 1921 set result [mytree rootname] 1922 mytree destroy 1923 set result 1924} root 1925 1926############################################################ 1927 1928test tree-${impl}-3.16.1 {rename, wrong # args} { 1929 tree mytree 1930 catch {mytree rename foo far fox} result 1931 mytree destroy 1932 set result 1933} [tmTooMany rename {node newname}] 1934 1935test tree-${impl}-3.16.2 {rename of bogus node fails} { 1936 tree mytree 1937 catch {mytree rename 0 foo} result 1938 mytree destroy 1939 set result 1940} "node \"0\" does not exist in tree \"$MY\"" 1941 1942test tree-${impl}-3.16.3 {rename, setting to existing node fails} { 1943 tree mytree 1944 mytree insert root end 0 1945 catch {mytree rename root 0} result 1946 mytree destroy 1947 set result 1948} "unable to rename node to \"0\", node of that name already present in the tree \"$MY\"" 1949 1950test tree-${impl}-3.16.4 {rename root, setting} { 1951 tree mytree 1952 set result [list] 1953 lappend result [mytree rootname] 1954 lappend result [mytree rename root foo] 1955 lappend result [mytree rootname] 1956 mytree destroy 1957 set result 1958} {root foo foo} 1959 1960test tree-${impl}-3.16.5 {rename root, parents} { 1961 tree mytree 1962 mytree insert root end 0 1963 set result [list] 1964 lappend result [mytree parent 0] 1965 mytree rename root foo 1966 lappend result [mytree parent 0] 1967 mytree destroy 1968 set result 1969} {root foo} 1970 1971test tree-${impl}-3.16.6 {rename root, existence} { 1972 tree mytree 1973 set result [list] 1974 lappend result [mytree exists root] 1975 lappend result [mytree exists 0] 1976 mytree rename root 0 1977 lappend result [mytree exists root] 1978 lappend result [mytree exists 0] 1979 mytree destroy 1980 set result 1981} {1 0 0 1} 1982 1983test tree-${impl}-3.16.7 {rename root, children} { 1984 tree mytree 1985 mytree insert root end xx 1986 set result [list] 1987 lappend result [mytree children root] 1988 lappend result [catch {mytree children foo}] 1989 mytree rename root foo 1990 lappend result [mytree children foo] 1991 lappend result [catch {mytree children root}] 1992 mytree destroy 1993 set result 1994} {xx 1 xx 1} 1995 1996test tree-${impl}-3.16.8 {rename root, attributes} { 1997 tree mytree 1998 mytree set root data foo 1999 set result [list] 2000 lappend result [mytree getall root] 2001 lappend result [catch {mytree getall foo}] 2002 mytree rename root foo 2003 lappend result [mytree getall foo] 2004 lappend result [catch {mytree getall root}] 2005 mytree destroy 2006 set result 2007} {{data foo} 1 {data foo} 1} 2008 2009test tree-${impl}-3.16.9 {rename node, index} { 2010 tree mytree 2011 set result [list] 2012 mytree insert root end 0 2013 mytree insert root end 1 2014 mytree insert root end 2 2015 lappend result [mytree index 1] 2016 lappend result [mytree rename 1 foo] 2017 lappend result [mytree index foo] 2018 mytree destroy 2019 set result 2020} {1 foo 1} 2021 2022############################################################ 2023 2024test tree-${impl}-3.17.1 {ancestors, wrong # args} { 2025 tree mytree 2026 catch {mytree ancestors {IT::EM 0} foo} msg 2027 mytree destroy 2028 set msg 2029} [tmTooMany ancestors {node}] 2030 2031test tree-${impl}-3.17.2 {ancestors gives error on fake node} { 2032 tree mytree 2033 catch {mytree ancestors {IT::EM 0}} msg 2034 mytree destroy 2035 set msg 2036} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2037 2038test tree-${impl}-3.17.3 {ancestors gives correct value} { 2039 tree mytree 2040 mytree insert root end {IT::EM 0} 2041 mytree insert {IT::EM 0} end {IT::EM 1} 2042 mytree insert {IT::EM 1} end {IT::EM 2} 2043 set result [mytree ancestors {IT::EM 2}] 2044 mytree destroy 2045 set result 2046} {{IT::EM 1} {IT::EM 0} root} 2047 2048test tree-${impl}-3.17.4 {ancestors of root is empty string} { 2049 tree mytree 2050 set result [mytree ancestors root] 2051 mytree destroy 2052 set result 2053} {} 2054 2055############################################################ 2056 2057test tree-${impl}-3.18.1 {descendants} { 2058 tree mytree 2059 set result [list] 2060 2061 mytree insert root end 0 2062 mytree insert root end 1 2063 mytree insert root end 2 2064 mytree insert 0 end 3 2065 mytree insert 0 end 4 2066 mytree insert 4 end 5 2067 mytree insert 4 end 6 2068 2069 set result {} 2070 lappend result [lsort [mytree descendants root]] 2071 lappend result [lsort [mytree descendants 0]] 2072 mytree destroy 2073 set result 2074} {{0 1 2 3 4 5 6} {3 4 5 6}} 2075 2076test tree-${impl}-3.18.2 {descendants, filtering} { 2077 tree mytree 2078 set result [list] 2079 2080 mytree insert root end 0 ; mytree set 0 volume 30 2081 mytree insert root end 1 2082 mytree insert root end 2 2083 mytree insert 0 end 3 2084 mytree insert 0 end 4 2085 mytree insert 4 end 5 ; mytree set 5 volume 50 2086 mytree insert 4 end 6 2087 2088 proc vol {t n} { 2089 $t keyexists $n volume 2090 } 2091 proc vgt40 {t n} { 2092 if {![$t keyexists $n volume]} {return 0} 2093 expr {[$t get $n volume] > 40} 2094 } 2095 2096 set result {} 2097 lappend result [lsort [mytree descendants root filter vol]] 2098 lappend result [lsort [mytree descendants root filter vgt40]] 2099 mytree destroy 2100 set result 2101} {{0 5} 5} 2102 2103test tree-${impl}-3.18.3 {descendants, bad filter keyword} { 2104 tree mytree 2105 mytree insert root end a 2106 mytree insert root end b 2107 proc ff {t n} {return 1} 2108 2109 catch {mytree descendants root snarf ff} msg 2110 2111 mytree destroy 2112 rename ff {} 2113 set msg 2114} "wrong # args: should be \"$MY descendants node ?filter cmd?\"" 2115 2116test tree-${impl}-3.18.4 {descendants, empty filter} { 2117 tree mytree 2118 mytree insert root end a 2119 mytree insert root end b 2120 2121 catch {mytree descendants root filter {}} msg 2122 2123 mytree destroy 2124 set msg 2125} "wrong # args: should be \"$MY descendants node ?filter cmd?\"" 2126 2127test tree-${impl}-3.18.5 {descendants, filter cmdprefix not a list} { 2128 tree mytree 2129 mytree insert root end a 2130 mytree insert root end b 2131 2132 catch {mytree descendants root filter "\{"} msg 2133 2134 mytree destroy 2135 set msg 2136} {unmatched open brace in list} 2137 2138test tree-${impl}-3.18.6 {descendants, filter, unknown command} { 2139 tree mytree 2140 mytree insert root end a 2141 mytree insert root end b 2142 2143 catch {mytree descendants root filter ::bogus} msg 2144 2145 mytree destroy 2146 set msg 2147} {invalid command name "::bogus"} 2148 2149test tree-${impl}-3.18.7 {descendants, filter returning error} { 2150 tree mytree 2151 mytree insert root end a 2152 mytree insert root end b 2153 proc ff {t n} {return -code error "boo"} 2154 2155 catch {mytree descendants root filter ::ff} msg 2156 2157 mytree destroy 2158 rename ff {} 2159 set msg 2160} {boo} 2161 2162test tree-${impl}-3.18.8 {descendants, filter result not boolean} { 2163 tree mytree 2164 mytree insert root end a 2165 mytree insert root end b 2166 proc ff {t n} {return "boo"} 2167 2168 catch {mytree descendants root filter ::ff} msg 2169 2170 mytree destroy 2171 rename ff {} 2172 set msg 2173} {expected boolean value but got "boo"} 2174 2175############################################################ 2176 2177test tree-${impl}-3.19.1a {nodes, wrong # args} {tcl8.4plus} { 2178 tree mytree 2179 catch {mytree nodes {IT::EM 0} foo} result 2180 mytree destroy 2181 set result 2182} [tmWrong nodes {} 0] 2183 2184test tree-${impl}-3.19.1b {nodes, wrong # args} {!tcl8.4plus} { 2185 tree mytree 2186 catch {mytree nodes {IT::EM 0} foo} result 2187 mytree destroy 2188 set result 2189} [tmTooMany nodes {node}] 2190 2191test tree-${impl}-3.19.2 {nodes of initial tree} { 2192 tree mytree 2193 set result [mytree nodes] 2194 mytree destroy 2195 set result 2196} {root} 2197 2198test tree-${impl}-3.19.3 {nodes} { 2199 tree mytree 2200 set result [list] 2201 2202 lappend result [mytree nodes] 2203 2204 mytree insert root end {IT::EM 0} 2205 mytree insert root end {IT::EM 1} 2206 mytree insert root end {IT::EM 2} 2207 mytree insert {IT::EM 0} end {IT::EM 3} 2208 mytree insert {IT::EM 0} end {IT::EM 4} 2209 2210 lappend result [lsort [mytree nodes]] 2211 mytree destroy 2212 set result 2213} {root {{IT::EM 0} {IT::EM 1} {IT::EM 2} {IT::EM 3} {IT::EM 4} root}} 2214 2215 2216############################################################ 2217 2218test tree-${impl}-3.20.1a {leaves, wrong # args} {tcl8.4plus} { 2219 tree mytree 2220 catch {mytree leaves {IT::EM 0} foo} result 2221 mytree destroy 2222 set result 2223} [tmWrong leaves {} 0] 2224 2225test tree-${impl}-3.20.1b {leaves, wrong # args} {!tcl8.4plus} { 2226 tree mytree 2227 catch {mytree leaves {IT::EM 0} foo} result 2228 mytree destroy 2229 set result 2230} [tmTooMany leaves {node}] 2231 2232test tree-${impl}-3.20.2 {leaves of initial tree} { 2233 tree mytree 2234 set result [mytree leaves] 2235 mytree destroy 2236 set result 2237} {root} 2238 2239test tree-${impl}-3.20.3 {leaves} { 2240 tree mytree 2241 set result [list] 2242 2243 lappend result [mytree leaves] 2244 2245 mytree insert root end {IT::EM 0} 2246 mytree insert root end {IT::EM 1} 2247 mytree insert root end {IT::EM 2} 2248 mytree insert {IT::EM 0} end {IT::EM 3} 2249 mytree insert {IT::EM 0} end {IT::EM 4} 2250 2251 lappend result [lsort [mytree leaves]] 2252 mytree destroy 2253 set result 2254} {root {{IT::EM 1} {IT::EM 2} {IT::EM 3} {IT::EM 4}}} 2255 2256############################################################ 2257# IV. Navigation in the tree 2258# - index, next, previous, walk 2259############################################################ 2260 2261############################################################ 2262 2263test tree-${impl}-4.1.1 {index, wrong # args} { 2264 tree mytree 2265 catch {mytree index root foo} msg 2266 mytree destroy 2267 set msg 2268} [tmTooMany index {node}] 2269 2270test tree-${impl}-4.1.2 {index of non-existant node} { 2271 tree mytree 2272 catch {mytree index {IT::EM 0}} msg 2273 mytree destroy 2274 set msg 2275} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2276 2277test tree-${impl}-4.1.3 {index of root fails} { 2278 tree mytree 2279 catch {mytree index root} msg 2280 mytree destroy 2281 set msg 2282} {cannot determine index of root node} 2283 2284test tree-${impl}-4.1.4 {index} { 2285 tree mytree 2286 mytree insert root end {IT::EM 1} 2287 mytree insert root end {IT::EM 0} 2288 set result [list] 2289 lappend result [mytree index {IT::EM 0}] 2290 lappend result [mytree index {IT::EM 1}] 2291 mytree destroy 2292 set result 2293} {1 0} 2294 2295############################################################ 2296 2297test tree-${impl}-4.2.1 {next, wrong # args} { 2298 tree mytree 2299 mytree insert root end 0 2300 catch {mytree next 0 foo} msg 2301 mytree destroy 2302 set msg 2303} [tmTooMany next {node}] 2304 2305test tree-${impl}-4.2.2 {next for bogus node} { 2306 tree mytree 2307 catch {mytree next {IT::EM 0}} msg 2308 mytree destroy 2309 set msg 2310} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2311 2312test tree-${impl}-4.2.3 {next from root} { 2313 tree mytree 2314 set res [mytree next root] 2315 mytree destroy 2316 set res 2317} {} 2318 2319test tree-${impl}-4.2.4 {next} { 2320 tree mytree 2321 mytree insert root end {IT::EM 0} 2322 mytree insert root end {IT::EM 1} 2323 set res [list [mytree next {IT::EM 0}] [mytree next {IT::EM 1}]] 2324 mytree destroy 2325 set res 2326} {{IT::EM 1} {}} 2327 2328############################################################ 2329 2330test tree-${impl}-4.3.1 {previous, wrong # args} { 2331 tree mytree 2332 mytree insert root end 0 2333 catch {mytree previous 0 foo} msg 2334 mytree destroy 2335 set msg 2336} [tmTooMany previous {node}] 2337 2338test tree-${impl}-4.3.2 {previous for bogus node} { 2339 tree mytree 2340 catch {mytree previous {IT::EM 0}} msg 2341 mytree destroy 2342 set msg 2343} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2344 2345test tree-${impl}-4.3.3 {previous from root} { 2346 tree mytree 2347 set res [mytree previous root] 2348 mytree destroy 2349 set res 2350} {} 2351 2352test tree-${impl}-4.3.4 {previous} { 2353 tree mytree 2354 mytree insert root end {IT::EM 0} 2355 mytree insert root end {IT::EM 1} 2356 set res [list [mytree previous {IT::EM 0}] [mytree previous {IT::EM 1}]] 2357 mytree destroy 2358 set res 2359} {{} {IT::EM 0}} 2360 2361############################################################ 2362 2363test tree-${impl}-4.4.1 {walk with too few args} {badTest} { 2364 tree mytree 2365 catch {mytree walk} msg 2366 mytree destroy 2367 set msg 2368} {no value given for parameter "node" to "::struct::tree::_walk"} 2369 2370test tree-${impl}-4.4.2 {walk with too few args} { 2371 tree mytree 2372 catch {mytree walk root} msg 2373 mytree destroy 2374 set msg 2375} "wrong # args: should be \"$MY walk node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? loopvar script\"" 2376 2377test tree-${impl}-4.4.3 {walk with too many args} { 2378 tree mytree 2379 catch {mytree walk root -foo bar -baz boo -foo2 boo -foo3 baz -foo4 gnar -foo5 schnurr} msg 2380 mytree destroy 2381 set msg 2382} "wrong # args: should be \"$MY walk node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? loopvar script\"" 2383 2384test tree-${impl}-4.4.4 {walk with fake node} { 2385 tree mytree 2386 catch {mytree walk {IT::EM 0} {a n} foo} msg 2387 mytree destroy 2388 set msg 2389} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2390 2391test tree-${impl}-4.4.5 {walk gives error on invalid search type} { 2392 tree mytree 2393 catch {mytree walk root -type foo {a n} foo} msg 2394 mytree destroy 2395 set msg 2396} {bad search type "foo": must be bfs or dfs} 2397 2398test tree-${impl}-4.4.6 {walk gives error on invalid search order} { 2399 tree mytree 2400 catch {mytree walk root -order foo {a n} foo} msg 2401 mytree destroy 2402 set msg 2403} {bad search order "foo": must be both, in, pre, or post} 2404 2405test tree-${impl}-4.4.7 {walk gives error on invalid combination of order and type} { 2406 tree mytree 2407 catch {mytree walk root -order in -type bfs {a n} foo} msg 2408 mytree destroy 2409 set msg 2410} {unable to do a in-order breadth first walk} 2411 2412test tree-${impl}-4.4.8 {walk with unknown options} { 2413 tree mytree 2414 catch {mytree walk root -foo bar {a n} foo} msg 2415 mytree destroy 2416 set msg 2417} {unknown option "-foo"} 2418 2419test tree-${impl}-4.4.9 {walk, option without value} { 2420 tree mytree 2421 catch {mytree walk root -type dfs -order} msg 2422 mytree destroy 2423 set msg 2424} {value for "-order" missing} 2425 2426test tree-${impl}-4.4.10 {walk without command} { 2427 tree mytree 2428 catch {mytree walk root -order pre} msg 2429 mytree destroy 2430 set msg 2431} "wrong # args: should be \"$MY walk node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? loopvar script\"" 2432 2433test tree-${impl}-4.4.10.1 {walk with too many loop variables} { 2434 tree mytree 2435 catch {mytree walk root {a n d} {foo}} msg 2436 mytree destroy 2437 set msg 2438} {too many loop variables, at most two allowed} 2439 2440test tree-${impl}-4.4.10.2 {walk with empty script} { 2441 tree mytree 2442 catch {mytree walk root {a n} {}} msg 2443 mytree destroy 2444 set msg 2445} {no script specified, or empty} 2446 2447test tree-${impl}-4.4.11.1 {pre dfs walk} { 2448 tree mytree 2449 set t [list ] 2450 mytree insert root end {IT::EM 0} 2451 mytree insert root end {IT::EM 1} 2452 mytree insert {IT::EM 0} end {IT::EM 0.1} 2453 mytree insert {IT::EM 0} end {IT::EM 0.2} 2454 mytree insert {IT::EM 1} end {IT::EM 1.1} 2455 mytree insert {IT::EM 1} end {IT::EM 1.2} 2456 mytree walk root -type dfs {a n} {lappend t $a $n} 2457 mytree destroy 2458 set t 2459} [list enter root \ 2460 enter {IT::EM 0} \ 2461 enter {IT::EM 0.1} \ 2462 enter {IT::EM 0.2} \ 2463 enter {IT::EM 1} \ 2464 enter {IT::EM 1.1} \ 2465 enter {IT::EM 1.2}] 2466 2467test tree-${impl}-4.4.11.2 {post dfs walk} { 2468 tree mytree 2469 set t [list ] 2470 mytree insert root end {IT::EM 0} 2471 mytree insert root end {IT::EM 1} 2472 mytree insert {IT::EM 0} end {IT::EM 0.1} 2473 mytree insert {IT::EM 0} end {IT::EM 0.2} 2474 mytree insert {IT::EM 1} end {IT::EM 1.1} 2475 mytree insert {IT::EM 1} end {IT::EM 1.2} 2476 mytree walk root -order post -type dfs {a n} {lappend t $a $n} 2477 mytree destroy 2478 set t 2479} [list leave {IT::EM 0.1} \ 2480 leave {IT::EM 0.2} \ 2481 leave {IT::EM 0} \ 2482 leave {IT::EM 1.1} \ 2483 leave {IT::EM 1.2} \ 2484 leave {IT::EM 1} \ 2485 leave root] 2486 2487test tree-${impl}-4.4.11.3 {both dfs walk} { 2488 tree mytree 2489 set t [list ] 2490 mytree insert root end {IT::EM 0} 2491 mytree insert root end {IT::EM 1} 2492 mytree insert {IT::EM 0} end {IT::EM 0.1} 2493 mytree insert {IT::EM 0} end {IT::EM 0.2} 2494 mytree insert {IT::EM 1} end {IT::EM 1.1} 2495 mytree insert {IT::EM 1} end {IT::EM 1.2} 2496 mytree walk root -order both -type dfs {a n} {lappend t $a $n} 2497 mytree destroy 2498 set t 2499} [list enter root \ 2500 enter {IT::EM 0} \ 2501 enter {IT::EM 0.1} \ 2502 leave {IT::EM 0.1} \ 2503 enter {IT::EM 0.2} \ 2504 leave {IT::EM 0.2} \ 2505 leave {IT::EM 0} \ 2506 enter {IT::EM 1} \ 2507 enter {IT::EM 1.1} \ 2508 leave {IT::EM 1.1} \ 2509 enter {IT::EM 1.2} \ 2510 leave {IT::EM 1.2} \ 2511 leave {IT::EM 1} \ 2512 leave root] 2513 2514test tree-${impl}-4.4.11.4 {in dfs walk} { 2515 tree mytree 2516 set t [list ] 2517 mytree insert root end {IT::EM 0} 2518 mytree insert root end {IT::EM 1} 2519 mytree insert {IT::EM 0} end {IT::EM 0.1} 2520 mytree insert {IT::EM 0} end {IT::EM 0.2} 2521 mytree insert {IT::EM 1} end {IT::EM 1.1} 2522 mytree insert {IT::EM 1} end {IT::EM 1.2} 2523 mytree walk root -order in -type dfs {a n} {lappend t $a $n} 2524 mytree destroy 2525 set t 2526} [list visit {IT::EM 0.1} \ 2527 visit {IT::EM 0} \ 2528 visit {IT::EM 0.2} \ 2529 visit root \ 2530 visit {IT::EM 1.1} \ 2531 visit {IT::EM 1} \ 2532 visit {IT::EM 1.2}] 2533 2534test tree-${impl}-4.4.11.7 {pre dfs walk, nodes with spaces in names} { 2535 tree mytree 2536 set t [list ] 2537 mytree insert root end "node 0" 2538 mytree insert root end "node 1" 2539 mytree insert "node 0" end "node 0 1" 2540 mytree insert "node 0" end "node 0 2" 2541 mytree insert "node 1" end "node 1 1" 2542 mytree insert "node 1" end "node 1 2" 2543 mytree walk root -type dfs {a n} {lappend t $n} 2544 mytree destroy 2545 set t 2546} {root {node 0} {node 0 1} {node 0 2} {node 1} {node 1 1} {node 1 2}} 2547 2548test tree-${impl}-4.4.12.1 {pre bfs walk} { 2549 tree mytree 2550 set t [list ] 2551 mytree insert root end {IT::EM 0} 2552 mytree insert root end {IT::EM 1} 2553 mytree insert {IT::EM 0} end {IT::EM 0.1} 2554 mytree insert {IT::EM 0} end {IT::EM 0.2} 2555 mytree insert {IT::EM 1} end {IT::EM 1.1} 2556 mytree insert {IT::EM 1} end {IT::EM 1.2} 2557 mytree walk root -type bfs {a n} {lappend t $a $n} 2558 mytree destroy 2559 set t 2560} [list enter root \ 2561 enter {IT::EM 0} \ 2562 enter {IT::EM 1} \ 2563 enter {IT::EM 0.1} \ 2564 enter {IT::EM 0.2} \ 2565 enter {IT::EM 1.1} \ 2566 enter {IT::EM 1.2}] 2567 2568test tree-${impl}-4.4.12.2 {post bfs walk} { 2569 tree mytree 2570 set t [list ] 2571 mytree insert root end {IT::EM 0} 2572 mytree insert root end {IT::EM 1} 2573 mytree insert {IT::EM 0} end {IT::EM 0.1} 2574 mytree insert {IT::EM 0} end {IT::EM 0.2} 2575 mytree insert {IT::EM 1} end {IT::EM 1.1} 2576 mytree insert {IT::EM 1} end {IT::EM 1.2} 2577 mytree walk root -type bfs -order post {a n} {lappend t $a $n} 2578 mytree destroy 2579 set t 2580} [list leave {IT::EM 1.2} \ 2581 leave {IT::EM 1.1} \ 2582 leave {IT::EM 0.2} \ 2583 leave {IT::EM 0.1} \ 2584 leave {IT::EM 1} \ 2585 leave {IT::EM 0} \ 2586 leave root] 2587 2588test tree-${impl}-4.4.12.3 {both bfs walk} { 2589 tree mytree 2590 set t [list ] 2591 mytree insert root end {IT::EM 0} 2592 mytree insert root end {IT::EM 1} 2593 mytree insert {IT::EM 0} end {IT::EM 0.1} 2594 mytree insert {IT::EM 0} end {IT::EM 0.2} 2595 mytree insert {IT::EM 1} end {IT::EM 1.1} 2596 mytree insert {IT::EM 1} end {IT::EM 1.2} 2597 mytree walk root -type bfs -order both {a n} {lappend t $a $n} 2598 mytree destroy 2599 set t 2600} [list enter root \ 2601 enter {IT::EM 0} \ 2602 enter {IT::EM 1} \ 2603 enter {IT::EM 0.1} \ 2604 enter {IT::EM 0.2} \ 2605 enter {IT::EM 1.1} \ 2606 enter {IT::EM 1.2} \ 2607 leave {IT::EM 1.2} \ 2608 leave {IT::EM 1.1} \ 2609 leave {IT::EM 0.2} \ 2610 leave {IT::EM 0.1} \ 2611 leave {IT::EM 1} \ 2612 leave {IT::EM 0} \ 2613 leave root] 2614 2615test tree-${impl}-4.4.13 {pre dfs is default walk} { 2616 tree mytree 2617 set t [list ] 2618 mytree insert root end {IT::EM 0} 2619 mytree insert root end {IT::EM 1} 2620 mytree insert {IT::EM 0} end {IT::EM 0.1} 2621 mytree insert {IT::EM 0} end {IT::EM 0.2} 2622 mytree insert {IT::EM 1} end {IT::EM 1.1} 2623 mytree insert {IT::EM 1} end {IT::EM 1.2} 2624 mytree walk root {a n} {lappend t $a $n} 2625 mytree destroy 2626 set t 2627} [list enter root \ 2628 enter {IT::EM 0} \ 2629 enter {IT::EM 0.1} \ 2630 enter {IT::EM 0.2} \ 2631 enter {IT::EM 1} \ 2632 enter {IT::EM 1.1} \ 2633 enter {IT::EM 1.2}] 2634 2635foreach {n type order log} { 2636 0 dfs pre {== enter root enter 0 enter a . enter c enter 1 enter 2 ==} 2637 1 dfs post {== leave a . leave c leave 0 leave 1 leave 2 leave root ==} 2638 2 dfs both {== enter root enter 0 enter a leave a . . enter c leave c leave 0 enter 1 leave 1 enter 2 leave 2 leave root ==} 2639 3 dfs in {== visit a visit 0 . visit c visit root visit 1 visit 2 ==} 2640 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter a . enter c ==} 2641 5 bfs post {== leave c . leave a leave 2 leave 1 leave 0 leave root ==} 2642 6 bfs both {== enter root enter 0 enter 1 enter 2 enter a . enter c leave c . leave a leave 2 leave 1 leave 0 leave root ==} 2643} { 2644 test tree-${impl}-4.4.14.$n "continue in walk $type/$order" { 2645 tree mytree 2646 set t [list ] 2647 mytree insert root end 0 1 2 2648 mytree insert 0 end a b c 2649 lappend t == 2650 mytree walk root -type $type -order $order {a n} { 2651 if {[string equal $n "b"]} {lappend t . ; continue} 2652 lappend t $a $n 2653 } 2654 lappend t == 2655 mytree destroy 2656 set t 2657 } $log 2658} 2659 2660foreach {n type order log} { 2661 0 dfs pre {== enter root enter 0 enter a . ==} 2662 1 dfs post {== leave a . ==} 2663 2 dfs both {== enter root enter 0 enter a leave a . ==} 2664 3 dfs in {== visit a visit 0 . ==} 2665 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a . ==} 2666 5 bfs post {== leave c . ==} 2667 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a . leave c . ==} 2668} { 2669 test tree-${impl}-4.4.15.$n "break in walk $type/$order" { 2670 tree mytree 2671 set t [list ] 2672 mytree insert root end 0 1 2 3 2673 mytree insert 0 end a b c 2674 lappend t == 2675 mytree walk root -type $type -order $order {a n} { 2676 if {[string equal $n "b"]} {lappend t . ; break} 2677 lappend t $a $n 2678 } 2679 lappend t == 2680 mytree destroy 2681 set t 2682 } $log 2683} 2684 2685foreach {n type order log} { 2686 0 dfs pre {== enter root enter 0 enter a . good-return} 2687 1 dfs post {== leave a . good-return} 2688 2 dfs both {== enter root enter 0 enter a leave a . good-return} 2689 3 dfs in {== visit a visit 0 . good-return} 2690 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a . good-return} 2691 5 bfs post {== leave c . good-return} 2692 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a . leave c . good-return} 2693} { 2694 test tree-${impl}-4.4.16.$n "return in walk $type/$order" { 2695 set t [list ] 2696 proc foo {} { 2697 global t type order 2698 tree mytree 2699 mytree insert root end 0 1 2 3 2700 mytree insert 0 end a b c 2701 lappend t == 2702 mytree walk root -type $type -order $order {a n} { 2703 if {[string equal $n "b"]} { 2704 lappend t . 2705 return good-return 2706 } 2707 lappend t $a $n 2708 } 2709 lappend t == 2710 return bad-return 2711 } 2712 lappend t [foo] 2713 mytree destroy 2714 set t 2715 } $log 2716} 2717 2718if {[package vcompare [package provide Tcl] 8.3] < 0} { 2719 # before 8.4 2720 set t4417estack [viewFile tree.testsuite.4417b84.txt] 2721 2722} elseif {[package vcompare [package provide Tcl] 8.4] == 0} { 2723 # 8.4 2724 switch -exact -- $impl { 2725 tcl { 2726 set t4417estack [viewFile [localPath tree.testsuite.4417=84tcl.txt]] 2727 } 2728 critcl { 2729 set t4417estack [viewFile [localPath tree.testsuite.4417a83critcl.txt]] 2730 } 2731 } 2732} else { 2733 # 8.5+ 2734 switch -exact -- $impl { 2735 tcl { 2736 set t4417estack [viewFile [localPath tree.testsuite.4417a84tcl.txt]] 2737 } 2738 critcl { 2739 set t4417estack [viewFile [localPath tree.testsuite.4417a83critcl.txt]] 2740 } 2741 } 2742} 2743 2744test tree-${impl}-4.4.17 {error in walk} { 2745 set t [list ] 2746 proc foo {} { 2747 global t 2748 tree mytree 2749 mytree insert root end 0 1 2 3 2750 mytree insert 0 end a b c 2751 lappend t == 2752 mytree walk root {a n} { 2753 if {[string equal $n "b"]} { 2754 lappend t . 2755 error fubar 2756 } 2757 lappend t $a $n 2758 } 2759 lappend t == 2760 return bad-return 2761 } 2762 catch {lappend t [foo]} result 2763 mytree destroy 2764 list $t $result $::errorInfo 2765} [list {== enter root enter 0 enter a .} fubar $t4417estack] 2766 2767foreach {n type order log} { 2768 0 dfs pre {== enter root enter 0 enter a .} 2769 1 dfs post {== leave a .} 2770 2 dfs both {== enter root enter 0 enter a leave a .} 2771 3 dfs in {== visit a visit 0 .} 2772 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a .} 2773 5 bfs post {== leave c .} 2774 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a .} 2775} { 2776 test tree-${impl}-4.4.17.$n "error in walk $type/$order" { 2777 set t [list ] 2778 proc foo {} { 2779 global t type order 2780 tree mytree 2781 mytree insert root end 0 1 2 3 2782 mytree insert 0 end a b c 2783 lappend t == 2784 mytree walk root -type $type -order $order {a n} { 2785 if {[string equal $n "b"]} { 2786 lappend t . 2787 error fubar 2788 } 2789 lappend t $a $n 2790 } 2791 lappend t == 2792 return bad-return 2793 } 2794 catch {lappend t [foo]} result 2795 mytree destroy 2796 list $t $result 2797 } [list $log fubar] 2798} 2799 2800foreach {n prune type order log} { 2801 0 0 dfs pre {enter 0 enter 1 enter 2 enter 4 enter 5 enter 6 enter 3} 2802 1 1 dfs pre {enter 0 enter 1 enter 2 enter 3} 2803 2 0 dfs both {enter 0 enter 1 leave 1 enter 2 enter 4 leave 4 enter 5 leave 5 enter 6 leave 6 leave 2 enter 3 leave 3 leave 0} 2804 3 1 dfs both {enter 0 enter 1 leave 1 enter 2 leave 2 enter 3 leave 3 leave 0} 2805 4 0 bfs pre {enter 0 enter 1 enter 2 enter 3 enter 4 enter 5 enter 6} 2806 5 1 bfs pre {enter 0 enter 1 enter 2 enter 3} 2807 6 0 bfs both {enter 0 enter 1 enter 2 enter 3 enter 4 enter 5 enter 6 leave 6 leave 5 leave 4 leave 3 leave 2 leave 1 leave 0} 2808 7 1 bfs both {enter 0 enter 1 enter 2 enter 3 leave 3 leave 2 leave 1 leave 0} 2809} { 2810 test tree-${impl}-4.5.$n {pruning} { 2811 # (0 (1 2 (4 5 6) 3)) 2812 tree mytree deserialize {0 {} {} 1 0 {} 2 0 {} 4 6 {} 5 6 {} 6 6 {} 3 0 {}} 2813 set t {} 2814 mytree walk 0 -type $type -order $order {a n} { 2815 lappend t $a $n 2816 if {$prune && ($n == 2)} {struct::tree::prune} 2817 } 2818 mytree destroy 2819 set t 2820 } $log ;# {} 2821} 2822 2823foreach {n type order} { 2824 8 dfs post 2825 9 bfs post 2826 10 dfs in 2827} { 2828 test tree-${impl}-4.5.$n {prune errors} { 2829 # (0 (1 2 (4 5))) 2830 tree mytree deserialize {0 {} {} 1 0 {} 2 0 {} 4 6 {} 5 6 {}} 2831 set t {} 2832 catch { 2833 mytree walk 0 -type $type -order $order {a n} { 2834 lappend t $a $n 2835 if {($n == 2)} {struct::tree::prune} 2836 } 2837 } res ; # {} 2838 mytree destroy 2839 set res 2840 } "Illegal attempt to prune ${order}-order walking" ;# {} 2841} 2842 2843 2844test tree-${impl}-4.6.1 {walkproc with too few args} {badTest} { 2845 tree mytree 2846 catch {mytree walkproc} msg 2847 mytree destroy 2848 set msg 2849} {no value given for parameter "node" to "::struct::tree::_walkproc"} 2850 2851test tree-${impl}-4.6.2 {walkproc with too few args} { 2852 tree mytree 2853 catch {mytree walkproc root} msg 2854 mytree destroy 2855 set msg 2856} "wrong # args: should be \"$MY walkproc node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? cmdprefix\"" 2857 2858test tree-${impl}-4.6.3 {walkproc with too many args} { 2859 tree mytree 2860 catch {mytree walkproc root -foo bar -baz boo -foo2 boo -foo3 baz -foo4 gnar -foo5 schnurr} msg 2861 mytree destroy 2862 set msg 2863} "wrong # args: should be \"$MY walkproc node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? cmdprefix\"" 2864 2865test tree-${impl}-4.6.4 {walkproc with fake node} { 2866 tree mytree 2867 catch {mytree walkproc {IT::EM 0} foo} msg 2868 mytree destroy 2869 set msg 2870} "node \"IT::EM 0\" does not exist in tree \"$MY\"" 2871 2872test tree-${impl}-4.6.5 {walkproc gives error on invalid search type} { 2873 tree mytree 2874 catch {mytree walkproc root -type foo foo} msg 2875 mytree destroy 2876 set msg 2877} {bad search type "foo": must be bfs or dfs} 2878 2879test tree-${impl}-4.6.6 {walkproc gives error on invalid search order} { 2880 tree mytree 2881 catch {mytree walkproc root -order foo foo} msg 2882 mytree destroy 2883 set msg 2884} {bad search order "foo": must be both, in, pre, or post} 2885 2886test tree-${impl}-4.6.7 {walkproc gives error on invalid combination of order and type} { 2887 tree mytree 2888 catch {mytree walkproc root -order in -type bfs foo} msg 2889 mytree destroy 2890 set msg 2891} {unable to do a in-order breadth first walk} 2892 2893test tree-${impl}-4.6.8 {walkproc with unknown options} { 2894 tree mytree 2895 catch {mytree walkproc root -foo bar foo} msg 2896 mytree destroy 2897 set msg 2898} {unknown option "-foo"} 2899 2900test tree-${impl}-4.6.9 {walkproc, option without value} { 2901 tree mytree 2902 catch {mytree walkproc root -type dfs -order} msg 2903 mytree destroy 2904 set msg 2905} {value for "-order" missing} 2906 2907test tree-${impl}-4.6.10 {walkproc without command} { 2908 tree mytree 2909 catch {mytree walkproc root -order pre} msg 2910 mytree destroy 2911 set msg 2912} "wrong # args: should be \"$MY walkproc node ?-type {bfs|dfs}? ?-order {pre|post|in|both}? ?--? cmdprefix\"" 2913 2914test tree-${impl}-4.6.10.1 {walkproc with empty command} { 2915 tree mytree 2916 catch {mytree walkproc root -order pre {}} msg 2917 mytree destroy 2918 set msg 2919} {no script specified, or empty} 2920 2921test tree-${impl}-4.6.10.2 {walkproc, cmdprefix is not a list} { 2922 tree mytree 2923 catch {mytree walkproc root -order pre "\{"} msg 2924 mytree destroy 2925 set msg 2926} {unmatched open brace in list} 2927 2928test tree-${impl}-4.6.10.3 {walkproc with unknown command} { 2929 tree mytree 2930 catch {mytree walkproc root -order pre ::bogus} msg 2931 mytree destroy 2932 set msg 2933} {invalid command name "::bogus"} 2934 2935test tree-${impl}-4.6.11.1 {pre dfs walk} { 2936 tree mytree 2937 set t [list ] 2938 mytree insert root end {IT::EM 0} 2939 mytree insert root end {IT::EM 1} 2940 mytree insert {IT::EM 0} end {IT::EM 0.1} 2941 mytree insert {IT::EM 0} end {IT::EM 0.2} 2942 mytree insert {IT::EM 1} end {IT::EM 1.1} 2943 mytree insert {IT::EM 1} end {IT::EM 1.2} 2944 mytree walkproc root -type dfs pwalker 2945 mytree destroy 2946 set t 2947} [list enter root \ 2948 enter {IT::EM 0} \ 2949 enter {IT::EM 0.1} \ 2950 enter {IT::EM 0.2} \ 2951 enter {IT::EM 1} \ 2952 enter {IT::EM 1.1} \ 2953 enter {IT::EM 1.2}] 2954 2955test tree-${impl}-4.6.11.2 {post dfs walk} { 2956 tree mytree 2957 set t [list ] 2958 mytree insert root end {IT::EM 0} 2959 mytree insert root end {IT::EM 1} 2960 mytree insert {IT::EM 0} end {IT::EM 0.1} 2961 mytree insert {IT::EM 0} end {IT::EM 0.2} 2962 mytree insert {IT::EM 1} end {IT::EM 1.1} 2963 mytree insert {IT::EM 1} end {IT::EM 1.2} 2964 mytree walkproc root -order post -type dfs pwalker 2965 mytree destroy 2966 set t 2967} [list leave {IT::EM 0.1} \ 2968 leave {IT::EM 0.2} \ 2969 leave {IT::EM 0} \ 2970 leave {IT::EM 1.1} \ 2971 leave {IT::EM 1.2} \ 2972 leave {IT::EM 1} \ 2973 leave root] 2974 2975test tree-${impl}-4.6.11.3 {both dfs walk} { 2976 tree mytree 2977 set t [list ] 2978 mytree insert root end {IT::EM 0} 2979 mytree insert root end {IT::EM 1} 2980 mytree insert {IT::EM 0} end {IT::EM 0.1} 2981 mytree insert {IT::EM 0} end {IT::EM 0.2} 2982 mytree insert {IT::EM 1} end {IT::EM 1.1} 2983 mytree insert {IT::EM 1} end {IT::EM 1.2} 2984 mytree walkproc root -order both -type dfs pwalker 2985 mytree destroy 2986 set t 2987} [list enter root \ 2988 enter {IT::EM 0} \ 2989 enter {IT::EM 0.1} \ 2990 leave {IT::EM 0.1} \ 2991 enter {IT::EM 0.2} \ 2992 leave {IT::EM 0.2} \ 2993 leave {IT::EM 0} \ 2994 enter {IT::EM 1} \ 2995 enter {IT::EM 1.1} \ 2996 leave {IT::EM 1.1} \ 2997 enter {IT::EM 1.2} \ 2998 leave {IT::EM 1.2} \ 2999 leave {IT::EM 1} \ 3000 leave root] 3001 3002test tree-${impl}-4.6.11.4 {in dfs walk} { 3003 tree mytree 3004 set t [list ] 3005 mytree insert root end {IT::EM 0} 3006 mytree insert root end {IT::EM 1} 3007 mytree insert {IT::EM 0} end {IT::EM 0.1} 3008 mytree insert {IT::EM 0} end {IT::EM 0.2} 3009 mytree insert {IT::EM 1} end {IT::EM 1.1} 3010 mytree insert {IT::EM 1} end {IT::EM 1.2} 3011 mytree walkproc root -order in -type dfs pwalker 3012 mytree destroy 3013 set t 3014} [list visit {IT::EM 0.1} \ 3015 visit {IT::EM 0} \ 3016 visit {IT::EM 0.2} \ 3017 visit root \ 3018 visit {IT::EM 1.1} \ 3019 visit {IT::EM 1} \ 3020 visit {IT::EM 1.2}] 3021 3022test tree-${impl}-4.6.11.7 {pre dfs walk, nodes with spaces in names} { 3023 tree mytree 3024 set t [list ] 3025 mytree insert root end "node 0" 3026 mytree insert root end "node 1" 3027 mytree insert "node 0" end "node 0 1" 3028 mytree insert "node 0" end "node 0 2" 3029 mytree insert "node 1" end "node 1 1" 3030 mytree insert "node 1" end "node 1 2" 3031 mytree walkproc root -type dfs pwalkern 3032 mytree destroy 3033 set t 3034} {root {node 0} {node 0 1} {node 0 2} {node 1} {node 1 1} {node 1 2}} 3035 3036test tree-${impl}-4.6.12.1 {pre bfs walk} { 3037 tree mytree 3038 set t [list ] 3039 mytree insert root end {IT::EM 0} 3040 mytree insert root end {IT::EM 1} 3041 mytree insert {IT::EM 0} end {IT::EM 0.1} 3042 mytree insert {IT::EM 0} end {IT::EM 0.2} 3043 mytree insert {IT::EM 1} end {IT::EM 1.1} 3044 mytree insert {IT::EM 1} end {IT::EM 1.2} 3045 mytree walkproc root -type bfs pwalker 3046 mytree destroy 3047 set t 3048} [list enter root \ 3049 enter {IT::EM 0} \ 3050 enter {IT::EM 1} \ 3051 enter {IT::EM 0.1} \ 3052 enter {IT::EM 0.2} \ 3053 enter {IT::EM 1.1} \ 3054 enter {IT::EM 1.2}] 3055 3056test tree-${impl}-4.6.12.2 {post bfs walk} { 3057 tree mytree 3058 set t [list ] 3059 mytree insert root end {IT::EM 0} 3060 mytree insert root end {IT::EM 1} 3061 mytree insert {IT::EM 0} end {IT::EM 0.1} 3062 mytree insert {IT::EM 0} end {IT::EM 0.2} 3063 mytree insert {IT::EM 1} end {IT::EM 1.1} 3064 mytree insert {IT::EM 1} end {IT::EM 1.2} 3065 mytree walkproc root -type bfs -order post pwalker 3066 mytree destroy 3067 set t 3068} [list leave {IT::EM 1.2} \ 3069 leave {IT::EM 1.1} \ 3070 leave {IT::EM 0.2} \ 3071 leave {IT::EM 0.1} \ 3072 leave {IT::EM 1} \ 3073 leave {IT::EM 0} \ 3074 leave root] 3075 3076test tree-${impl}-4.6.12.3 {both bfs walk} { 3077 tree mytree 3078 set t [list ] 3079 mytree insert root end {IT::EM 0} 3080 mytree insert root end {IT::EM 1} 3081 mytree insert {IT::EM 0} end {IT::EM 0.1} 3082 mytree insert {IT::EM 0} end {IT::EM 0.2} 3083 mytree insert {IT::EM 1} end {IT::EM 1.1} 3084 mytree insert {IT::EM 1} end {IT::EM 1.2} 3085 mytree walkproc root -type bfs -order both pwalker 3086 mytree destroy 3087 set t 3088} [list enter root \ 3089 enter {IT::EM 0} \ 3090 enter {IT::EM 1} \ 3091 enter {IT::EM 0.1} \ 3092 enter {IT::EM 0.2} \ 3093 enter {IT::EM 1.1} \ 3094 enter {IT::EM 1.2} \ 3095 leave {IT::EM 1.2} \ 3096 leave {IT::EM 1.1} \ 3097 leave {IT::EM 0.2} \ 3098 leave {IT::EM 0.1} \ 3099 leave {IT::EM 1} \ 3100 leave {IT::EM 0} \ 3101 leave root] 3102 3103test tree-${impl}-4.6.13 {pre dfs is default walk} { 3104 tree mytree 3105 set t [list ] 3106 mytree insert root end {IT::EM 0} 3107 mytree insert root end {IT::EM 1} 3108 mytree insert {IT::EM 0} end {IT::EM 0.1} 3109 mytree insert {IT::EM 0} end {IT::EM 0.2} 3110 mytree insert {IT::EM 1} end {IT::EM 1.1} 3111 mytree insert {IT::EM 1} end {IT::EM 1.2} 3112 mytree walkproc root pwalker 3113 mytree destroy 3114 set t 3115} [list enter root \ 3116 enter {IT::EM 0} \ 3117 enter {IT::EM 0.1} \ 3118 enter {IT::EM 0.2} \ 3119 enter {IT::EM 1} \ 3120 enter {IT::EM 1.1} \ 3121 enter {IT::EM 1.2}] 3122 3123foreach {n type order log} { 3124 0 dfs pre {== enter root enter 0 enter a . enter c enter 1 enter 2 ==} 3125 1 dfs post {== leave a . leave c leave 0 leave 1 leave 2 leave root ==} 3126 2 dfs both {== enter root enter 0 enter a leave a . . enter c leave c leave 0 enter 1 leave 1 enter 2 leave 2 leave root ==} 3127 3 dfs in {== visit a visit 0 . visit c visit root visit 1 visit 2 ==} 3128 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter a . enter c ==} 3129 5 bfs post {== leave c . leave a leave 2 leave 1 leave 0 leave root ==} 3130 6 bfs both {== enter root enter 0 enter 1 enter 2 enter a . enter c leave c . leave a leave 2 leave 1 leave 0 leave root ==} 3131} { 3132 test tree-${impl}-4.6.14.$n "continue in walk $type/$order" { 3133 tree mytree 3134 set t [list ] 3135 mytree insert root end 0 1 2 3136 mytree insert 0 end a b c 3137 lappend t == 3138 mytree walkproc root -type $type -order $order pwalkercont 3139 lappend t == 3140 mytree destroy 3141 set t 3142 } $log 3143} 3144 3145foreach {n type order log} { 3146 0 dfs pre {== enter root enter 0 enter a . ==} 3147 1 dfs post {== leave a . ==} 3148 2 dfs both {== enter root enter 0 enter a leave a . ==} 3149 3 dfs in {== visit a visit 0 . ==} 3150 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a . ==} 3151 5 bfs post {== leave c . ==} 3152 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a . leave c . ==} 3153} { 3154 test tree-${impl}-4.6.15.$n "break in walk $type/$order" { 3155 tree mytree 3156 set t [list ] 3157 mytree insert root end 0 1 2 3 3158 mytree insert 0 end a b c 3159 lappend t == 3160 mytree walkproc root -type $type -order $order pwalkerbreak 3161 lappend t == 3162 mytree destroy 3163 set t 3164 } $log 3165} 3166 3167foreach {n type order log} { 3168 0 dfs pre {== enter root enter 0 enter a . good-return} 3169 1 dfs post {== leave a . good-return} 3170 2 dfs both {== enter root enter 0 enter a leave a . good-return} 3171 3 dfs in {== visit a visit 0 . good-return} 3172 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a . good-return} 3173 5 bfs post {== leave c . good-return} 3174 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a . leave c . good-return} 3175} { 3176 test tree-${impl}-4.6.16.$n "return in walk $type/$order" { 3177 set t [list ] 3178 proc foo {} { 3179 global t type order 3180 tree mytree 3181 mytree insert root end 0 1 2 3 3182 mytree insert 0 end a b c 3183 lappend t == 3184 mytree walkproc root -type $type -order $order pwalkerret 3185 lappend t == 3186 return bad-return 3187 } 3188 lappend t [foo] 3189 mytree destroy 3190 set t 3191 } $log 3192} 3193 3194switch -exact -- $impl { 3195 tcl { 3196 set t4617estack {fubar 3197 while executing 3198"error fubar" 3199 (procedure "pwalkererr" line 4) 3200 invoked from within 3201"pwalkererr ::mytree b enter" 3202 ("WalkCallProc" body line 1) 3203 invoked from within 3204"WalkCallProc $name $node "enter" $script" 3205 (procedure "::struct::tree::_walkproc" line 79) 3206 invoked from within 3207"::struct::tree::_walkproc ::mytree root pwalkererr" 3208 ("_walkproc" body line 1) 3209 invoked from within 3210"mytree walkproc root pwalkererr" 3211 (procedure "foo" line 7) 3212 invoked from within 3213"foo"} 3214} 3215 critcl { 3216 set t4617estack {fubar 3217 while executing 3218"error fubar" 3219 (procedure "pwalkererr" line 4) 3220 invoked from within 3221"pwalkererr mytree b enter" 3222 invoked from within 3223"mytree walkproc root pwalkererr" 3224 (procedure "foo" line 7) 3225 invoked from within 3226"foo"} 3227} 3228} 3229 3230test tree-${impl}-4.6.17 {error in walk} { 3231 set t [list ] 3232 proc foo {} { 3233 global t 3234 tree mytree 3235 mytree insert root end 0 1 2 3 3236 mytree insert 0 end a b c 3237 lappend t == 3238 mytree walkproc root pwalkererr 3239 lappend t == 3240 return bad-return 3241 } 3242 catch {lappend t [foo]} result 3243 mytree destroy 3244 list $t $result $::errorInfo 3245} [list {== enter root enter 0 enter a .} fubar $t4617estack] 3246 3247foreach {n type order log} { 3248 0 dfs pre {== enter root enter 0 enter a .} 3249 1 dfs post {== leave a .} 3250 2 dfs both {== enter root enter 0 enter a leave a .} 3251 3 dfs in {== visit a visit 0 .} 3252 4 bfs pre {== enter root enter 0 enter 1 enter 2 enter 3 enter a .} 3253 5 bfs post {== leave c .} 3254 6 bfs both {== enter root enter 0 enter 1 enter 2 enter 3 enter a .} 3255} { 3256 test tree-${impl}-4.6.17.$n "error in walk $type/$order" { 3257 set t [list ] 3258 proc foo {} { 3259 global t type order 3260 tree mytree 3261 mytree insert root end 0 1 2 3 3262 mytree insert 0 end a b c 3263 lappend t == 3264 mytree walkproc root -type $type -order $order pwalkererr 3265 lappend t == 3266 return bad-return 3267 } 3268 catch {lappend t [foo]} result 3269 mytree destroy 3270 list $t $result 3271 } [list $log fubar] 3272} 3273 3274foreach {n prune type order log} { 3275 0 0 dfs pre {enter 0 enter 1 enter 2 enter 4 enter 5 enter 6 enter 3} 3276 1 1 dfs pre {enter 0 enter 1 enter 2 enter 3} 3277 2 0 dfs both {enter 0 enter 1 leave 1 enter 2 enter 4 leave 4 enter 5 leave 5 enter 6 leave 6 leave 2 enter 3 leave 3 leave 0} 3278 3 1 dfs both {enter 0 enter 1 leave 1 enter 2 leave 2 enter 3 leave 3 leave 0} 3279 4 0 bfs pre {enter 0 enter 1 enter 2 enter 3 enter 4 enter 5 enter 6} 3280 5 1 bfs pre {enter 0 enter 1 enter 2 enter 3} 3281 6 0 bfs both {enter 0 enter 1 enter 2 enter 3 enter 4 enter 5 enter 6 leave 6 leave 5 leave 4 leave 3 leave 2 leave 1 leave 0} 3282 7 1 bfs both {enter 0 enter 1 enter 2 enter 3 leave 3 leave 2 leave 1 leave 0} 3283} { 3284 test tree-${impl}-4.7.$n {pruning} { 3285 # (0 (1 2 (4 5 6) 3)) 3286 tree mytree deserialize {0 {} {} 1 0 {} 2 0 {} 4 6 {} 5 6 {} 6 6 {} 3 0 {}} 3287 set t {} 3288 mytree walkproc 0 -type $type -order $order pwalkerprune 3289 mytree destroy 3290 set t 3291 } $log ;# {} 3292} 3293 3294foreach {n type order} { 3295 8 dfs post 3296 9 bfs post 3297 10 dfs in 3298} { 3299 test tree-${impl}-4.7.$n {prune errors} { 3300 # (0 (1 2 (4 5))) 3301 tree mytree deserialize {0 {} {} 1 0 {} 2 0 {} 4 6 {} 5 6 {}} 3302 set t {} 3303 catch { 3304 mytree walkproc 0 -type $type -order $order pwalkerpruneb 3305 } res ; # {} 3306 mytree destroy 3307 set res 3308 } "Illegal attempt to prune ${order}-order walking" ;# {} 3309} 3310 3311############################################################ 3312# V. Objects to values and back ... 3313# - serialize deserialize = --> 3314############################################################ 3315 3316############################################################ 3317 3318test tree-${impl}-5.1.1 {serialization, wrong #args} { 3319 tree mytree 3320 catch {mytree serialize foo bar} result 3321 mytree destroy 3322 set result 3323} "wrong # args: should be \"$MY serialize ?node?\"" 3324 3325test tree-${impl}-5.1.2 {serialization, bogus node} { 3326 tree mytree 3327 catch {mytree serialize foo} result 3328 mytree destroy 3329 set result 3330} "node \"foo\" does not exist in tree \"$MY\"" 3331 3332test tree-${impl}-5.1.3 {serialization} { 3333 tree mytree 3334 mytree insert root end %0 3335 mytree insert root end %1 3336 mytree insert root end %2 3337 mytree insert %0 end %3 3338 mytree insert %0 end %4 3339 3340 set serial [mytree serialize] 3341 set result [validate_serial mytree $serial] 3342 mytree destroy 3343 set result 3344 # {{root {} %0 0 %3 2 %4 2 %1 0 %2 0} {}} 3345} ok 3346 3347test tree-${impl}-5.1.4 {serialization} { 3348 tree mytree 3349 mytree insert root end %0 3350 mytree insert root end %1 3351 mytree insert root end %2 3352 mytree insert %0 end %3 3353 mytree insert %0 end %4 3354 mytree set %4 foo far 3355 3356 set serial [mytree serialize %0] 3357 set result [validate_serial mytree $serial %0] 3358 mytree destroy 3359 set result 3360 # {%0 {} {} %3 0 {} %4 0 {foo far data {}}} 3361} ok 3362 3363test tree-${impl}-5.1.5 {serialization, empty tree} { 3364 tree mytree 3365 set serial [mytree serialize] 3366 set result [validate_serial mytree $serial] 3367 mytree destroy 3368 set result 3369 # serial = {root {} {}} 3370} ok 3371 3372############################################################ 3373 3374test tree-${impl}-5.2.1 {deserialization, wrong #args} { 3375 tree mytree 3376 catch {mytree deserialize foo bar} result 3377 mytree destroy 3378 set result 3379} [tmTooMany deserialize {serial}] 3380 3381test tree-${impl}-5.2.2 {deserialization} { 3382 tree mytree 3383 set serial {. %0 {} {} %3 0 {} %4 0 {foo far data {}}} 3384 set fail [catch {mytree deserialize $serial} result] 3385 mytree destroy 3386 list $fail $result 3387} {1 {error in serialization: list length not a multiple of 3.}} 3388 3389test tree-${impl}-5.2.3 {deserialization} { 3390 tree mytree 3391 set serial {%3 {} {} %4 0 {foo far . data {}}} 3392 set fail [catch {mytree deserialize $serial} result] 3393 mytree destroy 3394 list $fail $result 3395} {1 {error in serialization: malformed attribute dictionary.}} 3396 3397test tree-${impl}-5.2.4 {deserialization} { 3398 tree mytree 3399 set serial {%3 -1 {} %4 {} {foo far data {}}} 3400 set fail [catch {mytree deserialize $serial} result] 3401 mytree destroy 3402 list $fail $result 3403} {1 {error in serialization: bad parent reference "-1".}} 3404 3405test tree-${impl}-5.2.5 {deserialization} { 3406 tree mytree 3407 set serial {%3 .. {} %4 {} {foo far data {}}} 3408 set fail [catch {mytree deserialize $serial} result] 3409 mytree destroy 3410 list $fail $result 3411} {1 {error in serialization: bad parent reference "..".}} 3412 3413test tree-${impl}-5.2.6 {deserialization} { 3414 tree mytree 3415 set serial {%3 .. {} %4 {} {foo far data {}}} 3416 set fail [catch {mytree deserialize $serial} result] 3417 mytree destroy 3418 list $fail $result 3419} {1 {error in serialization: bad parent reference "..".}} 3420 3421test tree-${impl}-5.2.7 {deserialization} { 3422 tree mytree 3423 set serial {%3 1 {} %4 {} {foo far data {}}} 3424 set fail [catch {mytree deserialize $serial} result] 3425 mytree destroy 3426 list $fail $result 3427} {1 {error in serialization: bad parent reference "1".}} 3428 3429test tree-${impl}-5.2.8 {deserialization} { 3430 tree mytree 3431 set serial {%3 2 {} %4 {} {foo far data {}}} 3432 set fail [catch {mytree deserialize $serial} result] 3433 mytree destroy 3434 list $fail $result 3435} {1 {error in serialization: bad parent reference "2".}} 3436 3437test tree-${impl}-5.2.9 {deserialization} { 3438 tree mytree 3439 set serial {%3 8 {} %4 {} {foo far data {}}} 3440 set fail [catch {mytree deserialize $serial} result] 3441 mytree destroy 3442 list $fail $result 3443} {1 {error in serialization: bad parent reference "8".}} 3444 3445test tree-${impl}-5.2.10 {deserialization} { 3446 tree mytree 3447 set serial {%3 6 {} %4 {} {foo far data {}}} 3448 set fail [catch {mytree deserialize $serial} result] 3449 mytree destroy 3450 list $fail $result 3451} {1 {error in serialization: bad parent reference "6".}} 3452 3453test tree-${impl}-5.2.11 {deserialization} { 3454 tree mytree 3455 set serial {%3 3 {} %4 0 {}} 3456 set fail [catch {mytree deserialize $serial} result] 3457 mytree destroy 3458 list $fail $result 3459} {1 {error in serialization: no root specified.}} 3460 3461test tree-${impl}-5.2.12 {deserialization} { 3462 tree mytree 3463 set serial {%3 {} {} %4 {} {} %x 0 {}} 3464 set fail [catch {mytree deserialize $serial} result] 3465 mytree destroy 3466 list $fail $result 3467} {1 {error in serialization: multiple root nodes.}} 3468 3469test tree-${impl}-5.2.13 {deserialization} { 3470 tree mytree 3471 set serial {%3 3 {} %3 {} {} %x 0 {}} 3472 set fail [catch {mytree deserialize $serial} result] 3473 mytree destroy 3474 list $fail $result 3475} {1 {error in serialization: duplicate node names.}} 3476 3477test tree-${impl}-5.2.14 {deserialization} { 3478 tree mytree 3479 set serial {%3 0 {} %4 {} {} %x 0 {}} 3480 set fail [catch {mytree deserialize $serial} result] 3481 mytree destroy 3482 list $fail $result 3483} {1 {error in serialization: cycle detected.}} 3484 3485test tree-${impl}-5.2.15 {deserialization} { 3486 tree mytree 3487 set serial {%3 3 {} %4 0 {} %x {} {}} 3488 set fail [catch {mytree deserialize $serial} result] 3489 mytree destroy 3490 list $fail $result 3491} {1 {error in serialization: cycle detected.}} 3492 3493test tree-${impl}-5.2.16 {deserialization} { 3494 tree mytree 3495 3496 # Our check of the success of the deserialization 3497 # is to validate the generated tree against the 3498 # serialized data. 3499 3500 set serial {%0 {} {} %3 0 {} %4 0 {foo far data {}}} 3501 3502 set result [list] 3503 lappend result [validate_serial mytree $serial] 3504 3505 mytree deserialize $serial 3506 lappend result [validate_serial mytree $serial] 3507 lappend result [mytree rootname] 3508 3509 mytree destroy 3510 set result 3511} {node/%0/unknown ok %0} 3512 3513test tree-${impl}-5.2.17 {deserialization} { 3514 tree mytree 3515 3516 # Our check of the success of the deserialization 3517 # is to validate the generated tree against the 3518 # serialized data. 3519 3520 # Applying to serialization one after the 3521 # other. Checking that the second operation 3522 # completely squashes the data from the first. 3523 3524 set seriala {root {} {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3525 set serialb {%0 {} {} %3 0 {} %4 0 {foo far data {}}} 3526 3527 set result [list] 3528 lappend result [validate_serial mytree $seriala] 3529 lappend result [validate_serial mytree $serialb] 3530 lappend result [mytree rootname] 3531 3532 mytree deserialize $seriala 3533 lappend result [validate_serial mytree $seriala] 3534 lappend result [validate_serial mytree $serialb] 3535 lappend result [mytree rootname] 3536 3537 mytree deserialize $serialb 3538 lappend result [validate_serial mytree $seriala] 3539 lappend result [validate_serial mytree $serialb] 3540 lappend result [mytree rootname] 3541 3542 mytree destroy 3543 set result 3544} [list node/%0/unknown node/%0/unknown root \ 3545 ok attr/%4/mismatch root \ 3546 node/root/unknown ok %0] 3547 3548test tree-${impl}-5.2.18 {deserialization, empty tree} { 3549 tree mytree 3550 set serial {root {} {}} 3551 mytree deserialize $serial 3552 set result [validate_serial mytree $serial] 3553 mytree destroy 3554 set result 3555} ok 3556 3557test tree-${impl}-5.2.19 {deserialization, not a list} { 3558 tree mytree 3559 catch {mytree deserialize "\{"} result 3560 mytree destroy 3561 set result 3562} {unmatched open brace in list} 3563 3564############################################################ 3565 3566test tree-${impl}-5.3.1 {tree assignment} { 3567 tree mytree 3568 catch {mytree = foo bar} result 3569 mytree destroy 3570 set result 3571} [tmTooMany = {source}] 3572 3573test tree-${impl}-5.3.2 {tree assignment} { 3574 set serial {root {} {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3575 3576 tree mytree 3577 tree btree 3578 3579 mytree deserialize $serial 3580 3581 set result [validate_serial btree $serial] 3582 btree = mytree 3583 lappend result [validate_serial btree $serial] 3584 3585 mytree destroy 3586 btree destroy 3587 set result 3588} {node/%0/unknown ok} 3589 3590test tree-${impl}-5.3.3 {tree assignment, bogus cmd} { 3591 tree mytree 3592 catch {mytree = "\{"} result 3593 mytree destroy 3594 set result 3595} "invalid command name \"\{\"" 3596 3597test tree-${impl}-5.3.4 {tree assignment, unknown command} { 3598 tree mytree 3599 catch {mytree = ::bogus} result 3600 mytree destroy 3601 set result 3602} {invalid command name "::bogus"} 3603 3604############################################################ 3605 3606test tree-${impl}-5.4.1 {reverse tree assignment} { 3607 tree mytree 3608 catch {mytree --> foo bar} result 3609 mytree destroy 3610 set result 3611} [tmTooMany --> {dest}] 3612 3613test tree-${impl}-5.4.2 {reverse tree assignment} { 3614 3615 set serial {root {} {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3616 3617 tree mytree 3618 tree btree 3619 3620 mytree deserialize $serial 3621 3622 set result [validate_serial btree $serial] 3623 mytree --> btree 3624 lappend result [validate_serial btree $serial] 3625 3626 mytree destroy 3627 btree destroy 3628 set result 3629} {node/%0/unknown ok} 3630 3631test tree-${impl}-5.4.3 {reverse tree assignment, bogus cmd} { 3632 tree mytree 3633 catch {mytree --> "\{"} result 3634 mytree destroy 3635 set result 3636} "invalid command name \"\{\"" 3637 3638test tree-${impl}-5.4.4 {reverse tree assignment, unknown command} { 3639 tree mytree 3640 catch {mytree --> ::bogus} result 3641 mytree destroy 3642 set result 3643} {invalid command name "::bogus"} 3644 3645############################################################ 3646 3647test tree-${impl}-5.5.1 {copy construction, wrong # args} { 3648 catch {tree mytree = a b} result 3649 set result 3650} {wrong # args: should be "tree ?name ?=|:=|as|deserialize source??"} 3651 3652test tree-${impl}-5.5.2 {copy construction, unknown operator} { 3653 catch {tree mytree foo a} result 3654 set result 3655} {wrong # args: should be "tree ?name ?=|:=|as|deserialize source??"} 3656 3657test tree-${impl}-5.5.3 {copy construction, value} { 3658 set serial {root {} {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3659 3660 tree mytree deserialize $serial 3661 set result [validate_serial mytree $serial] 3662 mytree destroy 3663 3664 set result 3665} ok 3666 3667test tree-${impl}-5.5.4 {copy construction, tree} { 3668 set serial {root {} {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3669 3670 tree mytree deserialize $serial 3671 tree btree = mytree 3672 3673 set result [validate_serial btree $serial] 3674 mytree destroy 3675 btree destroy 3676 3677 set result 3678} ok 3679 3680test tree-${impl}-5.5.5 {copy construction, unknown command} { 3681 catch {tree mytree = ::bogus} msg 3682 catch {mytree destroy} res 3683 list $msg $res 3684} {{invalid command name "::bogus"} {invalid command name "mytree"}} 3685 3686test tree-${impl}-5.5.6 {copy construction, bad value} { 3687 set serial {root 6 {} %0 0 {} %3 3 {} %4 3 {} %1 0 {} %2 0 {}} 3688 3689 catch {tree mytree deserialize $serial} msg 3690 catch {mytree destroy} res 3691 list $msg $res 3692} {{error in serialization: no root specified.} {invalid command name "mytree"}} 3693 3694############################################################ 3695 3696proc gentree {t} { 3697 tree $t 3698 $t insert root end 0 ; $t set 0 volume 30 3699 $t insert root end 1 3700 $t insert root end 2 3701 $t insert 0 end 3 3702 $t insert 0 end 4 3703 $t insert 4 end 5 ; $t set 5 volume 50 3704 $t insert 4 end 6 3705} 3706 3707test tree-${impl}-6.0 {attribute search} { 3708 gentree mytree 3709 catch {mytree attr} msg 3710 mytree destroy 3711 set msg 3712} [tmWrong attr {key ?-nodes list|-glob pattern|-regexp pattern?} 0 {key args}] 3713 3714test tree-${impl}-6.1 {attribute search} { 3715 gentree mytree 3716 catch {mytree attr a b} msg 3717 mytree destroy 3718 set msg 3719} "wrong # args: should be \"$MY attr key ?-nodes list|-glob pattern|-regexp pattern?\"" 3720 3721test tree-${impl}-6.2 {attribute search} { 3722 gentree mytree 3723 catch {mytree attr a b c d} msg 3724 mytree destroy 3725 set msg 3726} "wrong # args: should be \"$MY attr key ?-nodes list|-glob pattern|-regexp pattern?\"" 3727 3728test tree-${impl}-6.3 {attribute search} { 3729 gentree mytree 3730 catch {mytree attr a b c} msg 3731 mytree destroy 3732 set msg 3733} "wrong # args: should be \"$MY attr key ?-nodes list|-glob pattern|-regexp pattern?\"" 3734 3735test tree-${impl}-6.4 {attribute search} { 3736 gentree mytree 3737 set result [mytree attr vol] 3738 mytree destroy 3739 set result 3740} {} 3741 3742test tree-${impl}-6.5 {attribute search} { 3743 gentree mytree 3744 set result [dictsort [mytree attr volume]] 3745 mytree destroy 3746 set result 3747} {0 30 5 50} 3748 3749test tree-${impl}-6.6 {attribute search} { 3750 gentree mytree 3751 set result [mytree attr volume -nodes {0 3}] 3752 mytree destroy 3753 set result 3754} {0 30} 3755 3756test tree-${impl}-6.7 {attribute search} { 3757 gentree mytree 3758 set result [mytree attr volume -glob {[0-3]}] 3759 mytree destroy 3760 set result 3761} {0 30} 3762 3763test tree-${impl}-6.8 {attribute search} { 3764 gentree mytree 3765 set result [mytree attr volume -regexp {[0-3]}] 3766 mytree destroy 3767 set result 3768} {0 30} 3769 3770test tree-${impl}-6.9 {attribute search} { 3771 gentree mytree 3772 set result [mytree attr volume -nodes {}] 3773 mytree destroy 3774 set result 3775} {} 3776 3777test tree-${impl}-6.10 {attribute search} { 3778 gentree mytree 3779 mytree unset 0 volume 3780 mytree unset 5 volume 3781 set result [mytree attr volume] 3782 mytree destroy 3783 set result 3784} {} 3785 3786test tree-${impl}-6.11 {attribute search, duplicates} { 3787 gentree mytree 3788 set result [mytree attr volume -nodes {0 3 0}] 3789 mytree destroy 3790 set result 3791} {0 30 0 30} 3792 3793test tree-${impl}-6.12 {attribute search, duplicates beyond tree size} { 3794 gentree mytree 3795 set result [mytree attr volume -nodes {0 3 0 5 0 5 0 5 0 5 0 5}] 3796 mytree destroy 3797 set result 3798} {0 30 0 30 5 50 0 30 5 50 0 30 5 50 0 30 5 50 0 30 5 50} 3799 3800############################################################ 3801 3802# deserialization, and the creation of new nodes with automatic names. 3803 3804test tree-${impl}-7.0 {deserialization & automatic node names} { 3805 tree mytree 3806 mytree deserialize {root {} {} node1 0 {}} 3807 mytree insert root end 3808 set result [lsort [mytree nodes]] 3809 mytree destroy 3810 set result 3811} {node1 node2 root} 3812