1# -*- tcl -*- 2# Copyright (c) 2001 by Jean-Luc Fontaine <jfontain@free.fr>. 3# This code may be distributed under the same terms as Tcl. 4# 5# $Id: stooop.test,v 1.12 2006/10/09 15:23:06 andreas_kupries Exp $ 6 7# ------------------------------------------------------------------------- 8 9source [file join \ 10 [file dirname [file dirname [file join [pwd] [info script]]]] \ 11 devtools testutilities.tcl] 12 13testsNeedTcl 8.3 14testsNeedTcltest 1.0 15 16testing { 17 useLocal stooop.tcl stooop 18} 19 20# ------------------------------------------------------------------------- 21 22set source [localPath stooop.tcl] 23 24# ------------------------------------------------------------------------- 25 26set dumpArraysCode { 27 proc dumpArrays {args} { 28 set list {} 29 foreach array $args { 30 upvar $array data 31 foreach name [lsort [array names data]] { 32 lappend list "$array\($name\) = $data($name)" 33 } 34 } 35 return $list 36 } 37} 38 39# ------------------------------------------------------------------------- 40 41test stooop-0 { 42 check that the empty named array feature works 43} { 44 set interpreter [interp create] 45 $interpreter eval "source $source; namespace import stooop::*" 46 set result [$interpreter eval { 47 set (0) 0 48 lappend ::result $(0) 49 namespace eval n { 50 variable {} 51 set (1) 1 52 lappend ::result $(1) 53 } 54 55 set ::result 56 }] 57 interp delete $interpreter 58 set result 59} [list\ 60 0\ 61 1\ 62] 63 64test stooop-1 { 65 undocumented 66} { 67 set interpreter [interp create] 68 $interpreter eval "source $source; namespace import stooop::*" 69 set result [$interpreter eval { 70 catch {new a} ::result 71 set ::result 72 }] 73 interp delete $interpreter 74 set result 75} {invalid command name "a::a"} 76 77test stooop-2 { 78 undocumented 79} { 80 set interpreter [interp create] 81 $interpreter eval "source $source; namespace import stooop::*" 82 set result [$interpreter eval { 83 class a {} 84 proc a::a {this} { 85 lappend ::result "a::a $this" 86 } 87 catch {delete [new a]} message 88 lappend ::result $message 89 90 class A { 91 proc A {this} { 92 lappend ::result "A::A $this" 93 } 94 } 95 catch {delete [new A]} message 96 lappend ::result $message 97 98 class b::c {} 99 proc b::c::c {this} { 100 lappend ::result "c::c $this" 101 } 102 catch {delete [new b::c]} message 103 lappend ::result $message 104 105 class B { 106 class C { 107 proc C {this} { 108 lappend ::result "C::C $this" 109 } 110 } 111 catch {delete [new C]} message 112 lappend ::result $message 113 } 114 catch {delete [new B::C]} message 115 lappend ::result $message 116 117 set ::result 118 }] 119 interp delete $interpreter 120 set result 121} [list\ 122 {a::a 1}\ 123 {invalid command name "::a::~a"}\ 124 {A::A 2}\ 125 {invalid command name "::A::~A"}\ 126 {c::c 3}\ 127 {invalid command name "::b::c::~c"}\ 128 {C::C 4}\ 129 {invalid command name "::B::C::~C"}\ 130 {C::C 5}\ 131 {invalid command name "::B::C::~C"}\ 132] 133 134test stooop-3 { 135 undocumented 136} { 137 set interpreter [interp create] 138 $interpreter eval "source $source; namespace import stooop::*" 139 set result [$interpreter eval { 140 class a {} 141 catch {new a} message 142 lappend ::result $message 143 144 class b::c {} 145 catch {new b::c} message 146 lappend ::result $message 147 148 class A {} 149 catch {new A} message 150 lappend ::result $message 151 152 class B { 153 class C {} 154 catch {new C} message 155 lappend ::result $message 156 } 157 catch {new B::C} message 158 lappend ::result $message 159 160 set ::result 161 }] 162 interp delete $interpreter 163 set result 164} [list\ 165 {invalid command name "a::a"}\ 166 {invalid command name "b::c::c"}\ 167 {invalid command name "A::A"}\ 168 {invalid command name "C::C"}\ 169 {invalid command name "B::C::C"}\ 170] 171 172test stooop-4 { 173 undocumented 174} { 175 set interpreter [interp create] 176 $interpreter eval "source $source; namespace import stooop::*" 177 $interpreter eval $dumpArraysCode 178 set result [$interpreter eval { 179 class a {} 180 proc a::a {this p q} { 181 lappend ::result "a::a $this" 182 set ($this,m) $p 183 set ($this,n) $q 184 } 185 proc a::~a {this} { 186 lappend ::result "a::~a $this" 187 } 188 set o [new a x {y z}] 189 eval lappend ::result [dumpArrays a::] 190 delete $o 191 eval lappend ::result [dumpArrays a::] 192 193 class A { 194 proc A {this p q} { 195 lappend ::result "A::A $this" 196 set ($this,m) $p 197 set ($this,n) $q 198 } 199 proc ~A {this} { 200 lappend ::result "A::~A $this" 201 } 202 } 203 set o [new A x {y z}] 204 eval lappend ::result [dumpArrays A::] 205 delete $o 206 eval lappend ::result [dumpArrays A::] 207 208 class c::d {} 209 proc c::d::d {this p q} { 210 lappend ::result "d::d $this" 211 set ($this,m) $p 212 set ($this,n) $q 213 } 214 proc c::d::~d {this} { 215 lappend ::result "d::~d $this" 216 } 217 set o [new c::d x {y z}] 218 eval lappend ::result [dumpArrays c::d::] 219 delete $o 220 eval lappend ::result [dumpArrays c::d::] 221 222 class C { 223 class D { 224 proc D {this p q} { 225 lappend ::result "D::D $this" 226 set ($this,m) $p 227 set ($this,n) $q 228 } 229 proc ~D {this} { 230 lappend ::result "D::~D $this" 231 } 232 } 233 set o [new D x {y z}] 234 eval lappend ::result [dumpArrays D::] 235 delete $o 236 eval lappend ::result [dumpArrays D::] 237 } 238 set o [new C::D x {y z}] 239 eval lappend ::result [dumpArrays C::D::] 240 delete $o 241 eval lappend ::result [dumpArrays C::D::] 242 243 set ::result 244 }] 245 interp delete $interpreter 246 set result 247} [list\ 248 {a::a 1}\ 249 {a::(1,m) = x}\ 250 {a::(1,n) = y z}\ 251 {a::~a 1}\ 252 {A::A 2}\ 253 {A::(2,m) = x}\ 254 {A::(2,n) = y z}\ 255 {A::~A 2}\ 256 {d::d 3}\ 257 {c::d::(3,m) = x}\ 258 {c::d::(3,n) = y z}\ 259 {d::~d 3}\ 260 {D::D 4}\ 261 {D::(4,m) = x}\ 262 {D::(4,n) = y z}\ 263 {D::~D 4}\ 264 {D::D 5}\ 265 {C::D::(5,m) = x}\ 266 {C::D::(5,n) = y z}\ 267 {D::~D 5}\ 268] 269 270test stooop-5 { 271 undocumented 272} { 273 set interpreter [interp create] 274 $interpreter eval "source $source; namespace import stooop::*" 275 set result [$interpreter eval { 276 class ::a {} 277 class b::b {} 278 set ::result {} 279 }] 280 interp delete $interpreter 281 set result 282} {} 283 284test stooop-6 { 285 undocumented 286} { 287 set interpreter [interp create] 288 $interpreter eval "source $source; namespace import stooop::*" 289 $interpreter eval $dumpArraysCode 290 set result [$interpreter eval { 291 class a {} 292 proc a::a {this p} { 293 lappend ::result "a::a $this" 294 set ($this,m) $p 295 } 296 proc a::~a {this} { 297 lappend ::result "a::~a $this" 298 } 299 class b {} 300 proc b::b {this p q} a {$p} { 301 lappend ::result "b::b $this" 302 set ($this,n) $q 303 } 304 proc b::~b {this} { 305 lappend ::result "b::~b $this" 306 } 307 set o [new b {x y} z] 308 eval lappend ::result [dumpArrays a:: b::] 309 delete $o 310 eval lappend ::result [dumpArrays a:: b::] 311 312 class A { 313 proc A {this p} { 314 lappend ::result "A::A $this" 315 set ($this,m) $p 316 } 317 proc ~A {this} { 318 lappend ::result "A::~A $this" 319 } 320 } 321 class B { 322 proc B {this p q} A {$p} { 323 lappend ::result "B::B $this" 324 set ($this,n) $q 325 } 326 proc ~B {this} { 327 lappend ::result "B::~B $this" 328 } 329 } 330 set o [new B {x y} z] 331 eval lappend ::result [dumpArrays A:: B::] 332 delete $o 333 eval lappend ::result [dumpArrays A:: B::] 334 335 class c::d {} 336 proc c::d::d {this p} { 337 lappend ::result "d::d $this" 338 set ($this,m) $p 339 } 340 proc c::d::~d {this} { 341 lappend ::result "d::~d $this" 342 } 343 class c::e {} 344 proc c::e::e {this p q} c::d {$p} { 345 lappend ::result "e::e $this" 346 set ($this,n) $q 347 } 348 proc c::e::~e {this} { 349 lappend ::result "e::~e $this" 350 } 351 set o [new c::e {x y} z] 352 eval lappend ::result [dumpArrays c::d:: c::e::] 353 delete $o 354 eval lappend ::result [dumpArrays c::d:: c::e::] 355 356 class C { 357 class D { 358 proc D {this p} { 359 lappend ::result "D::D $this" 360 set ($this,m) $p 361 } 362 proc ~D {this} { 363 lappend ::result "D::~D $this" 364 } 365 } 366 class E { 367 proc E {this p q} C::D {$p} { 368 lappend ::result "E::E $this" 369 set ($this,n) $q 370 } 371 proc ~E {this} { 372 lappend ::result "E::~E $this" 373 } 374 } 375 } 376 set o [new C::E {x y} z] 377 eval lappend ::result [dumpArrays C::D:: C::E::] 378 delete $o 379 eval lappend ::result [dumpArrays C::D:: C::E::] 380 381 set ::result 382 }] 383 interp delete $interpreter 384 set result 385} [list\ 386 {a::a 1}\ 387 {b::b 1}\ 388 {a::(1,_derived) = ::b}\ 389 {a::(1,m) = x y}\ 390 {b::(1,n) = z}\ 391 {b::~b 1}\ 392 {a::~a 1}\ 393 {A::A 2}\ 394 {B::B 2}\ 395 {A::(2,_derived) = ::B}\ 396 {A::(2,m) = x y}\ 397 {B::(2,n) = z}\ 398 {B::~B 2}\ 399 {A::~A 2}\ 400 {d::d 3}\ 401 {e::e 3}\ 402 {c::d::(3,_derived) = ::c::e}\ 403 {c::d::(3,m) = x y}\ 404 {c::e::(3,n) = z}\ 405 {e::~e 3}\ 406 {d::~d 3}\ 407 {D::D 4}\ 408 {E::E 4}\ 409 {C::D::(4,_derived) = ::C::E}\ 410 {C::D::(4,m) = x y}\ 411 {C::E::(4,n) = z}\ 412 {E::~E 4}\ 413 {D::~D 4}\ 414] 415 416test stooop-7 { 417 undocumented 418} { 419 set interpreter [interp create] 420 $interpreter eval "source $source; namespace import stooop::*" 421 set result [$interpreter eval { 422 class a {} 423 proc a::a {this} {} 424 class b {} 425 proc b::b {this} a {} {} 426 class c {} 427 proc c::c {this} b {} a {} {} 428 lappend ::result [classof [new a]] 429 lappend ::result [classof [new b]] 430 lappend ::result [classof [new c]] 431 432 class A { 433 proc A {this} {} 434 } 435 class B { 436 proc B {this} A {} {} 437 } 438 class C { 439 proc C {this} B {} A {} {} 440 } 441 lappend ::result [classof [new A]] 442 lappend ::result [classof [new B]] 443 lappend ::result [classof [new C]] 444 445 class d::e {} 446 proc d::e::e {this} {} 447 class d::f {} 448 proc d::f::f {this} d::e {} {} 449 class d::g {} 450 proc d::g::g {this} d::f {} d::e {} {} 451 lappend ::result [classof [new d::e]] 452 lappend ::result [classof [new d::f]] 453 lappend ::result [classof [new d::g]] 454 455 class D { 456 class E { 457 proc E {this} {} 458 } 459 class F { 460 proc F {this} D::E {} {} 461 } 462 class G { 463 proc G {this} D::F {} D::E {} {} 464 } 465 lappend ::result [classof [new E]] 466 lappend ::result [classof [new F]] 467 lappend ::result [classof [new G]] 468 } 469 lappend ::result [classof [new D::E]] 470 lappend ::result [classof [new D::F]] 471 lappend ::result [classof [new D::G]] 472 473 set ::result 474 }] 475 interp delete $interpreter 476 set result 477} [list\ 478 ::a\ 479 ::b\ 480 ::c\ 481 ::A\ 482 ::B\ 483 ::C\ 484 ::d::e\ 485 ::d::f\ 486 ::d::g\ 487 ::D::E\ 488 ::D::F\ 489 ::D::G\ 490 ::D::E\ 491 ::D::F\ 492 ::D::G\ 493] 494 495test stooop-8 { 496 undocumented 497} { 498 set interpreter [interp create] 499 $interpreter eval "source $source; namespace import stooop::*" 500 set result [$interpreter eval { 501 class a {} 502 proc a::a {this} { 503 lappend ::result "a::a $this" 504 } 505 proc a::~a {this} { 506 lappend ::result "a::~a $this" 507 } 508 class b {} 509 proc b::b {this} a {} { 510 lappend ::result "b::b $this" 511 } 512 proc b::~b {this} { 513 lappend ::result "b::~b $this" 514 } 515 class c {} 516 proc c::c {this} b {} { 517 lappend ::result "c::c $this" 518 } 519 proc c::~c {this} { 520 lappend ::result "c::~c $this" 521 } 522 delete [new a] 523 delete [new b] 524 delete [new c] 525 526 class A { 527 proc A {this} { 528 lappend ::result "A::A $this" 529 } 530 proc ~A {this} { 531 lappend ::result "A::~A $this" 532 } 533 } 534 class B { 535 proc B {this} A {} { 536 lappend ::result "B::B $this" 537 } 538 proc ~B {this} { 539 lappend ::result "B::~B $this" 540 } 541 } 542 class C { 543 proc C {this} B {} { 544 lappend ::result "C::C $this" 545 } 546 proc ~C {this} { 547 lappend ::result "C::~C $this" 548 } 549 } 550 delete [new A] 551 delete [new B] 552 delete [new C] 553 554 class d::e {} 555 proc d::e::e {this} { 556 lappend ::result "e::e $this" 557 } 558 proc d::e::~e {this} { 559 lappend ::result "e::~e $this" 560 } 561 class d::f {} 562 proc d::f::f {this} d::e {} { 563 lappend ::result "f::f $this" 564 } 565 proc d::f::~f {this} { 566 lappend ::result "f::~f $this" 567 } 568 class d::g {} 569 proc d::g::g {this} d::f {} { 570 lappend ::result "g::g $this" 571 } 572 proc d::g::~g {this} { 573 lappend ::result "g::~g $this" 574 } 575 delete [new d::e] 576 delete [new d::f] 577 delete [new d::g] 578 579 class D { 580 class E { 581 proc E {this} { 582 lappend ::result "E::E $this" 583 } 584 proc ~E {this} { 585 lappend ::result "E::~E $this" 586 } 587 } 588 class F { 589 proc F {this} D::E {} { 590 lappend ::result "F::F $this" 591 } 592 proc ~F {this} { 593 lappend ::result "F::~F $this" 594 } 595 } 596 class G { 597 proc G {this} D::F {} { 598 lappend ::result "G::G $this" 599 } 600 proc ~G {this} { 601 lappend ::result "G::~G $this" 602 } 603 } 604 delete [new E] 605 delete [new F] 606 delete [new G] 607 } 608 delete [new D::E] 609 delete [new D::F] 610 delete [new D::G] 611 612 set ::result 613 }] 614 interp delete $interpreter 615 set result 616} [list\ 617 {a::a 1}\ 618 {a::~a 1}\ 619 {a::a 2}\ 620 {b::b 2}\ 621 {b::~b 2}\ 622 {a::~a 2}\ 623 {a::a 3}\ 624 {b::b 3}\ 625 {c::c 3}\ 626 {c::~c 3}\ 627 {b::~b 3}\ 628 {a::~a 3}\ 629 {A::A 4}\ 630 {A::~A 4}\ 631 {A::A 5}\ 632 {B::B 5}\ 633 {B::~B 5}\ 634 {A::~A 5}\ 635 {A::A 6}\ 636 {B::B 6}\ 637 {C::C 6}\ 638 {C::~C 6}\ 639 {B::~B 6}\ 640 {A::~A 6}\ 641 {e::e 7}\ 642 {e::~e 7}\ 643 {e::e 8}\ 644 {f::f 8}\ 645 {f::~f 8}\ 646 {e::~e 8}\ 647 {e::e 9}\ 648 {f::f 9}\ 649 {g::g 9}\ 650 {g::~g 9}\ 651 {f::~f 9}\ 652 {e::~e 9}\ 653 {E::E 10}\ 654 {E::~E 10}\ 655 {E::E 11}\ 656 {F::F 11}\ 657 {F::~F 11}\ 658 {E::~E 11}\ 659 {E::E 12}\ 660 {F::F 12}\ 661 {G::G 12}\ 662 {G::~G 12}\ 663 {F::~F 12}\ 664 {E::~E 12}\ 665 {E::E 13}\ 666 {E::~E 13}\ 667 {E::E 14}\ 668 {F::F 14}\ 669 {F::~F 14}\ 670 {E::~E 14}\ 671 {E::E 15}\ 672 {F::F 15}\ 673 {G::G 15}\ 674 {G::~G 15}\ 675 {F::~F 15}\ 676 {E::~E 15}\ 677] 678 679test stooop-9 { 680 undocumented 681} { 682 set interpreter [interp create] 683 $interpreter eval "source $source; namespace import stooop::*" 684 set result [$interpreter eval { 685 catch { 686 class a {} 687 proc a::a {this} {} 688 proc a::~a {this p} {} 689 } message 690 lappend ::result $message 691 692 catch { 693 class A { 694 proc A {this} {} 695 proc ~A {this p} {} 696 } 697 } message 698 lappend ::result $message 699 700 catch { 701 class b::c {} 702 proc b::c::c {this} {} 703 proc b::c::~c {this p} {} 704 } message 705 lappend ::result $message 706 707 catch { 708 class B { 709 class C { 710 proc C {this} {} 711 proc ~C {this p} {} 712 } 713 } 714 } message 715 lappend ::result $message 716 717 set ::result 718 }] 719 interp delete $interpreter 720 set result 721} [list\ 722 {class ::a destructor must have 1 argument exactly}\ 723 {class ::A destructor must have 1 argument exactly}\ 724 {class ::b::c destructor must have 1 argument exactly}\ 725 {class ::B::C destructor must have 1 argument exactly}\ 726] 727 728test stooop-10 { 729 undocumented 730} { 731 set interpreter [interp create] 732 $interpreter eval "source $source; namespace import stooop::*" 733 set result [$interpreter eval { 734 catch { 735 class a {} 736 proc a::a {this} {} 737 virtual proc a::~a {this} {} 738 } message 739 lappend ::result $message 740 741 catch { 742 class A { 743 proc A {this} {} 744 virtual proc ~A {this} {} 745 } 746 } message 747 lappend ::result $message 748 749 catch { 750 class b::c {} 751 proc b::c::c {this} {} 752 virtual proc b::c::~c {this} {} 753 } message 754 lappend ::result $message 755 756 catch { 757 class B { 758 class C { 759 proc C {this} {} 760 virtual proc ~C {this} {} 761 } 762 } 763 } message 764 lappend ::result $message 765 766 set ::result 767 }] 768 interp delete $interpreter 769 set result 770} [list\ 771 {cannot make class ::a destructor virtual}\ 772 {cannot make class ::A destructor virtual}\ 773 {cannot make class ::b::c destructor virtual}\ 774 {cannot make class ::B::C destructor virtual}\ 775] 776 777test stooop-11 { 778 undocumented 779} { 780 set interpreter [interp create] 781 $interpreter eval "source $source; namespace import stooop::*" 782 set result [$interpreter eval { 783 class a {} 784 proc a::a {this} { 785 lappend ::result "a::a $this" 786 } 787 proc a::~a {this} { 788 lappend ::result "a::~a $this" 789 } 790 virtual proc a::f {this p q} {} 791 virtual proc a::g {this p q} 792 virtual proc a::h {this p q} { 793 lappend ::result "a::h $this $p $q" 794 } 795 virtual proc a::i {this p q} 796 class b {} 797 proc b::b {this} a {} { 798 lappend ::result "b::b $this" 799 } 800 proc b::~b {this} { 801 lappend ::result "b::~b $this" 802 } 803 virtual proc b::f {this p q} { 804 lappend ::result "b::f $this $p $q" 805 } 806 virtual proc b::g {this p q} { 807 lappend ::result "b::g $this $p $q" 808 } 809 set o [new b] 810 a::f $o x {y z} 811 a::g $o x {y z} 812 a::h $o x {y z} 813 catch {a::i $o x {y z}} message 814 lappend ::result $message 815 816 class A { 817 proc A {this} { 818 lappend ::result "A::A $this" 819 } 820 proc ~A {this} { 821 lappend ::result "A::~A $this" 822 } 823 virtual proc f {this p q} {} 824 virtual proc g {this p q} 825 virtual proc h {this p q} { 826 lappend ::result "A::h $this $p $q" 827 } 828 virtual proc i {this p q} 829 } 830 class B { 831 proc B {this} A {} { 832 lappend ::result "B::B $this" 833 } 834 proc ~B {this} { 835 lappend ::result "B::~B $this" 836 } 837 virtual proc f {this p q} { 838 lappend ::result "B::f $this $p $q" 839 } 840 virtual proc g {this p q} { 841 lappend ::result "B::g $this $p $q" 842 } 843 } 844 set o [new B] 845 A::f $o x {y z} 846 A::g $o x {y z} 847 A::h $o x {y z} 848 catch {A::i $o x {y z}} message 849 lappend ::result $message 850 851 class c::d {} 852 proc c::d::d {this} { 853 lappend ::result "d::d $this" 854 } 855 proc c::d::~d {this} { 856 lappend ::result "d::~d $this" 857 } 858 virtual proc c::d::f {this p q} {} 859 virtual proc c::d::g {this p q} 860 virtual proc c::d::h {this p q} { 861 lappend ::result "d::h $this $p $q" 862 } 863 virtual proc c::d::i {this p q} 864 class c::e {} 865 proc c::e::e {this} c::d {} { 866 lappend ::result "e::e $this" 867 } 868 proc c::e::~e {this} { 869 lappend ::result "e::~e $this" 870 } 871 virtual proc c::e::f {this p q} { 872 lappend ::result "e::f $this $p $q" 873 } 874 virtual proc c::e::g {this p q} { 875 lappend ::result "e::g $this $p $q" 876 } 877 set o [new c::e] 878 c::d::f $o x {y z} 879 c::d::g $o x {y z} 880 c::d::h $o x {y z} 881 catch {c::d::i $o x {y z}} message 882 lappend ::result $message 883 884 class C { 885 class D { 886 proc D {this} { 887 lappend ::result "D::D $this" 888 } 889 proc ~D {this} { 890 lappend ::result "D::~D $this" 891 } 892 virtual proc f {this p q} {} 893 virtual proc g {this p q} 894 virtual proc h {this p q} { 895 lappend ::result "D::h $this $p $q" 896 } 897 virtual proc i {this p q} 898 } 899 class E { 900 proc E {this} C::D {} { 901 lappend ::result "E::E $this" 902 } 903 proc ~E {this} { 904 lappend ::result "E::~E $this" 905 } 906 virtual proc f {this p q} { 907 lappend ::result "E::f $this $p $q" 908 } 909 virtual proc g {this p q} { 910 lappend ::result "E::g $this $p $q" 911 } 912 } 913 set o [new E] 914 D::f $o x {y z} 915 D::g $o x {y z} 916 D::h $o x {y z} 917 catch {D::i $o x {y z}} message 918 lappend ::result $message 919 } 920 set o [new C::E] 921 C::D::f $o x {y z} 922 C::D::g $o x {y z} 923 C::D::h $o x {y z} 924 catch {C::D::i $o x {y z}} message 925 lappend ::result $message 926 927 set ::result 928 }] 929 interp delete $interpreter 930 set result 931} [list\ 932 {a::a 1}\ 933 {b::b 1}\ 934 {b::f 1 x y z}\ 935 {b::g 1 x y z}\ 936 {a::h 1 x y z}\ 937 {invalid command name "::b::i"}\ 938 {A::A 2}\ 939 {B::B 2}\ 940 {B::f 2 x y z}\ 941 {B::g 2 x y z}\ 942 {A::h 2 x y z}\ 943 {invalid command name "::B::i"}\ 944 {d::d 3}\ 945 {e::e 3}\ 946 {e::f 3 x y z}\ 947 {e::g 3 x y z}\ 948 {d::h 3 x y z}\ 949 {invalid command name "::c::e::i"}\ 950 {D::D 4}\ 951 {E::E 4}\ 952 {E::f 4 x y z}\ 953 {E::g 4 x y z}\ 954 {D::h 4 x y z}\ 955 {invalid command name "::C::E::i"}\ 956 {D::D 5}\ 957 {E::E 5}\ 958 {E::f 5 x y z}\ 959 {E::g 5 x y z}\ 960 {D::h 5 x y z}\ 961 {invalid command name "::C::E::i"}\ 962] 963 964test stooop-12 { 965 undocumented 966} { 967 set interpreter [interp create] 968 $interpreter eval "source $source; namespace import stooop::*" 969 set result [$interpreter eval { 970 catch { 971 class a {} 972 virtual proc a::a {this} {} 973 } message 974 lappend ::result $message 975 976 catch { 977 class A { 978 virtual proc A {this} {} 979 } 980 } message 981 lappend ::result $message 982 983 catch { 984 class b::c {} 985 virtual proc b::c::c {this} {} 986 } message 987 lappend ::result $message 988 989 catch { 990 class B { 991 class C { 992 virtual proc C {this} {} 993 } 994 } 995 } message 996 lappend ::result $message 997 998 set ::result 999 }] 1000 interp delete $interpreter 1001 set result 1002} [list\ 1003 {cannot make class ::a constructor virtual}\ 1004 {cannot make class ::A constructor virtual}\ 1005 {cannot make class ::b::c constructor virtual}\ 1006 {cannot make class ::B::C constructor virtual}\ 1007] 1008 1009test stooop-13 { 1010 undocumented 1011} { 1012 set interpreter [interp create] 1013 $interpreter eval "source $source; namespace import stooop::*" 1014 set result [$interpreter eval { 1015 catch { 1016 class a {} 1017 proc a::~a {this} {} 1018 } message 1019 lappend ::result $message 1020 1021 catch { 1022 class A { 1023 proc ~A {this} {} 1024 } 1025 } message 1026 lappend ::result $message 1027 1028 catch { 1029 class b::c {} 1030 proc b::c::~c {this} {} 1031 } message 1032 lappend ::result $message 1033 1034 catch { 1035 class B { 1036 class C { 1037 proc ~C {this} {} 1038 } 1039 } 1040 } message 1041 lappend ::result $message 1042 1043 set ::result 1044 }] 1045 interp delete $interpreter 1046 set result 1047} [list\ 1048 {class ::a destructor defined before constructor}\ 1049 {class ::A destructor defined before constructor}\ 1050 {class ::b::c destructor defined before constructor}\ 1051 {class ::B::C destructor defined before constructor}\ 1052] 1053 1054test stooop-14 { 1055 undocumented 1056} { 1057 set interpreter [interp create] 1058 $interpreter eval "source $source; namespace import stooop::*" 1059 set result [$interpreter eval { 1060 class a {} 1061 catch { 1062 class b {} 1063 proc b::b {this} a {} {} 1064 } message 1065 lappend ::result $message 1066 1067 class A {} 1068 catch { 1069 class B { 1070 proc B {this} A {} {} 1071 } 1072 } message 1073 lappend ::result $message 1074 1075 class b::c {} 1076 catch { 1077 class b::d {} 1078 proc b::d::d {this} b::c {} {} 1079 } message 1080 lappend ::result $message 1081 1082 catch { 1083 class B { 1084 class C {} 1085 class D { 1086 proc D {this} C {} {} 1087 } 1088 } 1089 } message 1090 lappend ::result $message 1091 1092 set ::result 1093 }] 1094 interp delete $interpreter 1095 set result 1096} [list\ 1097 {class ::b constructor defined before base class a constructor}\ 1098 {class ::B constructor defined before base class A constructor}\ 1099 {class ::b::d constructor defined before base class b::c constructor}\ 1100 {class ::B::D constructor defined before base class C constructor}\ 1101] 1102 1103test stooop-15 { 1104 undocumented 1105} { 1106 set interpreter [interp create] 1107 $interpreter eval "source $source; namespace import stooop::*" 1108 set result [$interpreter eval { 1109 catch { 1110 class a {} 1111 virtual a::f {this} {} 1112 } message 1113 lappend ::result $message 1114 1115 catch { 1116 class A { 1117 virtual f {this} {} 1118 } 1119 } message 1120 lappend ::result $message 1121 1122 catch { 1123 class b::c {} 1124 virtual b::c::f {this} {} 1125 } message 1126 lappend ::result $message 1127 1128 catch { 1129 class B { 1130 class C { 1131 virtual f {this} {} 1132 } 1133 } 1134 } message 1135 lappend ::result $message 1136 1137 set ::result 1138 }] 1139 interp delete $interpreter 1140 set result 1141} [list\ 1142 {virtual operator works only on proc, not a::f}\ 1143 {virtual operator works only on proc, not f}\ 1144 {virtual operator works only on proc, not b::c::f}\ 1145 {virtual operator works only on proc, not f}\ 1146] 1147 1148test stooop-16 { 1149 undocumented 1150} { 1151 set interpreter [interp create] 1152 $interpreter eval "source $source; namespace import stooop::*" 1153 set result [$interpreter eval { 1154 catch { 1155 virtual proc f {} {} 1156 } message 1157 lappend ::result $message 1158 1159 catch { 1160 virtual proc a::f {} {} 1161 } message 1162 lappend ::result $message 1163 1164 set ::result 1165 }] 1166 interp delete $interpreter 1167 set result 1168} [list\ 1169 {procedure ::f class name is empty}\ 1170 {procedure ::a::f class ::a is unknown}\ 1171] 1172 1173test stooop-17 { 1174 undocumented 1175} { 1176 set interpreter [interp create] 1177 $interpreter eval "source $source; namespace import stooop::*" 1178 set result [$interpreter eval { 1179 catch { 1180 class a {} 1181 proc a::f {this} 1182 } message 1183 lappend ::result $message 1184 1185 catch { 1186 class A { 1187 proc f {this} 1188 } 1189 } message 1190 lappend ::result $message 1191 1192 catch { 1193 class b::c {} 1194 proc b::c::f {this} 1195 } message 1196 lappend ::result $message 1197 1198 catch { 1199 class B { 1200 class C { 1201 proc f {this} 1202 } 1203 } 1204 } message 1205 lappend ::result $message 1206 1207 set ::result 1208 }] 1209 interp delete $interpreter 1210 set result 1211} [list\ 1212 {missing body for ::a::f}\ 1213 {missing body for ::A::f}\ 1214 {missing body for ::b::c::f}\ 1215 {missing body for ::B::C::f}\ 1216] 1217 1218test stooop-18 { 1219 undocumented 1220} { 1221 set interpreter [interp create] 1222 $interpreter eval "source $source; namespace import stooop::*" 1223 set result [$interpreter eval { 1224 catch { 1225 class b {} 1226 proc b::b {this} a {} 1227 } message 1228 lappend ::result $message 1229 1230 catch { 1231 class B { 1232 proc B {this} A {} 1233 } 1234 } message 1235 lappend ::result $message 1236 1237 catch { 1238 class c::e {} 1239 proc c::e::e {this} d {} 1240 } message 1241 lappend ::result $message 1242 1243 catch { 1244 class C { 1245 class E { 1246 proc E {this} D {} 1247 } 1248 } 1249 } message 1250 lappend ::result $message 1251 1252 set ::result 1253 }] 1254 interp delete $interpreter 1255 set result 1256} [list\ 1257 {bad class ::b constructor declaration, a base class, contructor arguments or body may be missing}\ 1258 {bad class ::B constructor declaration, a base class, contructor arguments or body may be missing}\ 1259 {bad class ::c::e constructor declaration, a base class, contructor arguments or body may be missing}\ 1260 {bad class ::C::E constructor declaration, a base class, contructor arguments or body may be missing}\ 1261] 1262 1263test stooop-19 { 1264 undocumented 1265} { 1266 set interpreter [interp create] 1267 $interpreter eval "source $source; namespace import stooop::*" 1268 set result [$interpreter eval { 1269 catch { 1270 class b {} 1271 proc b::b {this} b {} {} 1272 } message 1273 lappend ::result $message 1274 1275 catch { 1276 class B { 1277 proc B {this} B {} {} 1278 } 1279 } message 1280 lappend ::result $message 1281 1282 catch { 1283 class c::d {} 1284 proc c::d::d {this} c::d {} {} 1285 } message 1286 lappend ::result $message 1287 1288 catch { 1289 class C { 1290 class D { 1291 proc D {this} D {} {} 1292 } 1293 } 1294 } message 1295 lappend ::result $message 1296 1297 set ::result 1298 }] 1299 interp delete $interpreter 1300 set result 1301} [list\ 1302 {class ::b cannot be derived from itself}\ 1303 {class ::B cannot be derived from itself}\ 1304 {class ::c::d cannot be derived from itself}\ 1305 {class ::C::D cannot be derived from itself}\ 1306] 1307 1308test stooop-20 { 1309 undocumented 1310} { 1311 set interpreter [interp create] 1312 $interpreter eval "source $source; namespace import stooop::*" 1313 set result [$interpreter eval { 1314 catch { 1315 class a {} 1316 proc a::~a {this} {} 1317 } message 1318 lappend ::result $message 1319 1320 catch { 1321 class A { 1322 proc ~A {this} {} 1323 } 1324 } message 1325 lappend ::result $message 1326 1327 catch { 1328 class a {} 1329 proc a::a {this} {} 1330 class a::b {} 1331 proc a::b::~b {this} {} 1332 } message 1333 lappend ::result $message 1334 1335 catch { 1336 class A { 1337 proc A {this} {} 1338 class B { 1339 proc ~B {this} {} 1340 } 1341 } 1342 } message 1343 lappend ::result $message 1344 1345 set ::result 1346 }] 1347 interp delete $interpreter 1348 set result 1349} [list\ 1350 {class ::a destructor defined before constructor}\ 1351 {class ::A destructor defined before constructor}\ 1352 {class ::a::b destructor defined before constructor}\ 1353 {class ::A::B destructor defined before constructor}\ 1354] 1355 1356test stooop-21 { 1357 undocumented 1358} { 1359 set interpreter [interp create] 1360 $interpreter eval "source $source; namespace import stooop::*" 1361 set result [$interpreter eval { 1362 catch { 1363 class a {} 1364 proc a::a {p} {} 1365 } message 1366 lappend ::result $message 1367 1368 catch { 1369 class A { 1370 proc A {p} {} 1371 } 1372 } message 1373 lappend ::result $message 1374 1375 catch { 1376 class a {} 1377 proc a::a {this} {} 1378 class a::b {} 1379 proc a::b::b {p} {} 1380 } message 1381 lappend ::result $message 1382 1383 catch { 1384 class A { 1385 proc A {this} {} 1386 class B { 1387 proc B {p} {} 1388 } 1389 } 1390 } message 1391 lappend ::result $message 1392 1393 set ::result 1394 }] 1395 interp delete $interpreter 1396 set result 1397} [list\ 1398 {class ::a constructor first argument must be this}\ 1399 {class ::A constructor first argument must be this}\ 1400 {class ::a::b constructor first argument must be this}\ 1401 {class ::A::B constructor first argument must be this}\ 1402] 1403 1404test stooop-22 { 1405 undocumented 1406} { 1407 set interpreter [interp create] 1408 $interpreter eval "source $source; namespace import stooop::*" 1409 set result [$interpreter eval { 1410 catch { 1411 class a {} 1412 proc a::~a {p} {} 1413 } message 1414 lappend ::result $message 1415 1416 catch { 1417 class A { 1418 proc ~A {p} {} 1419 } 1420 } message 1421 lappend ::result $message 1422 1423 catch { 1424 class a {} 1425 proc a::a {this} {} 1426 class a::b {} 1427 proc a::b::~b {p} {} 1428 } message 1429 lappend ::result $message 1430 1431 catch { 1432 class A { 1433 proc A {this} {} 1434 class B { 1435 proc ~B {p} {} 1436 } 1437 } 1438 } message 1439 lappend ::result $message 1440 1441 set ::result 1442 }] 1443 interp delete $interpreter 1444 set result 1445} [list\ 1446 {class ::a destructor argument must be this}\ 1447 {class ::A destructor argument must be this}\ 1448 {class ::a::b destructor argument must be this}\ 1449 {class ::A::B destructor argument must be this}\ 1450] 1451 1452test stooop-23 { 1453 undocumented 1454} { 1455 set interpreter [interp create] 1456 $interpreter eval "source $source; namespace import stooop::*" 1457 set result [$interpreter eval { 1458 catch { 1459 class a {} 1460 virtual proc a::f {p} {} 1461 } message 1462 lappend ::result $message 1463 1464 catch { 1465 class A { 1466 virtual proc f {p} {} 1467 } 1468 } message 1469 lappend ::result $message 1470 1471 catch { 1472 class a {} 1473 proc a::a {this} {} 1474 class a::b {} 1475 virtual proc a::b::f {p} {} 1476 } message 1477 lappend ::result $message 1478 1479 catch { 1480 class A { 1481 proc A {this} {} 1482 class B { 1483 virtual proc f {p} {} 1484 } 1485 } 1486 } message 1487 lappend ::result $message 1488 1489 set ::result 1490 }] 1491 interp delete $interpreter 1492 set result 1493} [list\ 1494 {cannot make static procedure f of class ::a virtual}\ 1495 {cannot make static procedure f of class ::A virtual}\ 1496 {cannot make static procedure f of class ::a::b virtual}\ 1497 {cannot make static procedure f of class ::A::B virtual}\ 1498] 1499 1500test stooop-24 { 1501 undocumented 1502} { 1503 set interpreter [interp create] 1504 $interpreter eval "source $source; namespace import stooop::*" 1505 $interpreter eval $dumpArraysCode 1506 set result [$interpreter eval { 1507 class a {} 1508 proc a::a {this p args} { 1509 lappend ::result "a::a $this $p $args" 1510 set ($this,m) [lindex $args 0] 1511 } 1512 proc a::~a {this} { 1513 lappend ::result "a::~a $this" 1514 } 1515 class b {} 1516 proc b::b {this p args} a {$p $args} { 1517 lappend ::result "b::b $this $p $args" 1518 set ($this,n) [lindex $args 0] 1519 } 1520 proc b::~b {this} { 1521 lappend ::result "b::~b $this" 1522 } 1523 new b {x y} {1 2} 3 1524 eval lappend ::result [dumpArrays a:: b::] 1525 1526 class A { 1527 proc A {this p args} { 1528 lappend ::result "A::A $this $p $args" 1529 set ($this,m) [lindex $args 0] 1530 } 1531 proc ~A {this} { 1532 lappend ::result "A::~A $this" 1533 } 1534 } 1535 class B { 1536 proc B {this p args} A {$p $args} { 1537 lappend ::result "B::B $this $p $args" 1538 set ($this,n) [lindex $args 0] 1539 } 1540 proc ~B {this} { 1541 lappend ::result "B::~B $this" 1542 } 1543 } 1544 new B {x y} {1 2} 3 1545 eval lappend ::result [dumpArrays A:: B::] 1546 1547 class c {} 1548 class c::d {} 1549 proc c::d::d {this p args} { 1550 lappend ::result "d::d $this $p $args" 1551 set ($this,m) [lindex $args 0] 1552 } 1553 proc c::d::~d {this} { 1554 lappend ::result "d::~d $this" 1555 } 1556 class c::e {} 1557 proc c::e::e {this p args} c::d {$p $args} { 1558 lappend ::result "e::e $this $p $args" 1559 set ($this,n) [lindex $args 0] 1560 } 1561 proc c::e::~e {this} { 1562 lappend ::result "e::~e $this" 1563 } 1564 new c::e {x y} {1 2} 3 1565 eval lappend ::result [dumpArrays c::d:: c::e::] 1566 1567 class C { 1568 class D { 1569 proc D {this p args} { 1570 lappend ::result "D::D $this $p $args" 1571 set ($this,m) [lindex $args 0] 1572 } 1573 proc ~D {this} { 1574 lappend ::result "D::~D $this" 1575 } 1576 } 1577 class E { 1578 proc E {this p args} C::D {$p $args} { 1579 lappend ::result "E::E $this $p $args" 1580 set ($this,n) [lindex $args 0] 1581 } 1582 proc ~E {this} { 1583 lappend ::result "E::~E $this" 1584 } 1585 } 1586 new E {x y} {1 2} 3 1587 eval lappend ::result [dumpArrays D:: E::] 1588 } 1589 new C::E {x y} {1 2} 3 1590 eval lappend ::result [dumpArrays C::D:: C::E::] 1591 1592 set ::result 1593 }] 1594 interp delete $interpreter 1595 set result 1596} [list\ 1597 {a::a 1 x y {1 2} 3}\ 1598 {b::b 1 x y {1 2} 3}\ 1599 {a::(1,_derived) = ::b}\ 1600 {a::(1,m) = 1 2}\ 1601 {b::(1,n) = 1 2}\ 1602 {A::A 2 x y {1 2} 3}\ 1603 {B::B 2 x y {1 2} 3}\ 1604 {A::(2,_derived) = ::B}\ 1605 {A::(2,m) = 1 2}\ 1606 {B::(2,n) = 1 2}\ 1607 {d::d 3 x y {1 2} 3}\ 1608 {e::e 3 x y {1 2} 3}\ 1609 {c::d::(3,_derived) = ::c::e}\ 1610 {c::d::(3,m) = 1 2}\ 1611 {c::e::(3,n) = 1 2}\ 1612 {D::D 4 x y {1 2} 3}\ 1613 {E::E 4 x y {1 2} 3}\ 1614 {D::(4,_derived) = ::C::E}\ 1615 {D::(4,m) = 1 2}\ 1616 {E::(4,n) = 1 2}\ 1617 {D::D 5 x y {1 2} 3}\ 1618 {E::E 5 x y {1 2} 3}\ 1619 {C::D::(4,_derived) = ::C::E}\ 1620 {C::D::(4,m) = 1 2}\ 1621 {C::D::(5,_derived) = ::C::E}\ 1622 {C::D::(5,m) = 1 2}\ 1623 {C::E::(4,n) = 1 2}\ 1624 {C::E::(5,n) = 1 2}\ 1625] 1626 1627test stooop-25 { 1628 undocumented 1629} { 1630 set interpreter [interp create] 1631 $interpreter eval "source $source; namespace import stooop::*" 1632 set result [$interpreter eval { 1633 class a {} 1634 proc a::a {this} { 1635 lappend ::result "a::a $this" 1636 } 1637 proc a::~a {this} { 1638 lappend ::result "a::~a $this" 1639 } 1640 virtual proc a::f {this p args} {} 1641 proc a::g {this p args} { 1642 lappend ::result "a::g $this $p $args" 1643 } 1644 class b {} 1645 proc b::b {this} a {} { 1646 lappend ::result "b::b $this" 1647 } 1648 proc b::~b {this} { 1649 lappend ::result "b::~b $this" 1650 } 1651 virtual proc b::f {this p args} { 1652 lappend ::result "b::f $this $p $args" 1653 } 1654 set o [new b] 1655 a::f $o {x y} {1 2} 3 1656 a::g $o {x y} {1 2} 3 1657 1658 class A { 1659 proc A {this} { 1660 lappend ::result "A::A $this" 1661 } 1662 proc ~A {this} { 1663 lappend ::result "A::~A $this" 1664 } 1665 virtual proc f {this p args} {} 1666 proc g {this p args} { 1667 lappend ::result "A::g $this $p $args" 1668 } 1669 } 1670 class B { 1671 proc B {this} A {} { 1672 lappend ::result "B::B $this" 1673 } 1674 proc ~B {this} { 1675 lappend ::result "B::~B $this" 1676 } 1677 virtual proc f {this p args} { 1678 lappend ::result "B::f $this $p $args" 1679 } 1680 } 1681 set o [new B] 1682 A::f $o {x y} {1 2} 3 1683 A::g $o {x y} {1 2} 3 1684 1685 class c {} 1686 class c::d {} 1687 proc c::d::d {this} { 1688 lappend ::result "d::d $this" 1689 } 1690 proc c::d::~d {this} { 1691 lappend ::result "d::~d $this" 1692 } 1693 virtual proc c::d::f {this p args} {} 1694 proc c::d::g {this p args} { 1695 lappend ::result "d::g $this $p $args" 1696 } 1697 class c::e {} 1698 proc c::e::e {this} c::d {} { 1699 lappend ::result "e::e $this" 1700 } 1701 proc c::e::~e {this} { 1702 lappend ::result "e::~e $this" 1703 } 1704 virtual proc c::e::f {this p args} { 1705 lappend ::result "e::f $this $p $args" 1706 } 1707 set o [new c::e] 1708 c::d::f $o {x y} {1 2} 3 1709 c::d::g $o {x y} {1 2} 3 1710 1711 class C { 1712 class D { 1713 proc D {this} { 1714 lappend ::result "D::D $this" 1715 } 1716 proc ~D {this} { 1717 lappend ::result "D::~D $this" 1718 } 1719 virtual proc f {this p args} {} 1720 proc g {this p args} { 1721 lappend ::result "D::g $this $p $args" 1722 } 1723 } 1724 class B { 1725 proc B {this} C::D {} { 1726 lappend ::result "B::B $this" 1727 } 1728 proc ~B {this} { 1729 lappend ::result "B::~B $this" 1730 } 1731 virtual proc f {this p args} { 1732 lappend ::result "B::f $this $p $args" 1733 } 1734 } 1735 set o [new B] 1736 D::f $o {x y} {1 2} 3 1737 D::g $o {x y} {1 2} 3 1738 } 1739 set o [new C::B] 1740 C::D::f $o {x y} {1 2} 3 1741 C::D::g $o {x y} {1 2} 3 1742 1743 set ::result 1744 }] 1745 interp delete $interpreter 1746 set result 1747} [list\ 1748 {a::a 1}\ 1749 {b::b 1}\ 1750 {b::f 1 x y {1 2} 3}\ 1751 {a::g 1 x y {1 2} 3}\ 1752 {A::A 2}\ 1753 {B::B 2}\ 1754 {B::f 2 x y {1 2} 3}\ 1755 {A::g 2 x y {1 2} 3}\ 1756 {d::d 3}\ 1757 {e::e 3}\ 1758 {e::f 3 x y {1 2} 3}\ 1759 {d::g 3 x y {1 2} 3}\ 1760 {D::D 4}\ 1761 {B::B 4}\ 1762 {B::f 4 x y {1 2} 3}\ 1763 {D::g 4 x y {1 2} 3}\ 1764 {D::D 5}\ 1765 {B::B 5}\ 1766 {B::f 5 x y {1 2} 3}\ 1767 {D::g 5 x y {1 2} 3}\ 1768] 1769 1770test stooop-26 { 1771 undocumented 1772} { 1773 set interpreter [interp create] 1774 $interpreter eval "source $source; namespace import stooop::*" 1775 $interpreter eval $dumpArraysCode 1776 set result [$interpreter eval { 1777 class a {} 1778 proc a::a {this p q args} { 1779 lappend ::result "a::a $this $p $q $args" 1780 set ($this,m) [lindex $args 0] 1781 set ($this,p) $p 1782 set ($this,q) $q 1783 } 1784 proc a::~a {this} { 1785 lappend ::result "a::~a $this" 1786 } 1787 class b {} 1788 proc b::b {this p q args} a {$p $q $args} { 1789 lappend ::result "b::b $this $p $q $args" 1790 set ($this,n) [lindex $args 0] 1791 } 1792 proc b::~b {this} { 1793 lappend ::result "b::~b $this" 1794 } 1795 new b {x y} {X Y} {1 2} 3 1796 eval lappend ::result [dumpArrays a:: b::] 1797 1798 class A { 1799 proc A {this p q args} { 1800 lappend ::result "A::A $this $p $q $args" 1801 set ($this,m) [lindex $args 0] 1802 set ($this,p) $p 1803 set ($this,q) $q 1804 } 1805 proc ~A {this} { 1806 lappend ::result "A::~A $this" 1807 } 1808 } 1809 class B { 1810 proc B {this p q args} A {$p $q $args} { 1811 lappend ::result "B::B $this $p $q $args" 1812 set ($this,n) [lindex $args 0] 1813 } 1814 proc ~B {this} { 1815 lappend ::result "B::~B $this" 1816 } 1817 } 1818 new B {x y} {X Y} {1 2} 3 1819 eval lappend ::result [dumpArrays A:: B::] 1820 1821 class c {} 1822 class c::d {} 1823 proc c::d::d {this p q args} { 1824 lappend ::result "d::d $this $p $q $args" 1825 set ($this,m) [lindex $args 0] 1826 set ($this,p) $p 1827 set ($this,q) $q 1828 } 1829 proc c::d::~d {this} { 1830 lappend ::result "d::~d $this" 1831 } 1832 class c::e {} 1833 proc c::e::e {this p q args} c::d {$p $q $args} { 1834 lappend ::result "e::e $this $p $q $args" 1835 set ($this,n) [lindex $args 0] 1836 } 1837 proc c::e::~e {this} { 1838 lappend ::result "e::~e $this" 1839 } 1840 new c::e {x y} {X Y} {1 2} 3 1841 eval lappend ::result [dumpArrays c::d:: c::e::] 1842 1843 class C { 1844 class D { 1845 proc D {this p q args} { 1846 lappend ::result "D::D $this $p $q $args" 1847 set ($this,m) [lindex $args 0] 1848 set ($this,p) $p 1849 set ($this,q) $q 1850 } 1851 proc ~D {this} { 1852 lappend ::result "D::~D $this" 1853 } 1854 } 1855 class E { 1856 proc E {this p q args} C::D {$p $q $args} { 1857 lappend ::result "E::E $this $p $q $args" 1858 set ($this,n) [lindex $args 0] 1859 } 1860 proc ~E {this} { 1861 lappend ::result "E::~E $this" 1862 } 1863 } 1864 new E {x y} {X Y} {1 2} 3 1865 eval lappend ::result [dumpArrays D:: E::] 1866 } 1867 new C::E {x y} {X Y} {1 2} 3 1868 eval lappend ::result [dumpArrays C::D:: C::E::] 1869 1870 set ::result 1871 }] 1872 interp delete $interpreter 1873 set result 1874} [list\ 1875 {a::a 1 x y X Y {1 2} 3}\ 1876 {b::b 1 x y X Y {1 2} 3}\ 1877 {a::(1,_derived) = ::b}\ 1878 {a::(1,m) = 1 2}\ 1879 {a::(1,p) = x y}\ 1880 {a::(1,q) = X Y}\ 1881 {b::(1,n) = 1 2}\ 1882 {A::A 2 x y X Y {1 2} 3}\ 1883 {B::B 2 x y X Y {1 2} 3}\ 1884 {A::(2,_derived) = ::B}\ 1885 {A::(2,m) = 1 2}\ 1886 {A::(2,p) = x y}\ 1887 {A::(2,q) = X Y}\ 1888 {B::(2,n) = 1 2}\ 1889 {d::d 3 x y X Y {1 2} 3}\ 1890 {e::e 3 x y X Y {1 2} 3}\ 1891 {c::d::(3,_derived) = ::c::e}\ 1892 {c::d::(3,m) = 1 2}\ 1893 {c::d::(3,p) = x y}\ 1894 {c::d::(3,q) = X Y}\ 1895 {c::e::(3,n) = 1 2}\ 1896 {D::D 4 x y X Y {1 2} 3}\ 1897 {E::E 4 x y X Y {1 2} 3}\ 1898 {D::(4,_derived) = ::C::E}\ 1899 {D::(4,m) = 1 2}\ 1900 {D::(4,p) = x y}\ 1901 {D::(4,q) = X Y}\ 1902 {E::(4,n) = 1 2}\ 1903 {D::D 5 x y X Y {1 2} 3}\ 1904 {E::E 5 x y X Y {1 2} 3}\ 1905 {C::D::(4,_derived) = ::C::E}\ 1906 {C::D::(4,m) = 1 2}\ 1907 {C::D::(4,p) = x y}\ 1908 {C::D::(4,q) = X Y}\ 1909 {C::D::(5,_derived) = ::C::E}\ 1910 {C::D::(5,m) = 1 2}\ 1911 {C::D::(5,p) = x y}\ 1912 {C::D::(5,q) = X Y}\ 1913 {C::E::(4,n) = 1 2}\ 1914 {C::E::(5,n) = 1 2}\ 1915] 1916 1917test stooop-27 { 1918 undocumented 1919} { 1920 set interpreter [interp create] 1921 $interpreter eval "source $source; namespace import stooop::*" 1922 $interpreter eval $dumpArraysCode 1923 set result [$interpreter eval { 1924 class a {} 1925 proc a::a {this args} { 1926 lappend ::result "a::a $this $args" 1927 set ($this,m) [lindex $args 0] 1928 } 1929 proc a::~a {this} { 1930 lappend ::result "a::~a $this" 1931 } 1932 class b {} 1933 proc b::b {this p args} a {$args} { 1934 lappend ::result "b::b $this $p $args" 1935 set ($this,n) [lindex $args 0] 1936 } 1937 proc b::~b {this} { 1938 lappend ::result "b::~b $this" 1939 } 1940 new b {x y} {1 2} 3 1941 eval lappend ::result [dumpArrays a:: b::] 1942 1943 class A { 1944 proc A {this args} { 1945 lappend ::result "A::A $this $args" 1946 set ($this,m) [lindex $args 0] 1947 } 1948 proc ~A {this} { 1949 lappend ::result "A::~A $this" 1950 } 1951 } 1952 class B { 1953 proc B {this p args} A {$args} { 1954 lappend ::result "B::B $this $p $args" 1955 set ($this,n) [lindex $args 0] 1956 } 1957 proc ~B {this} { 1958 lappend ::result "B::~B $this" 1959 } 1960 } 1961 new B {x y} {1 2} 3 1962 eval lappend ::result [dumpArrays A:: B::] 1963 1964 class c {} 1965 class c::d {} 1966 proc c::d::d {this args} { 1967 lappend ::result "d::d $this $args" 1968 set ($this,m) [lindex $args 0] 1969 } 1970 proc c::d::~d {this} { 1971 lappend ::result "d::~d $this" 1972 } 1973 class c::e {} 1974 proc c::e::e {this p args} c::d {$args} { 1975 lappend ::result "e::e $this $p $args" 1976 set ($this,n) [lindex $args 0] 1977 } 1978 proc c::e::~e {this} { 1979 lappend ::result "e::~e $this" 1980 } 1981 new c::e {x y} {1 2} 3 1982 eval lappend ::result [dumpArrays c::d:: c::e::] 1983 1984 class C { 1985 class D { 1986 proc D {this args} { 1987 lappend ::result "D::D $this $args" 1988 set ($this,m) [lindex $args 0] 1989 } 1990 proc ~D {this} { 1991 lappend ::result "D::~D $this" 1992 } 1993 } 1994 class E { 1995 proc E {this p args} C::D {$args} { 1996 lappend ::result "E::E $this $p $args" 1997 set ($this,n) [lindex $args 0] 1998 } 1999 proc ~E {this} { 2000 lappend ::result "E::~E $this" 2001 } 2002 } 2003 new E {x y} {1 2} 3 2004 eval lappend ::result [dumpArrays D:: E::] 2005 } 2006 new C::E {x y} {1 2} 3 2007 eval lappend ::result [dumpArrays C::D:: C::E::] 2008 2009 set ::result 2010 }] 2011 interp delete $interpreter 2012 set result 2013} [list\ 2014 {a::a 1 {1 2} 3}\ 2015 {b::b 1 x y {1 2} 3}\ 2016 {a::(1,_derived) = ::b}\ 2017 {a::(1,m) = 1 2}\ 2018 {b::(1,n) = 1 2}\ 2019 {A::A 2 {1 2} 3}\ 2020 {B::B 2 x y {1 2} 3}\ 2021 {A::(2,_derived) = ::B}\ 2022 {A::(2,m) = 1 2}\ 2023 {B::(2,n) = 1 2}\ 2024 {d::d 3 {1 2} 3}\ 2025 {e::e 3 x y {1 2} 3}\ 2026 {c::d::(3,_derived) = ::c::e}\ 2027 {c::d::(3,m) = 1 2}\ 2028 {c::e::(3,n) = 1 2}\ 2029 {D::D 4 {1 2} 3}\ 2030 {E::E 4 x y {1 2} 3}\ 2031 {D::(4,_derived) = ::C::E}\ 2032 {D::(4,m) = 1 2}\ 2033 {E::(4,n) = 1 2}\ 2034 {D::D 5 {1 2} 3}\ 2035 {E::E 5 x y {1 2} 3}\ 2036 {C::D::(4,_derived) = ::C::E}\ 2037 {C::D::(4,m) = 1 2}\ 2038 {C::D::(5,_derived) = ::C::E}\ 2039 {C::D::(5,m) = 1 2}\ 2040 {C::E::(4,n) = 1 2}\ 2041 {C::E::(5,n) = 1 2}\ 2042] 2043 2044test stooop-28 { 2045 undocumented 2046} { 2047 set interpreter [interp create] 2048 $interpreter eval "source $source; namespace import stooop::*" 2049 $interpreter eval $dumpArraysCode 2050 set result [$interpreter eval { 2051 class a {} 2052 proc a::a {this args} { 2053 lappend ::result "a::a $this $args" 2054 set ($this,m) [lindex $args 0] 2055 } 2056 proc a::~a {this} { 2057 lappend ::result "a::~a $this" 2058 } 2059 class b {} 2060 proc b::b {this args} a {$args} { 2061 lappend ::result "b::b $this $args" 2062 set ($this,n) [lindex $args 0] 2063 } 2064 proc b::~b {this} { 2065 lappend ::result "b::~b $this" 2066 } 2067 new b {1 2} 3 2068 eval lappend ::result [dumpArrays a:: b::] 2069 2070 class A { 2071 proc A {this args} { 2072 lappend ::result "A::A $this $args" 2073 set ($this,m) [lindex $args 0] 2074 } 2075 proc ~A {this} { 2076 lappend ::result "A::~A $this" 2077 } 2078 } 2079 class B { 2080 proc B {this args} A {$args} { 2081 lappend ::result "B::B $this $args" 2082 set ($this,n) [lindex $args 0] 2083 } 2084 proc ~B {this} { 2085 lappend ::result "B::~B $this" 2086 } 2087 } 2088 new B {1 2} 3 2089 eval lappend ::result [dumpArrays A:: B::] 2090 2091 class c {} 2092 class c::d {} 2093 proc c::d::d {this args} { 2094 lappend ::result "d::d $this $args" 2095 set ($this,m) [lindex $args 0] 2096 } 2097 proc c::d::~d {this} { 2098 lappend ::result "d::~d $this" 2099 } 2100 class c::e {} 2101 proc c::e::e {this args} c::d {$args} { 2102 lappend ::result "e::e $this $args" 2103 set ($this,n) [lindex $args 0] 2104 } 2105 proc c::e::~e {this} { 2106 lappend ::result "e::~e $this" 2107 } 2108 new c::e {1 2} 3 2109 eval lappend ::result [dumpArrays c::d:: c::e::] 2110 2111 class C { 2112 class D { 2113 proc D {this args} { 2114 lappend ::result "D::D $this $args" 2115 set ($this,m) [lindex $args 0] 2116 } 2117 proc ~D {this} { 2118 lappend ::result "D::~D $this" 2119 } 2120 } 2121 class E { 2122 proc E {this args} C::D {$args} { 2123 lappend ::result "E::E $this $args" 2124 set ($this,n) [lindex $args 0] 2125 } 2126 proc ~E {this} { 2127 lappend ::result "E::~E $this" 2128 } 2129 } 2130 new E {1 2} 3 2131 eval lappend ::result [dumpArrays D:: E::] 2132 } 2133 new C::E {1 2} 3 2134 eval lappend ::result [dumpArrays C::D:: C::E::] 2135 2136 set ::result 2137 }] 2138 interp delete $interpreter 2139 set result 2140} [list\ 2141 {a::a 1 {1 2} 3}\ 2142 {b::b 1 {1 2} 3}\ 2143 {a::(1,_derived) = ::b}\ 2144 {a::(1,m) = 1 2}\ 2145 {b::(1,n) = 1 2}\ 2146 {A::A 2 {1 2} 3}\ 2147 {B::B 2 {1 2} 3}\ 2148 {A::(2,_derived) = ::B}\ 2149 {A::(2,m) = 1 2}\ 2150 {B::(2,n) = 1 2}\ 2151 {d::d 3 {1 2} 3}\ 2152 {e::e 3 {1 2} 3}\ 2153 {c::d::(3,_derived) = ::c::e}\ 2154 {c::d::(3,m) = 1 2}\ 2155 {c::e::(3,n) = 1 2}\ 2156 {D::D 4 {1 2} 3}\ 2157 {E::E 4 {1 2} 3}\ 2158 {D::(4,_derived) = ::C::E}\ 2159 {D::(4,m) = 1 2}\ 2160 {E::(4,n) = 1 2}\ 2161 {D::D 5 {1 2} 3}\ 2162 {E::E 5 {1 2} 3}\ 2163 {C::D::(4,_derived) = ::C::E}\ 2164 {C::D::(4,m) = 1 2}\ 2165 {C::D::(5,_derived) = ::C::E}\ 2166 {C::D::(5,m) = 1 2}\ 2167 {C::E::(4,n) = 1 2}\ 2168 {C::E::(5,n) = 1 2}\ 2169] 2170 2171test stooop-29 { 2172 undocumented 2173} { 2174 set interpreter [interp create] 2175 $interpreter eval "source $source; namespace import stooop::*" 2176 set result [$interpreter eval { 2177 class a {} 2178 proc a::a {this p q} { 2179 lappend ::result "a::a $this $p $q" 2180 } 2181 proc a::~a {this} {} 2182 class b {} 2183 proc b::b {this p q} a { 2184 $p $q 2185 } { 2186 lappend ::result "b::b $this $p $q" 2187 } 2188 proc b::~b {this} {} 2189 new b {x y} z 2190 2191 class A { 2192 proc A {this p q} { 2193 lappend ::result "A::A $this $p $q" 2194 } 2195 proc ~A {this} {} 2196 } 2197 class B { 2198 proc B {this p q} A { 2199 $p $q 2200 } { 2201 lappend ::result "B::B $this $p $q" 2202 } 2203 proc ~B {this} {} 2204 } 2205 new B {x y} z 2206 2207 class c {} 2208 class c::d {} 2209 proc c::d::d {this p q} { 2210 lappend ::result "d::d $this $p $q" 2211 } 2212 proc c::d::~d {this} {} 2213 class c::e {} 2214 proc c::e::e {this p q} c::d { 2215 $p $q 2216 } { 2217 lappend ::result "e::e $this $p $q" 2218 } 2219 proc c::e::~e {this} {} 2220 new c::e {x y} z 2221 2222 class C { 2223 class D { 2224 proc D {this p q} { 2225 lappend ::result "D::D $this $p $q" 2226 } 2227 proc ~D {this} {} 2228 } 2229 class E { 2230 proc E {this p q} C::D { 2231 $p $q 2232 } { 2233 lappend ::result "E::E $this $p $q" 2234 } 2235 proc ~E {this} {} 2236 } 2237 new E {x y} z 2238 } 2239 new C::E {x y} z 2240 2241 set ::result 2242 }] 2243 interp delete $interpreter 2244 set result 2245} [list\ 2246 {a::a 1 x y z}\ 2247 {b::b 1 x y z}\ 2248 {A::A 2 x y z}\ 2249 {B::B 2 x y z}\ 2250 {d::d 3 x y z}\ 2251 {e::e 3 x y z}\ 2252 {D::D 4 x y z}\ 2253 {E::E 4 x y z}\ 2254 {D::D 5 x y z}\ 2255 {E::E 5 x y z}\ 2256] 2257 2258test stooop-30 { 2259 undocumented 2260} { 2261 set interpreter [interp create] 2262 $interpreter eval "source $source; namespace import stooop::*" 2263 set result [$interpreter eval { 2264 class a {} 2265 proc a::a {this} { 2266 lappend ::result "a::a $this" 2267 } 2268 proc a::~a {this} { 2269 lappend ::result "a::~a $this" 2270 } 2271 virtual proc a::f {this p q} { 2272 lappend ::result "a::h $this $p $q" 2273 } 2274 virtual proc a::g {this p args} { 2275 lappend ::result "a::g $this $p $args" 2276 } 2277 class b {} 2278 proc b::b {this} a {} { 2279 lappend ::result "b::b $this" 2280 } 2281 proc b::~b {this} { 2282 lappend ::result "b::~b $this" 2283 } 2284 proc b::f {this p q} { 2285 lappend ::result "b::f $this $p $q" 2286 a::_f $this $p $q 2287 } 2288 proc b::g {this p args} { 2289 lappend ::result "b::g $this $p $args" 2290 eval a::_g $this $p $args 2291 } 2292 set o [new b] 2293 a::f $o x {y z} 2294 a::g $o {x y} {1 2} 3 {4 5} 2295 2296 class A { 2297 proc A {this} { 2298 lappend ::result "A::A $this" 2299 } 2300 proc ~A {this} { 2301 lappend ::result "A::~A $this" 2302 } 2303 virtual proc f {this p q} { 2304 lappend ::result "A::h $this $p $q" 2305 } 2306 virtual proc g {this p args} { 2307 lappend ::result "A::g $this $p $args" 2308 } 2309 } 2310 class B { 2311 proc B {this} A {} { 2312 lappend ::result "B::B $this" 2313 } 2314 proc ~B {this} { 2315 lappend ::result "B::~B $this" 2316 } 2317 proc f {this p q} { 2318 lappend ::result "B::f $this $p $q" 2319 A::_f $this $p $q 2320 } 2321 proc g {this p args} { 2322 lappend ::result "B::g $this $p $args" 2323 eval A::_g $this $p $args 2324 } 2325 } 2326 set o [new B] 2327 A::f $o x {y z} 2328 A::g $o {x y} {1 2} 3 {4 5} 2329 2330 class c {} 2331 class c::d {} 2332 proc c::d::d {this} { 2333 lappend ::result "d::d $this" 2334 } 2335 proc c::d::~d {this} { 2336 lappend ::result "d::~d $this" 2337 } 2338 virtual proc c::d::f {this p q} { 2339 lappend ::result "d::h $this $p $q" 2340 } 2341 virtual proc c::d::g {this p args} { 2342 lappend ::result "d::g $this $p $args" 2343 } 2344 class c::e {} 2345 proc c::e::e {this} c::d {} { 2346 lappend ::result "e::e $this" 2347 } 2348 proc c::e::~e {this} { 2349 lappend ::result "e::~e $this" 2350 } 2351 proc c::e::f {this p q} { 2352 lappend ::result "e::f $this $p $q" 2353 c::d::_f $this $p $q 2354 } 2355 proc c::e::g {this p args} { 2356 lappend ::result "e::g $this $p $args" 2357 eval c::d::_g $this $p $args 2358 } 2359 set o [new c::e] 2360 c::d::f $o x {y z} 2361 c::d::g $o {x y} {1 2} 3 {4 5} 2362 2363 class C { 2364 class D { 2365 proc D {this} { 2366 lappend ::result "D::D $this" 2367 } 2368 proc ~D {this} { 2369 lappend ::result "D::~D $this" 2370 } 2371 virtual proc f {this p q} { 2372 lappend ::result "D::h $this $p $q" 2373 } 2374 virtual proc g {this p args} { 2375 lappend ::result "D::g $this $p $args" 2376 } 2377 } 2378 class E { 2379 proc E {this} C::D {} { 2380 lappend ::result "E::E $this" 2381 } 2382 proc ~E {this} { 2383 lappend ::result "E::~E $this" 2384 } 2385 proc f {this p q} { 2386 lappend ::result "E::f $this $p $q" 2387 C::D::_f $this $p $q 2388 } 2389 proc g {this p args} { 2390 lappend ::result "E::g $this $p $args" 2391 eval C::D::_g $this $p $args 2392 } 2393 } 2394 set o [new E] 2395 D::f $o x {y z} 2396 D::g $o {x y} {1 2} 3 {4 5} 2397 } 2398 set o [new C::E] 2399 C::D::f $o x {y z} 2400 C::D::g $o {x y} {1 2} 3 {4 5} 2401 2402 set ::result 2403 }] 2404 interp delete $interpreter 2405 set result 2406} [list\ 2407 {a::a 1}\ 2408 {b::b 1}\ 2409 {b::f 1 x y z}\ 2410 {a::h 1 x y z}\ 2411 {b::g 1 x y {1 2} 3 {4 5}}\ 2412 {a::g 1 x y {1 2} 3 {4 5}}\ 2413 {A::A 2}\ 2414 {B::B 2}\ 2415 {B::f 2 x y z}\ 2416 {A::h 2 x y z}\ 2417 {B::g 2 x y {1 2} 3 {4 5}}\ 2418 {A::g 2 x y {1 2} 3 {4 5}}\ 2419 {d::d 3}\ 2420 {e::e 3}\ 2421 {e::f 3 x y z}\ 2422 {d::h 3 x y z}\ 2423 {e::g 3 x y {1 2} 3 {4 5}}\ 2424 {d::g 3 x y {1 2} 3 {4 5}}\ 2425 {D::D 4}\ 2426 {E::E 4}\ 2427 {E::f 4 x y z}\ 2428 {D::h 4 x y z}\ 2429 {E::g 4 x y {1 2} 3 {4 5}}\ 2430 {D::g 4 x y {1 2} 3 {4 5}}\ 2431 {D::D 5}\ 2432 {E::E 5}\ 2433 {E::f 5 x y z}\ 2434 {D::h 5 x y z}\ 2435 {E::g 5 x y {1 2} 3 {4 5}}\ 2436 {D::g 5 x y {1 2} 3 {4 5}}\ 2437] 2438 2439test stooop-31 { 2440 check multiple inheritance construction order, destruction order and data 2441 deallocation 2442} { 2443 set interpreter [interp create] 2444 $interpreter eval "source $source; namespace import stooop::*" 2445 $interpreter eval $dumpArraysCode 2446 set result [$interpreter eval { 2447 class a {} 2448 proc a::a {this p} { 2449 lappend ::result "a::a $this" 2450 set ($this,m) $p 2451 } 2452 proc a::~a {this} { 2453 lappend ::result "a::~a $this" 2454 } 2455 class b {} 2456 proc b::b {this p} { 2457 lappend ::result "b::b $this" 2458 set ($this,n) $p 2459 } 2460 proc b::~b {this} { 2461 lappend ::result "b::~b $this" 2462 } 2463 class c {} 2464 proc c::c {this p q r} a {$p} b {$q} { 2465 lappend ::result "c::c $this" 2466 set ($this,o) $r 2467 } 2468 proc c::~c {this} { 2469 lappend ::result "c::~c $this" 2470 } 2471 set o [new c {x y} z {1 2}] 2472 eval lappend ::result [dumpArrays a:: b:: c::] 2473 delete $o 2474 eval lappend ::result [dumpArrays a:: b:: c::] 2475 2476 class A { 2477 proc A {this p} { 2478 lappend ::result "A::A $this" 2479 set ($this,m) $p 2480 } 2481 proc ~A {this} { 2482 lappend ::result "A::~A $this" 2483 } 2484 } 2485 class B { 2486 proc B {this p} { 2487 lappend ::result "B::B $this" 2488 set ($this,n) $p 2489 } 2490 proc ~B {this} { 2491 lappend ::result "B::~B $this" 2492 } 2493 } 2494 class C { 2495 proc C {this p q r} A {$p} B {$q} { 2496 lappend ::result "C::C $this" 2497 set ($this,o) $r 2498 } 2499 proc ~C {this} { 2500 lappend ::result "C::~C $this" 2501 } 2502 } 2503 set o [new C {x y} z {1 2}] 2504 eval lappend ::result [dumpArrays A:: B:: C::] 2505 delete $o 2506 eval lappend ::result [dumpArrays A:: B:: C::] 2507 2508 class d {} 2509 class d::e {} 2510 proc d::e::e {this p} { 2511 lappend ::result "e::e $this" 2512 set ($this,m) $p 2513 } 2514 proc d::e::~e {this} { 2515 lappend ::result "e::~e $this" 2516 } 2517 class d::f {} 2518 proc d::f::f {this p} { 2519 lappend ::result "f::f $this" 2520 set ($this,n) $p 2521 } 2522 proc d::f::~f {this} { 2523 lappend ::result "f::~f $this" 2524 } 2525 class d::g {} 2526 proc d::g::g {this p q r} d::e {$p} d::f {$q} { 2527 lappend ::result "g::g $this" 2528 set ($this,o) $r 2529 } 2530 proc d::g::~g {this} { 2531 lappend ::result "g::~g $this" 2532 } 2533 set o [new d::g {x y} z {1 2}] 2534 eval lappend ::result [dumpArrays d::e:: d::f:: d::g::] 2535 delete $o 2536 eval lappend ::result [dumpArrays d::e:: d::f:: d::g::] 2537 2538 class C { 2539 class E { 2540 proc E {this p} { 2541 lappend ::result "E::E $this" 2542 set ($this,m) $p 2543 } 2544 proc ~E {this} { 2545 lappend ::result "E::~E $this" 2546 } 2547 } 2548 class F { 2549 proc F {this p} { 2550 lappend ::result "F::F $this" 2551 set ($this,n) $p 2552 } 2553 proc ~F {this} { 2554 lappend ::result "F::~F $this" 2555 } 2556 } 2557 class G { 2558 proc G {this p q r} C::E {$p} C::F {$q} { 2559 lappend ::result "G::G $this" 2560 set ($this,o) $r 2561 } 2562 proc ~G {this} { 2563 lappend ::result "G::~G $this" 2564 } 2565 } 2566 set o [new G {x y} z {1 2}] 2567 eval lappend ::result [dumpArrays E:: F:: G::] 2568 delete $o 2569 eval lappend ::result [dumpArrays E:: F:: G::] 2570 } 2571 set o [new C::G {x y} z {1 2}] 2572 eval lappend ::result [dumpArrays C::E:: C::F:: C::G::] 2573 delete $o 2574 eval lappend ::result [dumpArrays C::E:: C::F:: C::G::] 2575 2576 set ::result 2577 }] 2578 interp delete $interpreter 2579 set result 2580} [list\ 2581 {a::a 1}\ 2582 {b::b 1}\ 2583 {c::c 1}\ 2584 {a::(1,_derived) = ::c}\ 2585 {a::(1,m) = x y}\ 2586 {b::(1,_derived) = ::c}\ 2587 {b::(1,n) = z}\ 2588 {c::(1,o) = 1 2}\ 2589 {c::~c 1}\ 2590 {b::~b 1}\ 2591 {a::~a 1}\ 2592 {A::A 2}\ 2593 {B::B 2}\ 2594 {C::C 2}\ 2595 {A::(2,_derived) = ::C}\ 2596 {A::(2,m) = x y}\ 2597 {B::(2,_derived) = ::C}\ 2598 {B::(2,n) = z}\ 2599 {C::(2,o) = 1 2}\ 2600 {C::~C 2}\ 2601 {B::~B 2}\ 2602 {A::~A 2}\ 2603 {e::e 3}\ 2604 {f::f 3}\ 2605 {g::g 3}\ 2606 {d::e::(3,_derived) = ::d::g}\ 2607 {d::e::(3,m) = x y}\ 2608 {d::f::(3,_derived) = ::d::g}\ 2609 {d::f::(3,n) = z}\ 2610 {d::g::(3,o) = 1 2}\ 2611 {g::~g 3}\ 2612 {f::~f 3}\ 2613 {e::~e 3}\ 2614 {E::E 4}\ 2615 {F::F 4}\ 2616 {G::G 4}\ 2617 {E::(4,_derived) = ::C::G}\ 2618 {E::(4,m) = x y}\ 2619 {F::(4,_derived) = ::C::G}\ 2620 {F::(4,n) = z}\ 2621 {G::(4,o) = 1 2}\ 2622 {G::~G 4}\ 2623 {F::~F 4}\ 2624 {E::~E 4}\ 2625 {E::E 5}\ 2626 {F::F 5}\ 2627 {G::G 5}\ 2628 {C::E::(5,_derived) = ::C::G}\ 2629 {C::E::(5,m) = x y}\ 2630 {C::F::(5,_derived) = ::C::G}\ 2631 {C::F::(5,n) = z}\ 2632 {C::G::(5,o) = 1 2}\ 2633 {G::~G 5}\ 2634 {F::~F 5}\ 2635 {E::~E 5}\ 2636] 2637 2638test stooop-32 { 2639 check that class constructor with multiple base classes has correct number 2640 of base class / argument pairs 2641} { 2642 set interpreter [interp create] 2643 $interpreter eval "source $source; namespace import stooop::*" 2644 set result [$interpreter eval { 2645 catch { 2646 class c {} 2647 proc c::c {this} a {} b {} 2648 } message 2649 lappend ::result $message 2650 2651 catch { 2652 class C { 2653 proc C {this} A {} B {} 2654 } 2655 } message 2656 lappend ::result $message 2657 2658 catch { 2659 class d {} 2660 class d::g {} 2661 proc d::g::g {this} d::e {} d::f {} 2662 } message 2663 lappend ::result $message 2664 2665 catch { 2666 class C { 2667 class G { 2668 proc G {this} C::E {} C::F {} 2669 } 2670 } 2671 } message 2672 lappend ::result $message 2673 2674 set ::result 2675 }] 2676 interp delete $interpreter 2677 set result 2678} [list\ 2679 {bad class ::c constructor declaration, a base class, contructor arguments or body may be missing}\ 2680 {bad class ::C constructor declaration, a base class, contructor arguments or body may be missing}\ 2681 {bad class ::d::g constructor declaration, a base class, contructor arguments or body may be missing}\ 2682 {bad class ::C::G constructor declaration, a base class, contructor arguments or body may be missing}\ 2683] 2684 2685test stooop-33 { 2686 check that base class of class with multiple base classes is defined 2687} { 2688 set interpreter [interp create] 2689 $interpreter eval "source $source; namespace import stooop::*" 2690 set result [$interpreter eval { 2691 catch { 2692 class a {} 2693 proc a::a {this} {} 2694 class b {} 2695 class c {} 2696 proc c::c {this} a {} b {} {} 2697 } message 2698 lappend ::result $message 2699 2700 catch { 2701 class A { 2702 proc A {this} {} 2703 } 2704 class B {} 2705 class C { 2706 proc C {this} A {} B {} {} 2707 } 2708 } message 2709 lappend ::result $message 2710 2711 catch { 2712 class d {} 2713 class d::e {} 2714 proc d::e::e {this} {} 2715 class d::f {} 2716 class d::g {} 2717 proc d::g::g {this} d::e {} d::f {} {} 2718 } message 2719 lappend ::result $message 2720 2721 catch { 2722 class C { 2723 class E { 2724 proc E {this} {} 2725 } 2726 class F {} 2727 class G { 2728 proc G {this} C::E {} C::F {} {} 2729 } 2730 } 2731 } message 2732 lappend ::result $message 2733 2734 set ::result 2735 }] 2736 interp delete $interpreter 2737 set result 2738} [list\ 2739 {class ::c constructor defined before base class b constructor}\ 2740 {class ::C constructor defined before base class B constructor}\ 2741 {class ::d::g constructor defined before base class d::f constructor}\ 2742 {class ::C::G constructor defined before base class C::F constructor}\ 2743] 2744 2745test stooop-34 { 2746 check that a direct base class is not specified more than once in a class 2747 constructor declaration 2748} { 2749 set interpreter [interp create] 2750 $interpreter eval "source $source; namespace import stooop::*" 2751 set result [$interpreter eval { 2752 catch { 2753 class a {} 2754 proc a::a {this} {} 2755 class c {} 2756 proc c::c {this} a {} a {} {} 2757 } message 2758 lappend ::result $message 2759 2760 catch { 2761 class A { 2762 proc A {this} {} 2763 } 2764 class C { 2765 proc C {this} A {} A {} {} 2766 } 2767 } message 2768 lappend ::result $message 2769 2770 catch { 2771 class d {} 2772 class d::e {} 2773 proc d::e::e {this} {} 2774 class d::g {} 2775 proc d::g::g {this} d::e {} d::e {} {} 2776 } message 2777 lappend ::result $message 2778 2779 catch { 2780 class D { 2781 class E { 2782 proc E {this} {} 2783 } 2784 class G { 2785 proc G {this} D::E {} D::E {} {} 2786 } 2787 } 2788 } message 2789 lappend ::result $message 2790 2791 set ::result 2792 }] 2793 interp delete $interpreter 2794 set result 2795} [list\ 2796 {class ::c directly inherits from class ::a more than once}\ 2797 {class ::C directly inherits from class ::A more than once}\ 2798 {class ::d::g directly inherits from class ::d::e more than once}\ 2799 {class ::D::G directly inherits from class ::D::E more than once}\ 2800] 2801 2802test stooop-35 { 2803 check that class constructor with multiple base classes allows new lines 2804 within base class constructors arguments 2805} { 2806 set interpreter [interp create] 2807 $interpreter eval "source $source; namespace import stooop::*" 2808 $interpreter eval $dumpArraysCode 2809 set result [$interpreter eval { 2810 class a {} 2811 proc a::a {this p} { 2812 lappend ::result "a::a $this" 2813 set ($this,m) $p 2814 } 2815 proc a::~a {this} { 2816 lappend ::result "a::~a $this" 2817 } 2818 class b {} 2819 proc b::b {this p} { 2820 lappend ::result "b::b $this" 2821 set ($this,n) $p 2822 } 2823 proc b::~b {this} { 2824 lappend ::result "b::~b $this" 2825 } 2826 class c {} 2827 proc c::c {this p q r} a { 2828 $p 2829 } b { 2830 $q 2831 } { 2832 lappend ::result "c::c $this" 2833 set ($this,o) $r 2834 } 2835 proc c::~c {this} { 2836 lappend ::result "c::~c $this" 2837 } 2838 new c {x y} z {1 2} 2839 eval lappend ::result [dumpArrays a:: b:: c::] 2840 2841 class A { 2842 proc A {this p} { 2843 lappend ::result "A::A $this" 2844 set ($this,m) $p 2845 } 2846 proc ~A {this} { 2847 lappend ::result "A::~A $this" 2848 } 2849 } 2850 class B { 2851 proc B {this p} { 2852 lappend ::result "B::B $this" 2853 set ($this,n) $p 2854 } 2855 proc ~B {this} { 2856 lappend ::result "B::~B $this" 2857 } 2858 } 2859 class C { 2860 proc C {this p q r} A { 2861 $p 2862 } B { 2863 $q 2864 } { 2865 lappend ::result "C::C $this" 2866 set ($this,o) $r 2867 } 2868 proc ~C {this} { 2869 lappend ::result "C::~C $this" 2870 } 2871 } 2872 new C {x y} z {1 2} 2873 eval lappend ::result [dumpArrays A:: B:: C::] 2874 2875 class d {} 2876 class d::e {} 2877 proc d::e::e {this p} { 2878 lappend ::result "e::e $this" 2879 set ($this,m) $p 2880 } 2881 proc d::e::~e {this} { 2882 lappend ::result "e::~e $this" 2883 } 2884 class d::f {} 2885 proc d::f::f {this p} { 2886 lappend ::result "f::f $this" 2887 set ($this,n) $p 2888 } 2889 proc d::f::~f {this} { 2890 lappend ::result "f::~f $this" 2891 } 2892 class d::g {} 2893 proc d::g::g {this p q r} d::e { 2894 $p 2895 } d::f { 2896 $q 2897 } { 2898 lappend ::result "g::g $this" 2899 set ($this,o) $r 2900 } 2901 proc d::g::~g {this} { 2902 lappend ::result "g::~g $this" 2903 } 2904 new d::g {x y} z {1 2} 2905 eval lappend ::result [dumpArrays d::e:: d::f:: d::g::] 2906 2907 class D { 2908 class E { 2909 proc E {this p} { 2910 lappend ::result "E::E $this" 2911 set ($this,m) $p 2912 } 2913 proc ~E {this} { 2914 lappend ::result "E::~E $this" 2915 } 2916 } 2917 class F { 2918 proc F {this p} { 2919 lappend ::result "F::F $this" 2920 set ($this,n) $p 2921 } 2922 proc ~F {this} { 2923 lappend ::result "F::~F $this" 2924 } 2925 } 2926 class G { 2927 proc G {this p q r} D::E { 2928 $p 2929 } D::F { 2930 $q 2931 } { 2932 lappend ::result "G::G $this" 2933 set ($this,o) $r 2934 } 2935 proc ~G {this} { 2936 lappend ::result "G::~G $this" 2937 } 2938 } 2939 new G {x y} z {1 2} 2940 eval lappend ::result [dumpArrays E:: F:: G::] 2941 } 2942 new D::G {x y} z {1 2} 2943 eval lappend ::result [dumpArrays D::E:: D::F:: D::G::] 2944 2945 set ::result 2946 }] 2947 interp delete $interpreter 2948 set result 2949} [list\ 2950 {a::a 1}\ 2951 {b::b 1}\ 2952 {c::c 1}\ 2953 {a::(1,_derived) = ::c}\ 2954 {a::(1,m) = x y}\ 2955 {b::(1,_derived) = ::c}\ 2956 {b::(1,n) = z}\ 2957 {c::(1,o) = 1 2}\ 2958 {A::A 2}\ 2959 {B::B 2}\ 2960 {C::C 2}\ 2961 {A::(2,_derived) = ::C}\ 2962 {A::(2,m) = x y}\ 2963 {B::(2,_derived) = ::C}\ 2964 {B::(2,n) = z}\ 2965 {C::(2,o) = 1 2}\ 2966 {e::e 3}\ 2967 {f::f 3}\ 2968 {g::g 3}\ 2969 {d::e::(3,_derived) = ::d::g}\ 2970 {d::e::(3,m) = x y}\ 2971 {d::f::(3,_derived) = ::d::g}\ 2972 {d::f::(3,n) = z}\ 2973 {d::g::(3,o) = 1 2}\ 2974 {E::E 4}\ 2975 {F::F 4}\ 2976 {G::G 4}\ 2977 {E::(4,_derived) = ::D::G}\ 2978 {E::(4,m) = x y}\ 2979 {F::(4,_derived) = ::D::G}\ 2980 {F::(4,n) = z}\ 2981 {G::(4,o) = 1 2}\ 2982 {E::E 5}\ 2983 {F::F 5}\ 2984 {G::G 5}\ 2985 {D::E::(4,_derived) = ::D::G}\ 2986 {D::E::(4,m) = x y}\ 2987 {D::E::(5,_derived) = ::D::G}\ 2988 {D::E::(5,m) = x y}\ 2989 {D::F::(4,_derived) = ::D::G}\ 2990 {D::F::(4,n) = z}\ 2991 {D::F::(5,_derived) = ::D::G}\ 2992 {D::F::(5,n) = z}\ 2993 {D::G::(4,o) = 1 2}\ 2994 {D::G::(5,o) = 1 2}\ 2995] 2996 2997test stooop-36 { 2998 check multiple inheritance construction order, destruction order and data 2999 deallocation with a common indirect base class 3000 (see test 71 for nested class version) 3001} { 3002 set interpreter [interp create] 3003 $interpreter eval "source $source; namespace import stooop::*" 3004 $interpreter eval $dumpArraysCode 3005 set result [$interpreter eval { 3006 class a {} 3007 proc a::a {this p} { 3008 lappend ::result "a::a $this" 3009 set ($this,m) $p 3010 } 3011 proc a::~a {this} { 3012 lappend ::result "a::~a $this" 3013 } 3014 class b {} 3015 proc b::b {this p} { 3016 lappend ::result "b::b $this" 3017 set ($this,n) $p 3018 } 3019 proc b::~b {this} { 3020 lappend ::result "b::~b $this" 3021 } 3022 class c {} 3023 proc c::c {this p q r} a {$p} b {$q} { 3024 lappend ::result "c::c $this" 3025 set ($this,o) $r 3026 } 3027 proc c::~c {this} { 3028 lappend ::result "c::~c $this" 3029 } 3030 class d {} 3031 proc d::d {this p q r} a {$p} b {$q} { 3032 lappend ::result "d::d $this" 3033 set ($this,p) $p 3034 } 3035 proc d::~d {this} { 3036 lappend ::result "d::~d $this" 3037 } 3038 class e {} 3039 proc e::e {this p q r} c {$p $q $r} d {$q $q $r} { 3040 lappend ::result "e::e $this" 3041 set ($this,q) $q 3042 } 3043 proc e::~e {this} { 3044 lappend ::result "e::~e $this" 3045 } 3046 set o [new e {x y} z {1 2}] 3047 eval lappend ::result [dumpArrays a:: b:: c:: d:: e::] 3048 delete $o 3049 eval lappend ::result [dumpArrays a:: b:: c:: d:: e::] 3050 3051 class A { 3052 proc A {this p} { 3053 lappend ::result "A::A $this" 3054 set ($this,m) $p 3055 } 3056 proc ~A {this} { 3057 lappend ::result "A::~A $this" 3058 } 3059 } 3060 class B { 3061 proc B {this p} { 3062 lappend ::result "B::B $this" 3063 set ($this,n) $p 3064 } 3065 proc ~B {this} { 3066 lappend ::result "B::~B $this" 3067 } 3068 } 3069 class C { 3070 proc C {this p q r} A {$p} B {$q} { 3071 lappend ::result "C::C $this" 3072 set ($this,o) $r 3073 } 3074 proc ~C {this} { 3075 lappend ::result "C::~C $this" 3076 } 3077 } 3078 class D { 3079 proc D {this p q r} A {$p} B {$q} { 3080 lappend ::result "D::D $this" 3081 set ($this,p) $p 3082 } 3083 proc ~D {this} { 3084 lappend ::result "D::~D $this" 3085 } 3086 } 3087 class E { 3088 proc E {this p q r} C {$p $q $r} D {$q $q $r} { 3089 lappend ::result "E::E $this" 3090 set ($this,q) $q 3091 } 3092 proc ~E {this} { 3093 lappend ::result "E::~E $this" 3094 } 3095 } 3096 set o [new E {x y} z {1 2}] 3097 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 3098 delete $o 3099 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 3100 3101 set ::result 3102 }] 3103 interp delete $interpreter 3104 set result 3105} [list\ 3106 {a::a 1}\ 3107 {b::b 1}\ 3108 {c::c 1}\ 3109 {a::a 1}\ 3110 {b::b 1}\ 3111 {d::d 1}\ 3112 {e::e 1}\ 3113 {a::(1,_derived) = ::d}\ 3114 {a::(1,m) = z}\ 3115 {b::(1,_derived) = ::d}\ 3116 {b::(1,n) = z}\ 3117 {c::(1,_derived) = ::e}\ 3118 {c::(1,o) = 1 2}\ 3119 {d::(1,_derived) = ::e}\ 3120 {d::(1,p) = z}\ 3121 {e::(1,q) = z}\ 3122 {e::~e 1}\ 3123 {d::~d 1}\ 3124 {b::~b 1}\ 3125 {a::~a 1}\ 3126 {c::~c 1}\ 3127 {b::~b 1}\ 3128 {a::~a 1}\ 3129 {A::A 2}\ 3130 {B::B 2}\ 3131 {C::C 2}\ 3132 {A::A 2}\ 3133 {B::B 2}\ 3134 {D::D 2}\ 3135 {E::E 2}\ 3136 {A::(2,_derived) = ::D}\ 3137 {A::(2,m) = z}\ 3138 {B::(2,_derived) = ::D}\ 3139 {B::(2,n) = z}\ 3140 {C::(2,_derived) = ::E}\ 3141 {C::(2,o) = 1 2}\ 3142 {D::(2,_derived) = ::E}\ 3143 {D::(2,p) = z}\ 3144 {E::(2,q) = z}\ 3145 {E::~E 2}\ 3146 {D::~D 2}\ 3147 {B::~B 2}\ 3148 {A::~A 2}\ 3149 {C::~C 2}\ 3150 {B::~B 2}\ 3151 {A::~A 2}\ 3152] 3153 3154test stooop-37 { 3155 check that multiply inherited base classes constructors work with variable 3156 number of arguments (see test 72 for nested class version) 3157} { 3158 set interpreter [interp create] 3159 $interpreter eval "source $source; namespace import stooop::*" 3160 $interpreter eval $dumpArraysCode 3161 set result [$interpreter eval { 3162 class a {} 3163 proc a::a {this args} { 3164 lappend ::result "a::a $this $args" 3165 set ($this,m) [lindex $args 0] 3166 } 3167 class b {} 3168 proc b::b {this p} { 3169 lappend ::result "b::b $this $p" 3170 set ($this,n) $p 3171 } 3172 class c {} 3173 proc c::c {this p args} { 3174 lappend ::result "c::c $this $p $args" 3175 set ($this,o) $p 3176 set ($this,p) [lindex $args 0] 3177 } 3178 class d {} 3179 proc d::d {this p args} a {$args} b {$p} c {$p $args} { 3180 lappend ::result "d::d $this $p $args" 3181 set ($this,q) $p 3182 set ($this,r) [lindex $args 0] 3183 } 3184 new d {x y} {1 2} 3 3185 eval lappend ::result [dumpArrays a:: b:: c:: d::] 3186 3187 class A { 3188 proc A {this args} { 3189 lappend ::result "A::A $this $args" 3190 set ($this,m) [lindex $args 0] 3191 } 3192 } 3193 class B { 3194 proc B {this p} { 3195 lappend ::result "B::B $this $p" 3196 set ($this,n) $p 3197 } 3198 } 3199 class C { 3200 proc C {this p args} { 3201 lappend ::result "C::C $this $p $args" 3202 set ($this,o) $p 3203 set ($this,p) [lindex $args 0] 3204 } 3205 } 3206 class D { 3207 proc D {this p args} A {$args} B {$p} C {$p $args} { 3208 lappend ::result "D::D $this $p $args" 3209 set ($this,q) $p 3210 set ($this,r) [lindex $args 0] 3211 } 3212 } 3213 new D {x y} {1 2} 3 3214 eval lappend ::result [dumpArrays A:: B:: C:: D::] 3215 3216 set ::result 3217 }] 3218 interp delete $interpreter 3219 set result 3220} [list\ 3221 {a::a 1 {1 2} 3}\ 3222 {b::b 1 x y}\ 3223 {c::c 1 x y {1 2} 3}\ 3224 {d::d 1 x y {1 2} 3}\ 3225 {a::(1,_derived) = ::d}\ 3226 {a::(1,m) = 1 2}\ 3227 {b::(1,_derived) = ::d}\ 3228 {b::(1,n) = x y}\ 3229 {c::(1,_derived) = ::d}\ 3230 {c::(1,o) = x y}\ 3231 {c::(1,p) = 1 2}\ 3232 {d::(1,q) = x y}\ 3233 {d::(1,r) = 1 2}\ 3234 {A::A 2 {1 2} 3}\ 3235 {B::B 2 x y}\ 3236 {C::C 2 x y {1 2} 3}\ 3237 {D::D 2 x y {1 2} 3}\ 3238 {A::(2,_derived) = ::D}\ 3239 {A::(2,m) = 1 2}\ 3240 {B::(2,_derived) = ::D}\ 3241 {B::(2,n) = x y}\ 3242 {C::(2,_derived) = ::D}\ 3243 {C::(2,o) = x y}\ 3244 {C::(2,p) = 1 2}\ 3245 {D::(2,q) = x y}\ 3246 {D::(2,r) = 1 2}\ 3247] 3248 3249test stooop-38 { 3250 check multiple inheritance destruction order and data deallocation with a 3251 common indirect base class (see test 73 for nested class version) 3252} { 3253 set interpreter [interp create] 3254 $interpreter eval "source $source; namespace import stooop::*" 3255 $interpreter eval $dumpArraysCode 3256 set result [$interpreter eval { 3257 class a {} 3258 proc a::a {this p} { 3259 lappend ::result "a::a $this" 3260 set ($this,m) $p 3261 } 3262 proc a::~a {this} { 3263 lappend ::result "a::~a $this" 3264 } 3265 class b {} 3266 proc b::b {this p} { 3267 lappend ::result "b::b $this" 3268 set ($this,n) $p 3269 } 3270 proc b::~b {this} { 3271 lappend ::result "b::~b $this" 3272 } 3273 class c {} 3274 proc c::c {this p q r} a {$p} b {$q} { 3275 lappend ::result "c::c $this" 3276 set ($this,o) $r 3277 } 3278 proc c::~c {this} { 3279 lappend ::result "c::~c $this" 3280 } 3281 class d {} 3282 proc d::d {this p q r} a {$p} b {$q} { 3283 lappend ::result "d::d $this" 3284 set ($this,p) $p 3285 } 3286 proc d::~d {this} { 3287 lappend ::result "d::~d $this" 3288 } 3289 class e {} 3290 proc e::e {this p q r} c {$p $q $r} d {$q $q $r} { 3291 lappend ::result "e::e $this" 3292 set ($this,q) $q 3293 } 3294 proc e::~e {this} { 3295 lappend ::result "e::~e $this" 3296 } 3297 set o [new e {x y} z {1 2}] 3298 eval lappend ::result [dumpArrays a:: b:: c:: d:: e::] 3299 delete $o 3300 eval lappend ::result [dumpArrays a:: b:: c:: d:: e::] 3301 3302 class A { 3303 proc A {this p} { 3304 lappend ::result "A::A $this" 3305 set ($this,m) $p 3306 } 3307 proc ~A {this} { 3308 lappend ::result "A::~A $this" 3309 } 3310 } 3311 class B { 3312 proc B {this p} { 3313 lappend ::result "B::B $this" 3314 set ($this,n) $p 3315 } 3316 proc ~B {this} { 3317 lappend ::result "B::~B $this" 3318 } 3319 } 3320 class C { 3321 proc C {this p q r} A {$p} B {$q} { 3322 lappend ::result "C::C $this" 3323 set ($this,o) $r 3324 } 3325 proc ~C {this} { 3326 lappend ::result "C::~C $this" 3327 } 3328 } 3329 class D { 3330 proc D {this p q r} A {$p} B {$q} { 3331 lappend ::result "D::D $this" 3332 set ($this,p) $p 3333 } 3334 proc ~D {this} { 3335 lappend ::result "D::~D $this" 3336 } 3337 } 3338 class E { 3339 proc E {this p q r} C {$p $q $r} D {$q $q $r} { 3340 lappend ::result "E::E $this" 3341 set ($this,q) $q 3342 } 3343 proc ~E {this} { 3344 lappend ::result "E::~E $this" 3345 } 3346 } 3347 set o [new E {x y} z {1 2}] 3348 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 3349 delete $o 3350 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 3351 3352 set ::result 3353 }] 3354 interp delete $interpreter 3355 set result 3356} [list\ 3357 {a::a 1}\ 3358 {b::b 1}\ 3359 {c::c 1}\ 3360 {a::a 1}\ 3361 {b::b 1}\ 3362 {d::d 1}\ 3363 {e::e 1}\ 3364 {a::(1,_derived) = ::d}\ 3365 {a::(1,m) = z}\ 3366 {b::(1,_derived) = ::d}\ 3367 {b::(1,n) = z}\ 3368 {c::(1,_derived) = ::e}\ 3369 {c::(1,o) = 1 2}\ 3370 {d::(1,_derived) = ::e}\ 3371 {d::(1,p) = z}\ 3372 {e::(1,q) = z}\ 3373 {e::~e 1}\ 3374 {d::~d 1}\ 3375 {b::~b 1}\ 3376 {a::~a 1}\ 3377 {c::~c 1}\ 3378 {b::~b 1}\ 3379 {a::~a 1}\ 3380 {A::A 2}\ 3381 {B::B 2}\ 3382 {C::C 2}\ 3383 {A::A 2}\ 3384 {B::B 2}\ 3385 {D::D 2}\ 3386 {E::E 2}\ 3387 {A::(2,_derived) = ::D}\ 3388 {A::(2,m) = z}\ 3389 {B::(2,_derived) = ::D}\ 3390 {B::(2,n) = z}\ 3391 {C::(2,_derived) = ::E}\ 3392 {C::(2,o) = 1 2}\ 3393 {D::(2,_derived) = ::E}\ 3394 {D::(2,p) = z}\ 3395 {E::(2,q) = z}\ 3396 {E::~E 2}\ 3397 {D::~D 2}\ 3398 {B::~B 2}\ 3399 {A::~A 2}\ 3400 {C::~C 2}\ 3401 {B::~B 2}\ 3402 {A::~A 2}\ 3403] 3404 3405test stooop-39 { 3406 check that optional arguments in constructors and multiple inheritance work 3407 together (see test 74 for nested class version) 3408} { 3409 set interpreter [interp create] 3410 $interpreter eval "source $source; namespace import stooop::*" 3411 $interpreter eval $dumpArraysCode 3412 set result [$interpreter eval { 3413 class a {} 3414 proc a::a {this {p 0}} { 3415 lappend ::result "a::a $this" 3416 set ($this,m) $p 3417 } 3418 proc a::~a {this} { 3419 lappend ::result "a::~a $this" 3420 } 3421 class b {} 3422 proc b::b {this {p 1}} { 3423 lappend ::result "b::b $this" 3424 set ($this,n) $p 3425 } 3426 proc b::~b {this} { 3427 lappend ::result "b::~b $this" 3428 } 3429 class c {} 3430 proc c::c {this {p 2} {q 3}} a {$p} b {$q} { 3431 lappend ::result "c::c $this" 3432 set ($this,o) $p 3433 set ($this,p) $q 3434 } 3435 proc c::~c {this} { 3436 lappend ::result "c::~c $this" 3437 } 3438 set o [new c {x y} z] 3439 eval lappend ::result [dumpArrays a:: b:: c::] 3440 delete $o 3441 set o [new c] 3442 eval lappend ::result [dumpArrays a:: b:: c::] 3443 3444 class A { 3445 proc A {this {p 0}} { 3446 lappend ::result "A::A $this" 3447 set ($this,m) $p 3448 } 3449 proc ~A {this} { 3450 lappend ::result "A::~A $this" 3451 } 3452 } 3453 class B { 3454 proc B {this {p 1}} { 3455 lappend ::result "B::B $this" 3456 set ($this,n) $p 3457 } 3458 proc ~B {this} { 3459 lappend ::result "B::~B $this" 3460 } 3461 } 3462 class C { 3463 proc C {this {p 2} {q 3}} A {$p} B {$q} { 3464 lappend ::result "C::C $this" 3465 set ($this,o) $p 3466 set ($this,p) $q 3467 } 3468 proc ~C {this} { 3469 lappend ::result "C::~C $this" 3470 } 3471 } 3472 set o [new C {x y} z] 3473 eval lappend ::result [dumpArrays A:: B:: C::] 3474 delete $o 3475 set o [new C] 3476 eval lappend ::result [dumpArrays A:: B:: C::] 3477 3478 set ::result 3479 }] 3480 interp delete $interpreter 3481 set result 3482} [list\ 3483 {a::a 1}\ 3484 {b::b 1}\ 3485 {c::c 1}\ 3486 {a::(1,_derived) = ::c}\ 3487 {a::(1,m) = x y}\ 3488 {b::(1,_derived) = ::c}\ 3489 {b::(1,n) = z}\ 3490 {c::(1,o) = x y}\ 3491 {c::(1,p) = z}\ 3492 {c::~c 1}\ 3493 {b::~b 1}\ 3494 {a::~a 1}\ 3495 {a::a 2}\ 3496 {b::b 2}\ 3497 {c::c 2}\ 3498 {a::(2,_derived) = ::c}\ 3499 {a::(2,m) = 2}\ 3500 {b::(2,_derived) = ::c}\ 3501 {b::(2,n) = 3}\ 3502 {c::(2,o) = 2}\ 3503 {c::(2,p) = 3}\ 3504 {A::A 3}\ 3505 {B::B 3}\ 3506 {C::C 3}\ 3507 {A::(3,_derived) = ::C}\ 3508 {A::(3,m) = x y}\ 3509 {B::(3,_derived) = ::C}\ 3510 {B::(3,n) = z}\ 3511 {C::(3,o) = x y}\ 3512 {C::(3,p) = z}\ 3513 {C::~C 3}\ 3514 {B::~B 3}\ 3515 {A::~A 3}\ 3516 {A::A 4}\ 3517 {B::B 4}\ 3518 {C::C 4}\ 3519 {A::(4,_derived) = ::C}\ 3520 {A::(4,m) = 2}\ 3521 {B::(4,_derived) = ::C}\ 3522 {B::(4,n) = 3}\ 3523 {C::(4,o) = 2}\ 3524 {C::(4,p) = 3}\ 3525] 3526 3527test stooop-40 { 3528 check various virtual procedures configurations in a 3 level deep class 3529 hierarchy (see test 75 for nested class version) 3530} { 3531 set interpreter [interp create] 3532 $interpreter eval "source $source; namespace import stooop::*" 3533 set result [$interpreter eval { 3534 class a {} 3535 proc a::a {this} {} 3536 proc a::~a {this} {} 3537 virtual proc a::f {this p q} {} 3538 virtual proc a::g {this p q} 3539 virtual proc a::h {this p q} { 3540 lappend ::result "a::h $this $p $q" 3541 } 3542 virtual proc a::i {this p q} { 3543 lappend ::result "a::i $this $p $q" 3544 } 3545 virtual proc a::k {this p q} 3546 virtual proc a::l {this p q} { 3547 lappend ::result "a::l $this $p $q" 3548 } 3549 class b {} 3550 proc b::b {this} a {} {} 3551 proc b::~b {this} {} 3552 virtual proc b::f {this p q} { 3553 lappend ::result "b::f $this $p $q" 3554 } 3555 virtual proc b::g {this p q} 3556 virtual proc b::h {this p q} { 3557 lappend ::result "b::h $this $p $q" 3558 } 3559 proc b::i {this p q} { 3560 lappend ::result "b::i $this $p $q" 3561 } 3562 virtual proc b::k {this p q} { 3563 lappend ::result "b::k $this $p $q" 3564 } 3565 virtual proc b::l {this p q} 3566 class c {} 3567 proc c::c {this} b {} {} 3568 proc c::~c {this} {} 3569 proc c::f {this p q} { 3570 lappend ::result "c::f $this $p $q" 3571 } 3572 proc c::g {this p q} { 3573 lappend ::result "c::g $this $p $q" 3574 } 3575 proc c::i {this p q} { 3576 lappend ::result "c::i $this $p $q" 3577 } 3578 proc c::k {this p q} { 3579 lappend ::result "c::k $this $p $q" 3580 } 3581 proc c::l {this p q} { 3582 lappend ::result "c::l $this $p $q" 3583 } 3584 set o [new c] 3585 a::f $o x {y z} 3586 a::g $o x {y z} 3587 a::h $o x {y z} 3588 a::i $o x {y z} 3589 a::k $o x {y z} 3590 a::l $o x {y z} 3591 3592 class A { 3593 proc A {this} {} 3594 proc ~A {this} {} 3595 virtual proc f {this p q} {} 3596 virtual proc g {this p q} 3597 virtual proc h {this p q} { 3598 lappend ::result "A::h $this $p $q" 3599 } 3600 virtual proc i {this p q} { 3601 lappend ::result "A::i $this $p $q" 3602 } 3603 virtual proc k {this p q} 3604 virtual proc l {this p q} { 3605 lappend ::result "A::l $this $p $q" 3606 } 3607 } 3608 class B { 3609 proc B {this} A {} {} 3610 proc ~B {this} {} 3611 virtual proc f {this p q} { 3612 lappend ::result "B::f $this $p $q" 3613 } 3614 virtual proc g {this p q} 3615 virtual proc h {this p q} { 3616 lappend ::result "B::h $this $p $q" 3617 } 3618 proc i {this p q} { 3619 lappend ::result "B::i $this $p $q" 3620 } 3621 virtual proc k {this p q} { 3622 lappend ::result "B::k $this $p $q" 3623 } 3624 virtual proc l {this p q} 3625 } 3626 class C { 3627 proc C {this} B {} {} 3628 proc ~C {this} {} 3629 proc f {this p q} { 3630 lappend ::result "C::f $this $p $q" 3631 } 3632 proc g {this p q} { 3633 lappend ::result "C::g $this $p $q" 3634 } 3635 proc i {this p q} { 3636 lappend ::result "C::i $this $p $q" 3637 } 3638 proc k {this p q} { 3639 lappend ::result "C::k $this $p $q" 3640 } 3641 proc l {this p q} { 3642 lappend ::result "C::l $this $p $q" 3643 } 3644 } 3645 set o [new C] 3646 A::f $o x {y z} 3647 A::g $o x {y z} 3648 A::h $o x {y z} 3649 A::i $o x {y z} 3650 A::k $o x {y z} 3651 A::l $o x {y z} 3652 3653 set ::result 3654 }] 3655 interp delete $interpreter 3656 set result 3657} [list\ 3658 {c::f 1 x y z}\ 3659 {c::g 1 x y z}\ 3660 {b::h 1 x y z}\ 3661 {b::i 1 x y z}\ 3662 {c::k 1 x y z}\ 3663 {c::l 1 x y z}\ 3664 {C::f 2 x y z}\ 3665 {C::g 2 x y z}\ 3666 {B::h 2 x y z}\ 3667 {B::i 2 x y z}\ 3668 {C::k 2 x y z}\ 3669 {C::l 2 x y z}\ 3670] 3671 3672test stooop-41 { 3673 check various virtual procedures with variable number of arguments 3674 configurations in a 3 level deep class hierarchy 3675 (see 76.tcl for nested class version) 3676} { 3677 set interpreter [interp create] 3678 $interpreter eval "source $source; namespace import stooop::*" 3679 set result [$interpreter eval { 3680 class a {} 3681 proc a::a {this} {} 3682 proc a::~a {this} {} 3683 virtual proc a::f {this p args} {} 3684 virtual proc a::g {this p args} 3685 virtual proc a::h {this p args} { 3686 lappend ::result "a::h $this $p $args" 3687 } 3688 virtual proc a::i {this p args} { 3689 lappend ::result "a::i $this $p $args" 3690 } 3691 virtual proc a::k {this p args} 3692 virtual proc a::l {this p args} { 3693 lappend ::result "a::l $this $p $args" 3694 } 3695 class b {} 3696 proc b::b {this} a {} {} 3697 proc b::~b {this} {} 3698 virtual proc b::f {this p args} { 3699 lappend ::result "b::f $this $p $args" 3700 } 3701 virtual proc b::g {this p args} 3702 virtual proc b::h {this p args} { 3703 lappend ::result "b::h $this $p $args" 3704 } 3705 proc b::i {this p args} { 3706 lappend ::result "b::i $this $p $args" 3707 } 3708 virtual proc b::k {this p args} { 3709 lappend ::result "b::k $this $p $args" 3710 } 3711 virtual proc b::l {this p args} 3712 class c {} 3713 proc c::c {this} b {} {} 3714 proc c::~c {this} {} 3715 proc c::f {this p args} { 3716 lappend ::result "c::f $this $p $args" 3717 } 3718 proc c::g {this p args} { 3719 lappend ::result "c::g $this $p $args" 3720 } 3721 proc c::i {this p args} { 3722 lappend ::result "c::i $this $p $args" 3723 } 3724 proc c::k {this p args} { 3725 lappend ::result "c::k $this $p $args" 3726 } 3727 proc c::l {this p args} { 3728 lappend ::result "c::l $this $p $args" 3729 } 3730 set o [new c] 3731 a::f $o x {y z} 3732 a::g $o x {y z} 3733 a::h $o x {y z} 3734 a::i $o x {y z} 3735 a::k $o x {y z} 3736 a::l $o x {y z} 3737 3738 class A { 3739 proc A {this} {} 3740 proc ~A {this} {} 3741 virtual proc f {this p args} {} 3742 virtual proc g {this p args} 3743 virtual proc h {this p args} { 3744 lappend ::result "A::h $this $p $args" 3745 } 3746 virtual proc i {this p args} { 3747 lappend ::result "A::i $this $p $args" 3748 } 3749 virtual proc k {this p args} 3750 virtual proc l {this p args} { 3751 lappend ::result "A::l $this $p $args" 3752 } 3753 } 3754 class B { 3755 proc B {this} A {} {} 3756 proc ~B {this} {} 3757 virtual proc f {this p args} { 3758 lappend ::result "B::f $this $p $args" 3759 } 3760 virtual proc g {this p args} 3761 virtual proc h {this p args} { 3762 lappend ::result "B::h $this $p $args" 3763 } 3764 proc i {this p args} { 3765 lappend ::result "B::i $this $p $args" 3766 } 3767 virtual proc k {this p args} { 3768 lappend ::result "B::k $this $p $args" 3769 } 3770 virtual proc l {this p args} 3771 } 3772 class C { 3773 proc C {this} B {} {} 3774 proc ~C {this} {} 3775 proc f {this p args} { 3776 lappend ::result "C::f $this $p $args" 3777 } 3778 proc g {this p args} { 3779 lappend ::result "C::g $this $p $args" 3780 } 3781 proc i {this p args} { 3782 lappend ::result "C::i $this $p $args" 3783 } 3784 proc k {this p args} { 3785 lappend ::result "C::k $this $p $args" 3786 } 3787 proc l {this p args} { 3788 lappend ::result "C::l $this $p $args" 3789 } 3790 } 3791 set o [new C] 3792 A::f $o x {y z} 3793 A::g $o x {y z} 3794 A::h $o x {y z} 3795 A::i $o x {y z} 3796 A::k $o x {y z} 3797 A::l $o x {y z} 3798 3799 set ::result 3800 }] 3801 interp delete $interpreter 3802 set result 3803} [list\ 3804 {c::f 1 x {y z}}\ 3805 {c::g 1 x {y z}}\ 3806 {b::h 1 x {y z}}\ 3807 {b::i 1 x {y z}}\ 3808 {c::k 1 x {y z}}\ 3809 {c::l 1 x {y z}}\ 3810 {C::f 2 x {y z}}\ 3811 {C::g 2 x {y z}}\ 3812 {B::h 2 x {y z}}\ 3813 {B::i 2 x {y z}}\ 3814 {C::k 2 x {y z}}\ 3815 {C::l 2 x {y z}}\ 3816] 3817 3818test stooop-42 { 3819 check basic cloning operation (see nested class version in test 70) 3820} { 3821 set interpreter [interp create] 3822 $interpreter eval "source $source; namespace import stooop::*" 3823 $interpreter eval $dumpArraysCode 3824 set result [$interpreter eval { 3825 class a {} 3826 proc a::a {this} { 3827 set ($this,x) 0 3828 } 3829 new [new a] 3830 eval lappend ::result [dumpArrays a::] 3831 3832 class A { 3833 proc A {this} { 3834 set ($this,x) 0 3835 } 3836 } 3837 new [new A] 3838 eval lappend ::result [dumpArrays A::] 3839 3840 set ::result 3841 }] 3842 interp delete $interpreter 3843 set result 3844} [list\ 3845 {a::(1,x) = 0}\ 3846 {a::(2,x) = 0}\ 3847 {A::(3,x) = 0}\ 3848 {A::(4,x) = 0}\ 3849] 3850 3851test stooop-43 { 3852 check user defined cloning operation (see nested class version in test 69) 3853} { 3854 set interpreter [interp create] 3855 $interpreter eval "source $source; namespace import stooop::*" 3856 $interpreter eval $dumpArraysCode 3857 set result [$interpreter eval { 3858 class a {} 3859 proc a::a {this} { 3860 set ($this,x) 0 3861 } 3862 proc a::a {this copy} { 3863 set ($this,x) [expr $($copy,x)+1] 3864 } 3865 new [new a] 3866 eval lappend ::result [dumpArrays a::] 3867 3868 class A { 3869 proc A {this} { 3870 set ($this,x) 0 3871 } 3872 proc A {this copy} { 3873 set ($this,x) [expr $($copy,x)+1] 3874 } 3875 } 3876 new [new A] 3877 eval lappend ::result [dumpArrays A::] 3878 3879 set ::result 3880 }] 3881 interp delete $interpreter 3882 set result 3883} [list\ 3884 {a::(1,x) = 0}\ 3885 {a::(2,x) = 1}\ 3886 {A::(3,x) = 0}\ 3887 {A::(4,x) = 1}\ 3888] 3889 3890test stooop-44 { 3891 check cloning operation in a 3 level deep class hierarchy 3892} { 3893 set interpreter [interp create] 3894 $interpreter eval "source $source; namespace import stooop::*" 3895 $interpreter eval $dumpArraysCode 3896 set result [$interpreter eval { 3897 class a {} 3898 proc a::a {this} { 3899 set ($this,x) 0 3900 } 3901 class b {} 3902 proc b::b {this} a {} { 3903 set ($this,y) 1 3904 } 3905 class c {} 3906 proc c::c {this} b {} { 3907 set ($this,z) 2 3908 } 3909 new [new c] 3910 eval lappend ::result [dumpArrays a:: b:: c::] 3911 3912 class A { 3913 proc A {this} { 3914 set ($this,x) 0 3915 } 3916 } 3917 class B { 3918 proc B {this} A {} { 3919 set ($this,y) 1 3920 } 3921 } 3922 class C { 3923 proc C {this} B {} { 3924 set ($this,z) 2 3925 } 3926 } 3927 new [new C] 3928 eval lappend ::result [dumpArrays A:: B:: C::] 3929 3930 class d {} 3931 class d::e {} 3932 proc d::e::e {this} { 3933 set ($this,x) 0 3934 } 3935 class d::f {} 3936 proc d::f::f {this} d::e {} { 3937 set ($this,y) 1 3938 } 3939 class d::g {} 3940 proc d::g::g {this} d::f {} { 3941 set ($this,z) 2 3942 } 3943 new [new d::g] 3944 eval lappend ::result [dumpArrays d::e:: d::f:: d::g::] 3945 3946 class D { 3947 class E { 3948 proc E {this} { 3949 set ($this,x) 0 3950 } 3951 } 3952 class F { 3953 proc F {this} D::E {} { 3954 set ($this,y) 1 3955 } 3956 } 3957 class G { 3958 proc G {this} D::F {} { 3959 set ($this,z) 2 3960 } 3961 } 3962 new [new G] 3963 eval lappend ::result [dumpArrays E:: F:: G::] 3964 } 3965 new [new D::G] 3966 eval lappend ::result [dumpArrays D::E:: D::F:: D::G::] 3967 3968 set ::result 3969 }] 3970 interp delete $interpreter 3971 set result 3972} [list\ 3973 {a::(1,_derived) = ::b}\ 3974 {a::(1,x) = 0}\ 3975 {a::(2,_derived) = ::b}\ 3976 {a::(2,x) = 0}\ 3977 {b::(1,_derived) = ::c}\ 3978 {b::(1,y) = 1}\ 3979 {b::(2,_derived) = ::c}\ 3980 {b::(2,y) = 1}\ 3981 {c::(1,z) = 2}\ 3982 {c::(2,z) = 2}\ 3983 {A::(3,_derived) = ::B}\ 3984 {A::(3,x) = 0}\ 3985 {A::(4,_derived) = ::B}\ 3986 {A::(4,x) = 0}\ 3987 {B::(3,_derived) = ::C}\ 3988 {B::(3,y) = 1}\ 3989 {B::(4,_derived) = ::C}\ 3990 {B::(4,y) = 1}\ 3991 {C::(3,z) = 2}\ 3992 {C::(4,z) = 2}\ 3993 {d::e::(5,_derived) = ::d::f}\ 3994 {d::e::(5,x) = 0}\ 3995 {d::e::(6,_derived) = ::d::f}\ 3996 {d::e::(6,x) = 0}\ 3997 {d::f::(5,_derived) = ::d::g}\ 3998 {d::f::(5,y) = 1}\ 3999 {d::f::(6,_derived) = ::d::g}\ 4000 {d::f::(6,y) = 1}\ 4001 {d::g::(5,z) = 2}\ 4002 {d::g::(6,z) = 2}\ 4003 {E::(7,_derived) = ::D::F}\ 4004 {E::(7,x) = 0}\ 4005 {E::(8,_derived) = ::D::F}\ 4006 {E::(8,x) = 0}\ 4007 {F::(7,_derived) = ::D::G}\ 4008 {F::(7,y) = 1}\ 4009 {F::(8,_derived) = ::D::G}\ 4010 {F::(8,y) = 1}\ 4011 {G::(7,z) = 2}\ 4012 {G::(8,z) = 2}\ 4013 {D::E::(10,_derived) = ::D::F}\ 4014 {D::E::(10,x) = 0}\ 4015 {D::E::(7,_derived) = ::D::F}\ 4016 {D::E::(7,x) = 0}\ 4017 {D::E::(8,_derived) = ::D::F}\ 4018 {D::E::(8,x) = 0}\ 4019 {D::E::(9,_derived) = ::D::F}\ 4020 {D::E::(9,x) = 0}\ 4021 {D::F::(10,_derived) = ::D::G}\ 4022 {D::F::(10,y) = 1}\ 4023 {D::F::(7,_derived) = ::D::G}\ 4024 {D::F::(7,y) = 1}\ 4025 {D::F::(8,_derived) = ::D::G}\ 4026 {D::F::(8,y) = 1}\ 4027 {D::F::(9,_derived) = ::D::G}\ 4028 {D::F::(9,y) = 1}\ 4029 {D::G::(10,z) = 2}\ 4030 {D::G::(7,z) = 2}\ 4031 {D::G::(8,z) = 2}\ 4032 {D::G::(9,z) = 2}\ 4033] 4034 4035test stooop-45 { 4036 check user defined cloning operation error checking 4037} { 4038 set interpreter [interp create] 4039 $interpreter eval "source $source; namespace import stooop::*" 4040 set result [$interpreter eval { 4041 catch { 4042 class a {} 4043 proc a::a {this} { 4044 set ($this,x) 0 4045 } 4046 proc a::a {destination source} {} 4047 new [new a] 4048 } message 4049 lappend ::result $message 4050 4051 catch { 4052 class A { 4053 proc A {this} { 4054 set ($this,x) 0 4055 } 4056 proc A {destination source} {} 4057 } 4058 new [new A] 4059 } message 4060 lappend ::result $message 4061 4062 catch { 4063 class b {} 4064 class b::c {} 4065 proc b::c::c {this} { 4066 set ($this,x) 0 4067 } 4068 proc b::c::c {destination source} {} 4069 new [new b::c] 4070 } message 4071 lappend ::result $message 4072 4073 catch { 4074 class B { 4075 class C { 4076 proc C {this} { 4077 set ($this,x) 0 4078 } 4079 proc C {destination source} {} 4080 } 4081 new [new C] 4082 } 4083 } message 4084 lappend ::result $message 4085 4086 set ::result 4087 }] 4088 interp delete $interpreter 4089 set result 4090} [list\ 4091 {class ::a constructor first argument must be this}\ 4092 {class ::A constructor first argument must be this}\ 4093 {class ::b::c constructor first argument must be this}\ 4094 {class ::B::C constructor first argument must be this}\ 4095] 4096 4097test stooop-46 { 4098 check user defined cloning operation error checking 4099} { 4100 set interpreter [interp create] 4101 $interpreter eval "source $source; namespace import stooop::*" 4102 set result [$interpreter eval { 4103 catch { 4104 class a {} 4105 proc a::a {this} { 4106 set ($this,x) 0 4107 } 4108 proc a::a {this copy dummy} {} 4109 new [new a] 4110 } message 4111 lappend ::result $message 4112 4113 catch { 4114 class A { 4115 proc A {this} { 4116 set ($this,x) 0 4117 } 4118 proc A {this copy dummy} {} 4119 } 4120 new [new A] 4121 } message 4122 lappend ::result $message 4123 4124 catch { 4125 class b {} 4126 class b::c {} 4127 proc b::c::c {this} { 4128 set ($this,x) 0 4129 } 4130 proc b::c::c {this copy dummy} {} 4131 new [new b::c] 4132 } message 4133 lappend ::result $message 4134 4135 catch { 4136 class B { 4137 class C { 4138 proc C {this} { 4139 set ($this,x) 0 4140 } 4141 proc C {this copy dummy} {} 4142 } 4143 new [new C] 4144 } 4145 } message 4146 lappend ::result $message 4147 4148 set ::result 4149 }] 4150 interp delete $interpreter 4151 set result 4152} [list\ 4153 {class ::a copy constructor must have 2 arguments exactly}\ 4154 {class ::A copy constructor must have 2 arguments exactly}\ 4155 {class ::b::c copy constructor must have 2 arguments exactly}\ 4156 {class ::B::C copy constructor must have 2 arguments exactly}\ 4157] 4158 4159test stooop-47 { 4160 check normal and user defined cloning operation with multiple inheritance 4161 and member objects (see test 77 for nested class version) 4162} { 4163 set interpreter [interp create] 4164 $interpreter eval "source $source; namespace import stooop::*" 4165 $interpreter eval $dumpArraysCode 4166 set result [$interpreter eval { 4167 class a {} 4168 proc a::a {this p} { 4169 set ($this,m) $p 4170 } 4171 class b {} 4172 proc b::b {this p} { 4173 set ($this,n) $p 4174 } 4175 class c {} 4176 proc c::c {this p q r} a {$p} b {$q} { 4177 set ($this,o) $r 4178 set ($this,O) [new f] 4179 } 4180 proc c::c {this copy} a {$a::($copy,m)} b 1 { 4181 set ($this,o) $($copy,o) 4182 set ($this,O) [new f] 4183 } 4184 class d {} 4185 proc d::d {this p q r} a {$p} b {$q} { 4186 set ($this,p) $p 4187 } 4188 class e {} 4189 proc e::e {this p q r} c {$p $q $r} d {$q $q $r} { 4190 set ($this,q) $q 4191 } 4192 class f {} 4193 proc f::f {this} { 4194 set ($this,x) 0 4195 } 4196 new [new e {x y} z {1 2}] 4197 eval lappend ::result [dumpArrays a:: b:: c:: d:: e:: f::] 4198 4199 class A { 4200 proc A {this p} { 4201 set ($this,m) $p 4202 } 4203 } 4204 class B { 4205 proc B {this p} { 4206 set ($this,n) $p 4207 } 4208 } 4209 class C { 4210 proc C {this p q r} A {$p} B {$q} { 4211 set ($this,o) $r 4212 set ($this,O) [new F] 4213 } 4214 proc C {this copy} A {$A::($copy,m)} B 1 { 4215 set ($this,o) $($copy,o) 4216 set ($this,O) [new F] 4217 } 4218 } 4219 class D { 4220 proc D {this p q r} A {$p} B {$q} { 4221 set ($this,p) $p 4222 } 4223 } 4224 class E { 4225 proc E {this p q r} C {$p $q $r} D {$q $q $r} { 4226 set ($this,q) $q 4227 } 4228 } 4229 class F { 4230 proc F {this} { 4231 set ($this,x) 0 4232 } 4233 } 4234 new [new E {x y} z {1 2}] 4235 eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::] 4236 4237 set ::result 4238 }] 4239 interp delete $interpreter 4240 set result 4241} [list\ 4242 {a::(1,_derived) = ::d}\ 4243 {a::(1,m) = z}\ 4244 {a::(3,_derived) = ::d}\ 4245 {a::(3,m) = z}\ 4246 {b::(1,_derived) = ::d}\ 4247 {b::(1,n) = z}\ 4248 {b::(3,_derived) = ::d}\ 4249 {b::(3,n) = z}\ 4250 {c::(1,O) = 2}\ 4251 {c::(1,_derived) = ::e}\ 4252 {c::(1,o) = 1 2}\ 4253 {c::(3,O) = 4}\ 4254 {c::(3,_derived) = ::e}\ 4255 {c::(3,o) = 1 2}\ 4256 {d::(1,_derived) = ::e}\ 4257 {d::(1,p) = z}\ 4258 {d::(3,_derived) = ::e}\ 4259 {d::(3,p) = z}\ 4260 {e::(1,q) = z}\ 4261 {e::(3,q) = z}\ 4262 {f::(2,x) = 0}\ 4263 {f::(4,x) = 0}\ 4264 {A::(5,_derived) = ::D}\ 4265 {A::(5,m) = z}\ 4266 {A::(7,_derived) = ::D}\ 4267 {A::(7,m) = z}\ 4268 {B::(5,_derived) = ::D}\ 4269 {B::(5,n) = z}\ 4270 {B::(7,_derived) = ::D}\ 4271 {B::(7,n) = z}\ 4272 {C::(5,O) = 6}\ 4273 {C::(5,_derived) = ::E}\ 4274 {C::(5,o) = 1 2}\ 4275 {C::(7,O) = 8}\ 4276 {C::(7,_derived) = ::E}\ 4277 {C::(7,o) = 1 2}\ 4278 {D::(5,_derived) = ::E}\ 4279 {D::(5,p) = z}\ 4280 {D::(7,_derived) = ::E}\ 4281 {D::(7,p) = z}\ 4282 {E::(5,q) = z}\ 4283 {E::(7,q) = z}\ 4284 {F::(6,x) = 0}\ 4285 {F::(8,x) = 0}\ 4286] 4287 4288test stooop-48 { 4289 check basic cloning operation with array members 4290} { 4291 set interpreter [interp create] 4292 $interpreter eval "source $source; namespace import stooop::*" 4293 $interpreter eval $dumpArraysCode 4294 set result [$interpreter eval { 4295 class a {} 4296 proc a::a {this} { 4297 variable ${this}x 4298 set ${this}x(0) 0 4299 set ($this,y) 1 4300 } 4301 proc a::a {this copy} { 4302 variable ${this}x 4303 variable ${copy}x 4304 array set ${this}x [array get ${copy}x] 4305 set ($this,y) $($copy,y) 4306 } 4307 new [new a] 4308 eval lappend ::result [dumpArrays a:: a::1x a::2x] 4309 4310 class A { 4311 proc A {this} { 4312 variable ${this}x 4313 set ${this}x(0) 0 4314 set ($this,y) 1 4315 } 4316 proc A {this copy} { 4317 variable ${this}x 4318 variable ${copy}x 4319 array set ${this}x [array get ${copy}x] 4320 set ($this,y) $($copy,y) 4321 } 4322 } 4323 new [new A] 4324 eval lappend ::result [dumpArrays A:: A::3x A::4x] 4325 4326 class b {} 4327 class b::c {} 4328 proc b::c::c {this} { 4329 variable ${this}x 4330 set ${this}x(0) 0 4331 set ($this,y) 1 4332 } 4333 proc b::c::c {this copy} { 4334 variable ${this}x 4335 variable ${copy}x 4336 array set ${this}x [array get ${copy}x] 4337 set ($this,y) $($copy,y) 4338 } 4339 new [new b::c] 4340 eval lappend ::result [dumpArrays b::c:: b::c::5x b::c::6x] 4341 4342 class B { 4343 class C { 4344 proc C {this} { 4345 variable ${this}x 4346 set ${this}x(0) 0 4347 set ($this,y) 1 4348 } 4349 proc C {this copy} { 4350 variable ${this}x 4351 variable ${copy}x 4352 array set ${this}x [array get ${copy}x] 4353 set ($this,y) $($copy,y) 4354 } 4355 } 4356 new [new C] 4357 eval lappend ::result [dumpArrays C:: C::7x C::8x] 4358 } 4359 new [new B::C] 4360 eval lappend ::result [dumpArrays B::C:: B::C::9x B::C::10x] 4361 4362 set ::result 4363 }] 4364 interp delete $interpreter 4365 set result 4366} [list\ 4367 {a::(1,y) = 1}\ 4368 {a::(2,y) = 1}\ 4369 {a::1x(0) = 0}\ 4370 {a::2x(0) = 0}\ 4371 {A::(3,y) = 1}\ 4372 {A::(4,y) = 1}\ 4373 {A::3x(0) = 0}\ 4374 {A::4x(0) = 0}\ 4375 {b::c::(5,y) = 1}\ 4376 {b::c::(6,y) = 1}\ 4377 {b::c::5x(0) = 0}\ 4378 {b::c::6x(0) = 0}\ 4379 {C::(7,y) = 1}\ 4380 {C::(8,y) = 1}\ 4381 {C::7x(0) = 0}\ 4382 {C::8x(0) = 0}\ 4383 {B::C::(10,y) = 1}\ 4384 {B::C::(7,y) = 1}\ 4385 {B::C::(8,y) = 1}\ 4386 {B::C::(9,y) = 1}\ 4387 {B::C::9x(0) = 0}\ 4388 {B::C::10x(0) = 0}\ 4389] 4390 4391test stooop-49 { 4392 check user defined cloning operation error checking 4393} { 4394 set interpreter [interp create] 4395 $interpreter eval "source $source; namespace import stooop::*" 4396 set result [$interpreter eval { 4397 catch { 4398 class a {} 4399 proc a::a {this copy} {} 4400 } message 4401 lappend ::result $message 4402 4403 catch { 4404 class A { 4405 proc A {this copy} {} 4406 } 4407 } message 4408 lappend ::result $message 4409 4410 catch { 4411 class b {} 4412 class b::c {} 4413 proc b::c::c {this copy} {} 4414 } message 4415 lappend ::result $message 4416 4417 catch { 4418 class B { 4419 class C { 4420 proc C {this copy} {} 4421 } 4422 } 4423 } message 4424 lappend ::result $message 4425 4426 set ::result 4427 }] 4428 interp delete $interpreter 4429 set result 4430} [list\ 4431 {class ::a copy constructor defined before constructor}\ 4432 {class ::A copy constructor defined before constructor}\ 4433 {class ::b::c copy constructor defined before constructor}\ 4434 {class ::B::C copy constructor defined before constructor}\ 4435] 4436 4437test stooop-50 { 4438 check copy constructor base class(es) initialization errors 4439} { 4440 set interpreter [interp create] 4441 $interpreter eval "source $source; namespace import stooop::*" 4442 set result [$interpreter eval { 4443 catch { 4444 class a {} 4445 proc a::a {this p} {} 4446 class b {} 4447 proc b::b {this} a 0 {} 4448 proc b::b {this copy} {} 4449 new [new b] 4450 } message 4451 lappend ::result $message 4452 4453 catch { 4454 class A { 4455 proc A {this p} {} 4456 } 4457 class B { 4458 proc B {this} A 0 {} 4459 proc B {this copy} {} 4460 } 4461 new [new B] 4462 } message 4463 lappend ::result $message 4464 4465 catch { 4466 class c {} 4467 class c::d {} 4468 proc c::d::d {this p} {} 4469 class c::e {} 4470 proc c::e::e {this} c::d 0 {} 4471 proc c::e::e {this copy} {} 4472 new [new c::e] 4473 } message 4474 lappend ::result $message 4475 4476 catch { 4477 class C { 4478 class D { 4479 proc D {this p} {} 4480 } 4481 class E { 4482 proc E {this} C::D 0 {} 4483 proc E {this copy} {} 4484 } 4485 new [new E] 4486 } 4487 } message 4488 lappend ::result $message 4489 4490 set ::result 4491 }] 4492 interp delete $interpreter 4493 set result 4494} [list\ 4495 {missing base class ::a constructor arguments from class ::b constructor}\ 4496 {missing base class ::A constructor arguments from class ::B constructor}\ 4497 {missing base class ::c::d constructor arguments from class ::c::e constructor}\ 4498 {missing base class ::C::D constructor arguments from class ::C::E constructor}\ 4499] 4500 4501test stooop-51 { 4502 check that multiple declarations that can occur when a class declaration 4503 file is sourced multiple times have no adverse effects 4504} { 4505 set interpreter [interp create] 4506 $interpreter eval "source $source; namespace import stooop::*" 4507 set result [$interpreter eval { 4508 class a {} 4509 proc a::a {this} {} 4510 class b {} 4511 proc b::b {this} a {} {} 4512 proc b::b {this} a {} {} 4513 4514 class A { 4515 proc A {this} {} 4516 } 4517 class B { 4518 proc B {this} A {} {} 4519 } 4520 class B { 4521 proc B {this} A {} {} 4522 } 4523 4524 class c {} 4525 class c::d {} 4526 proc c::d::d {this} {} 4527 class c::e {} 4528 proc c::e::e {this} c::d {} {} 4529 proc c::e::e {this} c::d {} {} 4530 4531 class C { 4532 class D { 4533 proc D {this} {} 4534 } 4535 class E { 4536 proc E {this} C::D {} {} 4537 } 4538 class E { 4539 proc E {this} C::D {} {} 4540 } 4541 } 4542 4543 set ::result {} 4544 }] 4545 interp delete $interpreter 4546 set result 4547} {} 4548 4549test stooop-52 { 4550 check that member procedure cannot be defined before constructor 4551 declaration for we need ancestors for global ancestors array declaration 4552} { 4553 set interpreter [interp create] 4554 $interpreter eval "source $source; namespace import stooop::*" 4555 set result [$interpreter eval { 4556 catch { 4557 class a {} 4558 proc a::p {this} {} 4559 } message 4560 lappend ::result $message 4561 4562 catch { 4563 class A { 4564 proc p {this} {} 4565 } 4566 } message 4567 lappend ::result $message 4568 4569 catch { 4570 class b {} 4571 class b::c {} 4572 proc b::c::p {this} {} 4573 } message 4574 lappend ::result $message 4575 4576 catch { 4577 class B { 4578 class C { 4579 proc p {this} {} 4580 } 4581 } 4582 } message 4583 lappend ::result $message 4584 4585 set ::result 4586 }] 4587 interp delete $interpreter 4588 set result 4589} [list\ 4590 {class ::a member procedure p defined before constructor}\ 4591 {class ::A member procedure p defined before constructor}\ 4592 {class ::b::c member procedure p defined before constructor}\ 4593 {class ::B::C member procedure p defined before constructor}\ 4594] 4595 4596test stooop-53 { 4597 check that embedded command in base class constructor arguments does not 4598 interfere with variable number of arguments processing special case 4599} { 4600 set interpreter [interp create] 4601 $interpreter eval "source $source; namespace import stooop::*" 4602 set result [$interpreter eval { 4603 class a {} 4604 proc a::a {this p args} {} 4605 proc a::~a {this} {} 4606 class b {} 4607 proc b::b {this args} a {[list {}] $args} {} 4608 proc b::b {this args} a {[list {}] $args } {} 4609 proc b::b {this args} a { 4610 [list {}] $args 4611 } {} 4612 4613 class A { 4614 proc A {this p args} {} 4615 proc ~A {this} {} 4616 } 4617 class B { 4618 proc B {this args} A {[list {}] $args} {} 4619 proc B {this args} A {[list {}] $args } {} 4620 proc B {this args} A { 4621 [list {}] $args 4622 } {} 4623 } 4624 4625 class c {} 4626 class c::d {} 4627 proc c::d::d {this p args} {} 4628 proc c::d::~d {this} {} 4629 class c::e {} 4630 proc c::e::e {this args} c::d {[list {}] $args} {} 4631 proc c::e::e {this args} c::d {[list {}] $args } {} 4632 proc c::e::e {this args} c::d { 4633 [list {}] $args 4634 } {} 4635 4636 class C { 4637 class D { 4638 proc D {this p args} {} 4639 proc ~D {this} {} 4640 } 4641 class E { 4642 proc E {this args} C::D {[list {}] $args} {} 4643 proc E {this args} C::D {[list {}] $args } {} 4644 proc E {this args} C::D { 4645 [list {}] $args 4646 } {} 4647 } 4648 } 4649 4650 set ::result {} 4651 }] 4652 interp delete $interpreter 4653 set result 4654} {} 4655 4656test stooop-54 { 4657 check that virtual procedure invocations from base class constructor behave 4658 as in C++ (see test 78 for nested class version) 4659} { 4660 set interpreter [interp create] 4661 $interpreter eval "source $source; namespace import stooop::*" 4662 set result [$interpreter eval { 4663 class a {} 4664 proc a::a {this} { 4665 a::f $this x 4666 a::g $this x {y z} 4667 # pure virtual invocations behavior is undefined 4668 lappend ::result [catch {a::h $this x}] 4669 lappend ::result [catch {a::i $this x {y z}}] 4670 } 4671 proc a::~a {this} {} 4672 virtual proc a::f {this p} { 4673 lappend ::result "a::f $this $p" 4674 } 4675 virtual proc a::g {this p args} { 4676 lappend ::result "a::g $this $p $args" 4677 } 4678 virtual proc a::h {this p} 4679 virtual proc a::i {this p args} 4680 class b {} 4681 proc b::b {this} a {} {} 4682 proc b::~b {this} {} 4683 virtual proc b::f {this p} { 4684 lappend ::result "b::f $this $p" 4685 } 4686 virtual proc b::g {this p args} { 4687 lappend ::result "b::g $this $p $args" 4688 } 4689 virtual proc b::h {this p} { 4690 lappend ::result "b::h $this $p" 4691 } 4692 proc b::i {this p args} { 4693 lappend ::result "b::i $this $p $args" 4694 } 4695 new b 4696 4697 class A { 4698 proc A {this} { 4699 A::f $this x 4700 A::g $this x {y z} 4701 # pure virtual invocations behavior is undefined 4702 lappend ::result [catch {A::h $this x}] 4703 lappend ::result [catch {A::i $this x {y z}}] 4704 } 4705 proc ~A {this} {} 4706 virtual proc f {this p} { 4707 lappend ::result "A::f $this $p" 4708 } 4709 virtual proc g {this p args} { 4710 lappend ::result "A::g $this $p $args" 4711 } 4712 virtual proc h {this p} 4713 virtual proc i {this p args} 4714 } 4715 class B { 4716 proc B {this} A {} {} 4717 proc ~B {this} {} 4718 virtual proc f {this p} { 4719 lappend ::result "B::f $this $p" 4720 } 4721 virtual proc g {this p args} { 4722 lappend ::result "B::g $this $p $args" 4723 } 4724 virtual proc h {this p} { 4725 lappend ::result "B::h $this $p" 4726 } 4727 proc i {this p args} { 4728 lappend ::result "B::i $this $p $args" 4729 } 4730 } 4731 new B 4732 4733 set ::result 4734 }] 4735 interp delete $interpreter 4736 set result 4737} [list\ 4738 {a::f 1 x}\ 4739 {a::g 1 x {y z}}\ 4740 {1}\ 4741 {1}\ 4742 {A::f 2 x}\ 4743 {A::g 2 x {y z}}\ 4744 {1}\ 4745 {1}\ 4746] 4747 4748test stooop-55 { 4749 check that procedure invocation on variable arguments in derived class base 4750 class constructor arguments works 4751} { 4752 set interpreter [interp create] 4753 $interpreter eval "source $source; namespace import stooop::*" 4754 $interpreter eval $dumpArraysCode 4755 set result [$interpreter eval { 4756 class a {} 4757 proc a::a {this p args} { 4758 lappend ::result "a::a $this $p $args" 4759 set ($this,m) [lindex $args 0] 4760 } 4761 proc a::~a {this} { 4762 lappend ::result "a::~a $this" 4763 } 4764 class b {} 4765 proc b::b {this p args} a {$p [concat $args]} { 4766 lappend ::result "b::b $this $p $args" 4767 set ($this,n) [lindex $args 0] 4768 } 4769 proc b::~b {this} { 4770 lappend ::result "b::~b $this" 4771 } 4772 new b {x y} {1 2} 3 4773 eval lappend ::result [dumpArrays a:: b::] 4774 4775 class A { 4776 proc A {this p args} { 4777 lappend ::result "A::A $this $p $args" 4778 set ($this,m) [lindex $args 0] 4779 } 4780 proc ~A {this} { 4781 lappend ::result "A::~A $this" 4782 } 4783 } 4784 class B { 4785 proc B {this p args} A {$p [concat $args]} { 4786 lappend ::result "B::B $this $p $args" 4787 set ($this,n) [lindex $args 0] 4788 } 4789 proc ~B {this} { 4790 lappend ::result "B::~B $this" 4791 } 4792 } 4793 new B {x y} {1 2} 3 4794 eval lappend ::result [dumpArrays A:: B::] 4795 4796 class c {} 4797 class c::d {} 4798 proc c::d::d {this p args} { 4799 lappend ::result "d::d $this $p $args" 4800 set ($this,m) [lindex $args 0] 4801 } 4802 proc c::d::~d {this} { 4803 lappend ::result "d::~d $this" 4804 } 4805 class c::e {} 4806 proc c::e::e {this p args} c::d {$p [concat $args]} { 4807 lappend ::result "e::e $this $p $args" 4808 set ($this,n) [lindex $args 0] 4809 } 4810 proc c::e::~e {this} { 4811 lappend ::result "e::~e $this" 4812 } 4813 new c::e {x y} {1 2} 3 4814 eval lappend ::result [dumpArrays c::d:: c::e::] 4815 4816 class C { 4817 class D { 4818 proc D {this p args} { 4819 lappend ::result "D::D $this $p $args" 4820 set ($this,m) [lindex $args 0] 4821 } 4822 proc ~D {this} { 4823 lappend ::result "D::~D $this" 4824 } 4825 } 4826 class E { 4827 proc E {this p args} C::D {$p [concat $args]} { 4828 lappend ::result "E::E $this $p $args" 4829 set ($this,n) [lindex $args 0] 4830 } 4831 proc ~E {this} { 4832 lappend ::result "E::~E $this" 4833 } 4834 } 4835 new E {x y} {1 2} 3 4836 eval lappend ::result [dumpArrays D:: E::] 4837 } 4838 new C::E {x y} {1 2} 3 4839 eval lappend ::result [dumpArrays C::D:: C::E::] 4840 4841 set ::result 4842 }] 4843 interp delete $interpreter 4844 set result 4845} [list\ 4846 {a::a 1 x y {1 2} 3}\ 4847 {b::b 1 x y {1 2} 3}\ 4848 {a::(1,_derived) = ::b}\ 4849 {a::(1,m) = 1 2}\ 4850 {b::(1,n) = 1 2}\ 4851 {A::A 2 x y {1 2} 3}\ 4852 {B::B 2 x y {1 2} 3}\ 4853 {A::(2,_derived) = ::B}\ 4854 {A::(2,m) = 1 2}\ 4855 {B::(2,n) = 1 2}\ 4856 {d::d 3 x y {1 2} 3}\ 4857 {e::e 3 x y {1 2} 3}\ 4858 {c::d::(3,_derived) = ::c::e}\ 4859 {c::d::(3,m) = 1 2}\ 4860 {c::e::(3,n) = 1 2}\ 4861 {D::D 4 x y {1 2} 3}\ 4862 {E::E 4 x y {1 2} 3}\ 4863 {D::(4,_derived) = ::C::E}\ 4864 {D::(4,m) = 1 2}\ 4865 {E::(4,n) = 1 2}\ 4866 {D::D 5 x y {1 2} 3}\ 4867 {E::E 5 x y {1 2} 3}\ 4868 {C::D::(4,_derived) = ::C::E}\ 4869 {C::D::(4,m) = 1 2}\ 4870 {C::D::(5,_derived) = ::C::E}\ 4871 {C::D::(5,m) = 1 2}\ 4872 {C::E::(4,n) = 1 2}\ 4873 {C::E::(5,n) = 1 2}\ 4874] 4875 4876test stooop-56 { 4877 check that procedure invocation on variable arguments in derived class base 4878 class constructor arguments works 4879} { 4880 set interpreter [interp create] 4881 $interpreter eval "source $source; namespace import stooop::*" 4882 $interpreter eval $dumpArraysCode 4883 set result [$interpreter eval { 4884 class a {} 4885 proc a::a {this args} { 4886 lappend ::result "a::a $this $args" 4887 set ($this,m) [lindex $args 0] 4888 } 4889 proc a::~a {this} { 4890 lappend ::result "a::~a $this" 4891 } 4892 class b {} 4893 proc b::b {this args} a {[concat $args]} { 4894 lappend ::result "b::b $this $args" 4895 set ($this,n) [lindex $args 0] 4896 } 4897 proc b::~b {this} { 4898 lappend ::result "b::~b $this" 4899 } 4900 new b {1 2} 3 4901 eval lappend ::result [dumpArrays a:: b::] 4902 4903 class A { 4904 proc A {this args} { 4905 lappend ::result "A::A $this $args" 4906 set ($this,m) [lindex $args 0] 4907 } 4908 proc ~A {this} { 4909 lappend ::result "A::~A $this" 4910 } 4911 } 4912 class B { 4913 proc B {this args} A {[concat $args]} { 4914 lappend ::result "B::B $this $args" 4915 set ($this,n) [lindex $args 0] 4916 } 4917 proc ~B {this} { 4918 lappend ::result "B::~B $this" 4919 } 4920 } 4921 new B {1 2} 3 4922 eval lappend ::result [dumpArrays A:: B::] 4923 4924 class c {} 4925 class c::d {} 4926 proc c::d::d {this args} { 4927 lappend ::result "d::d $this $args" 4928 set ($this,m) [lindex $args 0] 4929 } 4930 proc c::d::~d {this} { 4931 lappend ::result "d::~d $this" 4932 } 4933 class c::e {} 4934 proc c::e::e {this args} c::d {[concat $args]} { 4935 lappend ::result "e::e $this $args" 4936 set ($this,n) [lindex $args 0] 4937 } 4938 proc c::e::~e {this} { 4939 lappend ::result "e::~e $this" 4940 } 4941 new c::e {1 2} 3 4942 eval lappend ::result [dumpArrays c::d:: c::e::] 4943 4944 class C { 4945 class D { 4946 proc D {this args} { 4947 lappend ::result "D::D $this $args" 4948 set ($this,m) [lindex $args 0] 4949 } 4950 proc ~D {this} { 4951 lappend ::result "D::~D $this" 4952 } 4953 } 4954 class E { 4955 proc E {this args} C::D {[concat $args]} { 4956 lappend ::result "E::E $this $args" 4957 set ($this,n) [lindex $args 0] 4958 } 4959 proc ~E {this} { 4960 lappend ::result "E::~E $this" 4961 } 4962 } 4963 new E {1 2} 3 4964 eval lappend ::result [dumpArrays D:: E::] 4965 } 4966 new C::E {1 2} 3 4967 eval lappend ::result [dumpArrays C::D:: C::E::] 4968 4969 set ::result 4970 }] 4971 interp delete $interpreter 4972 set result 4973} [list\ 4974 {a::a 1 {1 2} 3}\ 4975 {b::b 1 {1 2} 3}\ 4976 {a::(1,_derived) = ::b}\ 4977 {a::(1,m) = 1 2}\ 4978 {b::(1,n) = 1 2}\ 4979 {A::A 2 {1 2} 3}\ 4980 {B::B 2 {1 2} 3}\ 4981 {A::(2,_derived) = ::B}\ 4982 {A::(2,m) = 1 2}\ 4983 {B::(2,n) = 1 2}\ 4984 {d::d 3 {1 2} 3}\ 4985 {e::e 3 {1 2} 3}\ 4986 {c::d::(3,_derived) = ::c::e}\ 4987 {c::d::(3,m) = 1 2}\ 4988 {c::e::(3,n) = 1 2}\ 4989 {D::D 4 {1 2} 3}\ 4990 {E::E 4 {1 2} 3}\ 4991 {D::(4,_derived) = ::C::E}\ 4992 {D::(4,m) = 1 2}\ 4993 {E::(4,n) = 1 2}\ 4994 {D::D 5 {1 2} 3}\ 4995 {E::E 5 {1 2} 3}\ 4996 {C::D::(4,_derived) = ::C::E}\ 4997 {C::D::(4,m) = 1 2}\ 4998 {C::D::(5,_derived) = ::C::E}\ 4999 {C::D::(5,m) = 1 2}\ 5000 {C::E::(4,n) = 1 2}\ 5001 {C::E::(5,n) = 1 2}\ 5002] 5003 5004test stooop-57 { 5005 check that variable arguments in derived class work with base class 5006 constructor constant arguments 5007} { 5008 set interpreter [interp create] 5009 $interpreter eval "source $source; namespace import stooop::*" 5010 $interpreter eval $dumpArraysCode 5011 set result [$interpreter eval { 5012 class a {} 5013 proc a::a {this p} { 5014 lappend ::result "a::a $this $p" 5015 set ($this,m) $p 5016 } 5017 proc a::~a {this} {} 5018 class b {} 5019 proc b::b {this p args} a {$args} { 5020 lappend ::result "b::b $this $p $args" 5021 } 5022 proc b::~b {this} {} 5023 new b {x y} {1 2} 3 5024 eval lappend ::result [dumpArrays a::] 5025 5026 class A { 5027 proc A {this p} { 5028 lappend ::result "A::A $this $p" 5029 set ($this,m) $p 5030 } 5031 proc ~A {this} {} 5032 } 5033 class B { 5034 proc B {this p args} A {$args} { 5035 lappend ::result "B::B $this $p $args" 5036 } 5037 proc ~B {this} {} 5038 } 5039 new B {x y} {1 2} 3 5040 eval lappend ::result [dumpArrays A::] 5041 5042 class c {} 5043 class c::d {} 5044 proc c::d::d {this p} { 5045 lappend ::result "d::d $this $p" 5046 set ($this,m) $p 5047 } 5048 proc c::d::~d {this} {} 5049 class c::e {} 5050 proc c::e::e {this p args} c::d {$args} { 5051 lappend ::result "e::e $this $p $args" 5052 } 5053 proc c::e::~e {this} {} 5054 new c::e {x y} {1 2} 3 5055 eval lappend ::result [dumpArrays c::d::] 5056 5057 class C { 5058 class D { 5059 proc D {this p} { 5060 lappend ::result "D::D $this $p" 5061 set ($this,m) $p 5062 } 5063 proc ~D {this} {} 5064 } 5065 class E { 5066 proc E {this p args} C::D {$args} { 5067 lappend ::result "E::E $this $p $args" 5068 } 5069 proc ~E {this} {} 5070 } 5071 new E {x y} {1 2} 3 5072 eval lappend ::result [dumpArrays D::] 5073 } 5074 new C::E {x y} {1 2} 3 5075 eval lappend ::result [dumpArrays C::D::] 5076 5077 set ::result 5078 }] 5079 interp delete $interpreter 5080 set result 5081} [list\ 5082 {a::a 1 {1 2} 3}\ 5083 {b::b 1 x y {1 2} 3}\ 5084 {a::(1,_derived) = ::b}\ 5085 {a::(1,m) = {1 2} 3}\ 5086 {A::A 2 {1 2} 3}\ 5087 {B::B 2 x y {1 2} 3}\ 5088 {A::(2,_derived) = ::B}\ 5089 {A::(2,m) = {1 2} 3}\ 5090 {d::d 3 {1 2} 3}\ 5091 {e::e 3 x y {1 2} 3}\ 5092 {c::d::(3,_derived) = ::c::e}\ 5093 {c::d::(3,m) = {1 2} 3}\ 5094 {D::D 4 {1 2} 3}\ 5095 {E::E 4 x y {1 2} 3}\ 5096 {D::(4,_derived) = ::C::E}\ 5097 {D::(4,m) = {1 2} 3}\ 5098 {D::D 5 {1 2} 3}\ 5099 {E::E 5 x y {1 2} 3}\ 5100 {C::D::(4,_derived) = ::C::E}\ 5101 {C::D::(4,m) = {1 2} 3}\ 5102 {C::D::(5,_derived) = ::C::E}\ 5103 {C::D::(5,m) = {1 2} 3}\ 5104] 5105 5106test stooop-58 { 5107 check that variable arguments in derived class work with base class 5108 constructor constant arguments 5109} { 5110 set interpreter [interp create] 5111 $interpreter eval "source $source; namespace import stooop::*" 5112 $interpreter eval $dumpArraysCode 5113 set result [$interpreter eval { 5114 class a {} 5115 proc a::a {this p args} { 5116 lappend ::result "a::a $this $p $args" 5117 set ($this,m) [lindex $args 0] 5118 } 5119 proc a::~a {this} {} 5120 class b {} 5121 proc b::b {this p args} a {$p z} { 5122 lappend ::result "b::b $this $p $args" 5123 set ($this,n) [lindex $args 0] 5124 } 5125 proc b::~b {this} {} 5126 new b {x y} {1 2} 3 5127 eval lappend ::result [dumpArrays a::] 5128 5129 class A { 5130 proc A {this p args} { 5131 lappend ::result "A::A $this $p $args" 5132 set ($this,m) [lindex $args 0] 5133 } 5134 proc ~A {this} {} 5135 } 5136 class B { 5137 proc B {this p args} A {$p z} { 5138 lappend ::result "B::B $this $p $args" 5139 set ($this,n) [lindex $args 0] 5140 } 5141 proc ~B {this} {} 5142 } 5143 new B {x y} {1 2} 3 5144 eval lappend ::result [dumpArrays A::] 5145 5146 class c {} 5147 class c::d {} 5148 proc c::d::d {this p args} { 5149 lappend ::result "d::d $this $p $args" 5150 set ($this,m) [lindex $args 0] 5151 } 5152 proc c::d::~d {this} {} 5153 class c::e {} 5154 proc c::e::e {this p args} c::d {$p z} { 5155 lappend ::result "e::e $this $p $args" 5156 set ($this,n) [lindex $args 0] 5157 } 5158 proc c::e::~e {this} {} 5159 new c::e {x y} {1 2} 3 5160 eval lappend ::result [dumpArrays c::d::] 5161 5162 class C { 5163 class D { 5164 proc D {this p args} { 5165 lappend ::result "D::D $this $p $args" 5166 set ($this,m) [lindex $args 0] 5167 } 5168 proc ~D {this} {} 5169 } 5170 class E { 5171 proc E {this p args} C::D {$p z} { 5172 lappend ::result "E::E $this $p $args" 5173 set ($this,n) [lindex $args 0] 5174 } 5175 proc ~E {this} {} 5176 } 5177 new E {x y} {1 2} 3 5178 eval lappend ::result [dumpArrays D::] 5179 } 5180 new C::E {x y} {1 2} 3 5181 eval lappend ::result [dumpArrays C::D::] 5182 5183 set ::result 5184 }] 5185 interp delete $interpreter 5186 set result 5187} [list\ 5188 {a::a 1 x y z}\ 5189 {b::b 1 x y {1 2} 3}\ 5190 {a::(1,_derived) = ::b}\ 5191 {a::(1,m) = z}\ 5192 {A::A 2 x y z}\ 5193 {B::B 2 x y {1 2} 3}\ 5194 {A::(2,_derived) = ::B}\ 5195 {A::(2,m) = z}\ 5196 {d::d 3 x y z}\ 5197 {e::e 3 x y {1 2} 3}\ 5198 {c::d::(3,_derived) = ::c::e}\ 5199 {c::d::(3,m) = z}\ 5200 {D::D 4 x y z}\ 5201 {E::E 4 x y {1 2} 3}\ 5202 {D::(4,_derived) = ::C::E}\ 5203 {D::(4,m) = z}\ 5204 {D::D 5 x y z}\ 5205 {E::E 5 x y {1 2} 3}\ 5206 {C::D::(4,_derived) = ::C::E}\ 5207 {C::D::(4,m) = z}\ 5208 {C::D::(5,_derived) = ::C::E}\ 5209 {C::D::(5,m) = z}\ 5210] 5211 5212test stooop-59 { 5213 check that construction, copy and deletion work transparently for variable 5214 context 5215} { 5216 set interpreter [interp create] 5217 $interpreter eval "source $source; namespace import stooop::*" 5218 $interpreter eval $dumpArraysCode 5219 set result [$interpreter eval { 5220 class a {} 5221 proc a::a {this p} { 5222 upvar $p q 5223 eval lappend ::result [dumpArrays q] 5224 } 5225 proc a::a {this copy} { 5226 upvar d q 5227 eval lappend ::result [dumpArrays q] 5228 } 5229 proc a::~a {this} { 5230 upvar d q 5231 eval lappend ::result [dumpArrays q] 5232 } 5233 set d(0) 0 5234 set o [new a d] 5235 new $o 5236 delete $o 5237 5238 class A { 5239 proc A {this p} { 5240 upvar $p q 5241 eval lappend ::result [dumpArrays q] 5242 } 5243 proc A {this copy} { 5244 upvar d q 5245 eval lappend ::result [dumpArrays q] 5246 } 5247 proc ~A {this} { 5248 upvar d q 5249 eval lappend ::result [dumpArrays q] 5250 } 5251 } 5252 set d(0) 1 5253 set o [new A d] 5254 new $o 5255 delete $o 5256 5257 class b {} 5258 class b::c {} 5259 proc b::c::c {this p} { 5260 upvar $p q 5261 eval lappend ::result [dumpArrays q] 5262 } 5263 proc b::c::c {this copy} { 5264 upvar d q 5265 eval lappend ::result [dumpArrays q] 5266 } 5267 proc b::c::~c {this} { 5268 upvar d q 5269 eval lappend ::result [dumpArrays q] 5270 } 5271 set d(0) 2 5272 set o [new b::c d] 5273 new $o 5274 delete $o 5275 5276 class B { 5277 class C { 5278 proc C {this p} { 5279 upvar $p q 5280 eval lappend ::result [dumpArrays q] 5281 } 5282 proc C {this copy} { 5283 upvar d q 5284 eval lappend ::result [dumpArrays q] 5285 } 5286 proc ~C {this} { 5287 upvar d q 5288 eval lappend ::result [dumpArrays q] 5289 } 5290 } 5291 set d(0) 3 5292 set o [new C d] 5293 new $o 5294 delete $o 5295 } 5296 set d(0) 4 5297 set o [new B::C d] 5298 new $o 5299 delete $o 5300 5301 set ::result 5302 }] 5303 interp delete $interpreter 5304 set result 5305} [list\ 5306 {q(0) = 0}\ 5307 {q(0) = 0}\ 5308 {q(0) = 0}\ 5309 {q(0) = 1}\ 5310 {q(0) = 1}\ 5311 {q(0) = 1}\ 5312 {q(0) = 2}\ 5313 {q(0) = 2}\ 5314 {q(0) = 2}\ 5315 {q(0) = 3}\ 5316 {q(0) = 3}\ 5317 {q(0) = 3}\ 5318 {q(0) = 4}\ 5319 {q(0) = 4}\ 5320 {q(0) = 4}\ 5321] 5322 5323test stooop-60 { 5324 undocumented 5325} { 5326 set interpreter [interp create] 5327 $interpreter eval "source $source; namespace import stooop::*" 5328 set result [$interpreter eval { 5329 catch { 5330 class a {} 5331 proc a::a::p {this} {} 5332 } message 5333 lappend ::result $message 5334 5335 catch { 5336 class A { 5337 proc A::p {this} {} 5338 } 5339 } message 5340 lappend ::result $message 5341 5342 catch { 5343 class b {} 5344 class b::c {} 5345 proc b::c::c::p {this} {} 5346 } message 5347 lappend ::result $message 5348 5349 catch { 5350 class B { 5351 class C { 5352 proc C::p {this} {} 5353 } 5354 } 5355 } message 5356 lappend ::result $message 5357 5358 set ::result 5359 }] 5360 interp delete $interpreter 5361 set result 5362} [list\ 5363 {can't create procedure "a::a::p": unknown namespace}\ 5364 {can't create procedure "A::p": unknown namespace}\ 5365 {can't create procedure "b::c::c::p": unknown namespace}\ 5366 {can't create procedure "C::p": unknown namespace}\ 5367] 5368 5369test stooop-61 { 5370 undocumented 5371} { 5372 set interpreter [interp create] 5373 $interpreter eval "source $source; namespace import stooop::*" 5374 set result [$interpreter eval { 5375 catch {new 1} ::result 5376 set ::result 5377 }] 5378 interp delete $interpreter 5379 set result 5380} {invalid object identifier 1} 5381 5382test stooop-62 { 5383 check that multiple class definitions for the same class are possible 5384} { 5385 set interpreter [interp create] 5386 $interpreter eval "source $source; namespace import stooop::*" 5387 set result [$interpreter eval { 5388 class a { 5389 proc a {this} {} 5390 proc ~a {this} {} 5391 } 5392 proc a::p {this p} { 5393 set ($this,m) $p 5394 } 5395 class a { 5396 proc q {this} { 5397 lappend ::result $($this,m) 5398 } 5399 } 5400 set o [new a] 5401 a::p $o 0 5402 a::q $o 5403 5404 class b { 5405 class c { 5406 proc c {this} {} 5407 proc ~c {this} {} 5408 } 5409 proc c::p {this p} { 5410 set ($this,m) $p 5411 } 5412 class c { 5413 proc q {this} { 5414 lappend ::result $($this,m) 5415 } 5416 } 5417 set o [new c] 5418 c::p $o 0 5419 c::q $o 5420 } 5421 set o [new b::c] 5422 b::c::p $o 0 5423 b::c::q $o 5424 5425 set ::result 5426 }] 5427 interp delete $interpreter 5428 set result 5429} [list\ 5430 0\ 5431 0\ 5432 0\ 5433] 5434 5435test stooop-63 { 5436 check that non qualified procedure invocation in derived class base class 5437 constructor arguments works 5438} { 5439 set interpreter [interp create] 5440 $interpreter eval "source $source; namespace import stooop::*" 5441 $interpreter eval $dumpArraysCode 5442 set result [$interpreter eval { 5443 proc p {p} {error "::p invoked"} 5444 5445 class a {} 5446 proc a::a {this p} { 5447 set ($this,m) $p 5448 } 5449 proc a::~a {this} {} 5450 class b {} 5451 proc b::b {this p} a {[p $p]} { 5452 set ($this,n) $p 5453 } 5454 proc b::~b {this} {} 5455 proc b::p {p} { 5456 return [incr p] 5457 } 5458 new b 0 5459 eval lappend ::result [dumpArrays a:: b::] 5460 5461 class A { 5462 proc A {this p} { 5463 set ($this,m) $p 5464 } 5465 proc ~A {this} {} 5466 } 5467 class B { 5468 proc B {this p} A {[p $p]} { 5469 set ($this,n) $p 5470 } 5471 proc ~B {this} {} 5472 proc p {p} { 5473 return [incr p] 5474 } 5475 } 5476 new B 0 5477 eval lappend ::result [dumpArrays A:: B::] 5478 5479 class c {} 5480 class c::d {} 5481 proc c::d::d {this p} { 5482 set ($this,m) $p 5483 } 5484 proc c::d::~d {this} {} 5485 class c::e {} 5486 proc c::e::e {this p} c::d {[p $p]} { 5487 set ($this,n) $p 5488 } 5489 proc c::e::~e {this} {} 5490 proc c::e::p {p} { 5491 return [incr p] 5492 } 5493 new c::e 0 5494 eval lappend ::result [dumpArrays c::d:: c::e::] 5495 5496 class C { 5497 class D { 5498 proc D {this p} { 5499 set ($this,m) $p 5500 } 5501 proc ~D {this} {} 5502 } 5503 class E { 5504 proc E {this p} C::D {[p $p]} { 5505 set ($this,n) $p 5506 } 5507 proc ~E {this} {} 5508 proc p {p} { 5509 return [incr p] 5510 } 5511 } 5512 new E 0 5513 eval lappend ::result [dumpArrays D:: E::] 5514 } 5515 new C::E 0 5516 eval lappend ::result [dumpArrays C::D:: C::E::] 5517 5518 set ::result 5519 }] 5520 interp delete $interpreter 5521 set result 5522} [list\ 5523 {a::(1,_derived) = ::b}\ 5524 {a::(1,m) = 1}\ 5525 {b::(1,n) = 0}\ 5526 {A::(2,_derived) = ::B}\ 5527 {A::(2,m) = 1}\ 5528 {B::(2,n) = 0}\ 5529 {c::d::(3,_derived) = ::c::e}\ 5530 {c::d::(3,m) = 1}\ 5531 {c::e::(3,n) = 0}\ 5532 {D::(4,_derived) = ::C::E}\ 5533 {D::(4,m) = 1}\ 5534 {E::(4,n) = 0}\ 5535 {C::D::(4,_derived) = ::C::E}\ 5536 {C::D::(4,m) = 1}\ 5537 {C::D::(5,_derived) = ::C::E}\ 5538 {C::D::(5,m) = 1}\ 5539 {C::E::(4,n) = 0}\ 5540 {C::E::(5,n) = 0}\ 5541] 5542 5543test stooop-64 { 5544 check static member initialization within class body 5545} { 5546 set interpreter [interp create] 5547 $interpreter eval "source $source; namespace import stooop::*" 5548 $interpreter eval $dumpArraysCode 5549 set result [$interpreter eval { 5550 class a { 5551 set (l) {} 5552 } 5553 proc a::a {this} { 5554 lappend (l) $this 5555 } 5556 proc a::~a {this} {} 5557 new a 5558 new a 5559 eval lappend ::result [dumpArrays a::] 5560 5561 class A { 5562 set A::(l) {} 5563 proc A {this} { 5564 lappend (l) $this 5565 } 5566 proc ~A {this} {} 5567 } 5568 new A 5569 new A 5570 eval lappend ::result [dumpArrays A::] 5571 5572 class b {} 5573 class b::c { 5574 set (l) {} 5575 } 5576 proc b::c::c {this} { 5577 lappend (l) $this 5578 } 5579 proc b::c::~c {this} {} 5580 new b::c 5581 new b::c 5582 eval lappend ::result [dumpArrays b::c::] 5583 5584 class B { 5585 class C { 5586 set (l) {} 5587 proc C {this} { 5588 lappend (l) $this 5589 } 5590 proc ~C {this} {} 5591 } 5592 new C 5593 new C 5594 eval lappend ::result [dumpArrays C::] 5595 } 5596 new B::C 5597 new B::C 5598 eval lappend ::result [dumpArrays B::C::] 5599 5600 set ::result 5601 }] 5602 interp delete $interpreter 5603 set result 5604} [list\ 5605 {a::(l) = 1 2}\ 5606 {A::(l) = 3 4}\ 5607 {b::c::(l) = 5 6}\ 5608 {C::(l) = 7 8}\ 5609 {B::C::(l) = 7 8 9 10}\ 5610] 5611 5612test stooop-65 { 5613 undocumented 5614} { 5615 set interpreter [interp create] 5616 $interpreter eval "source $source; namespace import stooop::*" 5617 set result [$interpreter eval { 5618 catch { 5619 class a {} 5620 proc a::a {this} {} 5621 virtual proc a::a::p {this} {} 5622 } message 5623 lappend ::result $message 5624 5625 catch { 5626 class A { 5627 proc A {this} {} 5628 virtual proc A::p {this} {} 5629 } 5630 } message 5631 lappend ::result $message 5632 5633 catch { 5634 class b {} 5635 class b::c {} 5636 proc b::c::c {this} {} 5637 virtual proc b::c::c::p {this} {} 5638 } message 5639 lappend ::result $message 5640 5641 catch { 5642 class B { 5643 class C { 5644 proc C {this} {} 5645 virtual proc C::p {this} {} 5646 } 5647 } 5648 } message 5649 lappend ::result $message 5650 5651 set ::result 5652 }] 5653 interp delete $interpreter 5654 set result 5655} [list\ 5656 {procedure ::a::a::p class ::a::a is unknown}\ 5657 {procedure ::A::A::p class ::A::A is unknown}\ 5658 {procedure ::b::c::c::p class ::b::c::c is unknown}\ 5659 {procedure ::B::C::C::p class ::B::C::C is unknown}\ 5660] 5661 5662test stooop-66 { 5663 check that nested class procedure definition works inside and outside 5664 nested class or namespace 5665} { 5666 set interpreter [interp create] 5667 $interpreter eval "source $source; namespace import stooop::*" 5668 set result [$interpreter eval { 5669 class a { 5670 class b { 5671 proc b {this} {} 5672 proc p {this} { 5673 lappend ::result 1 5674 } 5675 } 5676 set o [new b] 5677 b::p $o 5678 proc b::p {this} { 5679 lappend ::result 2 5680 } 5681 b::p $o 5682 } 5683 5684 namespace eval c { 5685 class b { 5686 proc b {this} {} 5687 proc p {this} { 5688 lappend ::result 3 5689 } 5690 } 5691 set o [new b] 5692 b::p $o 5693 proc b::p {this} { 5694 lappend ::result 4 5695 } 5696 b::p $o 5697 } 5698 5699 set o [new a::b] 5700 proc a::b::p {this} { 5701 lappend ::result 5 5702 } 5703 a::b::p $o 5704 5705 set o [new c::b] 5706 proc c::b::p {this} { 5707 lappend ::result 6 5708 } 5709 c::b::p $o 5710 5711 set ::result 5712 }] 5713 interp delete $interpreter 5714 set result 5715} [list\ 5716 1\ 5717 2\ 5718 3\ 5719 4\ 5720 5\ 5721 6\ 5722] 5723 5724test stooop-67 { 5725 check that nested class procedure definition works inside a separate 5726 namespace and is free from interferences 5727} { 5728 set interpreter [interp create] 5729 $interpreter eval "source $source; namespace import stooop::*" 5730 set result [$interpreter eval { 5731 class a { 5732 proc a {this} {} 5733 proc p {this} { 5734 lappend ::result 1 5735 } 5736 } 5737 set o [new a] 5738 a::p $o 5739 5740 namespace eval b { 5741 namespace eval a {} 5742 proc a::p {this} { 5743 lappend ::result 2 5744 } 5745 } 5746 a::p $o 5747 5748 namespace eval c { 5749 proc ::a::p {this} { 5750 lappend ::result 3 5751 } 5752 } 5753 a::p $o 5754 5755 namespace eval d { 5756 class a { 5757 proc a {this} {} 5758 proc p {this} { 5759 lappend ::result 4 5760 } 5761 } 5762 set o [new a] 5763 a::p $o 5764 5765 namespace eval b { 5766 namespace eval a {} 5767 proc a::p {this} { 5768 lappend ::result 5 5769 } 5770 } 5771 a::p $o 5772 5773 namespace eval c { 5774 proc ::d::a::p {this} { 5775 lappend ::result 6 5776 } 5777 } 5778 a::p $o 5779 } 5780 5781 class e { 5782 proc e {this} {} 5783 class a { 5784 proc a {this} {} 5785 proc p {this} { 5786 lappend ::result 7 5787 } 5788 } 5789 set o [new a] 5790 a::p $o 5791 5792 namespace eval b { 5793 namespace eval a {} 5794 proc a::p {this} { 5795 lappend ::result 8 5796 } 5797 } 5798 a::p $o 5799 5800 namespace eval c { 5801 proc ::e::a::p {this} { 5802 lappend ::result 9 5803 } 5804 } 5805 a::p $o 5806 } 5807 5808 set ::result 5809 }] 5810 interp delete $interpreter 5811 set result 5812} [list\ 5813 1\ 5814 1\ 5815 3\ 5816 4\ 5817 4\ 5818 6\ 5819 7\ 5820 7\ 5821 9\ 5822] 5823 5824test stooop-68 { 5825 check inheritance within a deep nested class hierarchy 5826} { 5827 set interpreter [interp create] 5828 $interpreter eval "source $source; namespace import stooop::*" 5829 set result [$interpreter eval { 5830 class a { 5831 proc a {this} { 5832 lappend ::result a::a 5833 } 5834 class b { 5835 proc b {this} a {} { 5836 lappend ::result b::b 5837 } 5838 class c { 5839 catch { 5840 proc c {this} b {} {} 5841 } message 5842 lappend ::result $message 5843 proc c {this} a::b {} { 5844 lappend ::result c::c 5845 } 5846 } 5847 new c 5848 } 5849 } 5850 5851 namespace eval d { 5852 proc d {this} { 5853 lappend ::result d::d 5854 } 5855 namespace eval e { 5856 proc e {this} { 5857 d::d $this 5858 lappend ::result e::e 5859 } 5860 namespace eval f { 5861 proc f {this} { 5862 catch { 5863 e::e $this 5864 } message 5865 lappend ::result $message 5866 d::e::e $this 5867 lappend ::result f::f 5868 } 5869 } 5870 f::f 0 5871 } 5872 } 5873 5874 set ::result 5875 }] 5876 interp delete $interpreter 5877 set result 5878} [list\ 5879 {class ::a::b::c constructor defined before base class b constructor}\ 5880 {a::a}\ 5881 {b::b}\ 5882 {c::c}\ 5883 {invalid command name "e::e"}\ 5884 {d::d}\ 5885 {e::e}\ 5886 {f::f}\ 5887] 5888 5889test stooop-69 { 5890 check user defined cloning operation in nested class context 5891} { 5892 set interpreter [interp create] 5893 $interpreter eval "source $source; namespace import stooop::*" 5894 $interpreter eval $dumpArraysCode 5895 set result [$interpreter eval { 5896 class a {} 5897 proc a::a {this} {} 5898 class a::b {} 5899 proc a::b::b {this} { 5900 set ($this,x) 0 5901 } 5902 proc a::b::b {this copy} { 5903 set ($this,x) [expr $($copy,x)+1] 5904 } 5905 new [new a::b] 5906 eval lappend ::result [dumpArrays a::b::] 5907 5908 class A { 5909 proc A {this} {} 5910 class B { 5911 proc B {this} { 5912 set ($this,x) 0 5913 } 5914 proc B {this copy} { 5915 set ($this,x) [expr $($copy,x)+1] 5916 } 5917 } 5918 new [new B] 5919 eval lappend ::result [dumpArrays B::] 5920 } 5921 new [new A::B] 5922 eval lappend ::result [dumpArrays A::B::] 5923 5924 set ::result 5925 }] 5926 interp delete $interpreter 5927 set result 5928} [list\ 5929 {a::b::(1,x) = 0}\ 5930 {a::b::(2,x) = 1}\ 5931 {B::(3,x) = 0}\ 5932 {B::(4,x) = 1}\ 5933 {A::B::(3,x) = 0}\ 5934 {A::B::(4,x) = 1}\ 5935 {A::B::(5,x) = 0}\ 5936 {A::B::(6,x) = 1}\ 5937] 5938 5939test stooop-70 { 5940 check basic cloning operation in nested class context 5941} { 5942 set interpreter [interp create] 5943 $interpreter eval "source $source; namespace import stooop::*" 5944 $interpreter eval $dumpArraysCode 5945 set result [$interpreter eval { 5946 class a {} 5947 proc a::a {this} {} 5948 class a::b {} 5949 proc a::b::b {this} { 5950 set ($this,x) 0 5951 } 5952 new [new a::b] 5953 eval lappend ::result [dumpArrays a::b::] 5954 5955 class A { 5956 proc A {this} {} 5957 class B { 5958 proc B {this} { 5959 set ($this,x) 0 5960 } 5961 } 5962 new [new B] 5963 eval lappend ::result [dumpArrays B::] 5964 } 5965 new [new A::B] 5966 eval lappend ::result [dumpArrays A::B::] 5967 5968 set ::result 5969 }] 5970 interp delete $interpreter 5971 set result 5972} [list\ 5973 {a::b::(1,x) = 0}\ 5974 {a::b::(2,x) = 0}\ 5975 {B::(3,x) = 0}\ 5976 {B::(4,x) = 0}\ 5977 {A::B::(3,x) = 0}\ 5978 {A::B::(4,x) = 0}\ 5979 {A::B::(5,x) = 0}\ 5980 {A::B::(6,x) = 0}\ 5981] 5982 5983test stooop-71 { 5984 check multiple inheritance construction order, destruction order and data 5985 deallocation with a common indirect base class 5986} { 5987 set interpreter [interp create] 5988 $interpreter eval "source $source; namespace import stooop::*" 5989 $interpreter eval $dumpArraysCode 5990 set result [$interpreter eval { 5991 class z {} 5992 class z::a {} 5993 proc z::a::a {this p} { 5994 lappend ::result "a::a $this" 5995 set ($this,m) $p 5996 } 5997 proc z::a::~a {this} { 5998 lappend ::result "a::~a $this" 5999 } 6000 class z::b {} 6001 proc z::b::b {this p} { 6002 lappend ::result "b::b $this" 6003 set ($this,n) $p 6004 } 6005 proc z::b::~b {this} { 6006 lappend ::result "b::~b $this" 6007 } 6008 class z::c {} 6009 proc z::c::c {this p q r} z::a {$p} z::b {$q} { 6010 lappend ::result "c::c $this" 6011 set ($this,o) $r 6012 } 6013 proc z::c::~c {this} { 6014 lappend ::result "c::~c $this" 6015 } 6016 class z::d {} 6017 proc z::d::d {this p q r} z::a {$p} z::b {$q} { 6018 lappend ::result "d::d $this" 6019 set ($this,p) $p 6020 } 6021 proc z::d::~d {this} { 6022 lappend ::result "d::~d $this" 6023 } 6024 class z::e {} 6025 proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} { 6026 lappend ::result "e::e $this" 6027 set ($this,q) $q 6028 } 6029 proc z::e::~e {this} { 6030 lappend ::result "e::~e $this" 6031 } 6032 set o [new z::e {x y} z {1 2}] 6033 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::] 6034 delete $o 6035 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::] 6036 6037 class Z { 6038 class A { 6039 proc A {this p} { 6040 lappend ::result "A::A $this" 6041 set ($this,m) $p 6042 } 6043 proc ~A {this} { 6044 lappend ::result "A::~A $this" 6045 } 6046 } 6047 class B { 6048 proc B {this p} { 6049 lappend ::result "B::B $this" 6050 set ($this,n) $p 6051 } 6052 proc ~B {this} { 6053 lappend ::result "B::~B $this" 6054 } 6055 } 6056 class C { 6057 proc C {this p q r} Z::A {$p} Z::B {$q} { 6058 lappend ::result "C::C $this" 6059 set ($this,o) $r 6060 } 6061 proc ~C {this} { 6062 lappend ::result "C::~C $this" 6063 } 6064 } 6065 class D { 6066 proc D {this p q r} Z::A {$p} Z::B {$q} { 6067 lappend ::result "D::D $this" 6068 set ($this,p) $p 6069 } 6070 proc ~D {this} { 6071 lappend ::result "D::~D $this" 6072 } 6073 } 6074 class E { 6075 proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} { 6076 lappend ::result "E::E $this" 6077 set ($this,q) $q 6078 } 6079 proc ~E {this} { 6080 lappend ::result "E::~E $this" 6081 } 6082 } 6083 set o [new E {x y} z {1 2}] 6084 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 6085 delete $o 6086 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 6087 } 6088 set o [new Z::E {x y} z {1 2}] 6089 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::] 6090 delete $o 6091 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::] 6092 6093 set ::result 6094 }] 6095 interp delete $interpreter 6096 set result 6097} [list\ 6098 {a::a 1}\ 6099 {b::b 1}\ 6100 {c::c 1}\ 6101 {a::a 1}\ 6102 {b::b 1}\ 6103 {d::d 1}\ 6104 {e::e 1}\ 6105 {z::a::(1,_derived) = ::z::d}\ 6106 {z::a::(1,m) = z}\ 6107 {z::b::(1,_derived) = ::z::d}\ 6108 {z::b::(1,n) = z}\ 6109 {z::c::(1,_derived) = ::z::e}\ 6110 {z::c::(1,o) = 1 2}\ 6111 {z::d::(1,_derived) = ::z::e}\ 6112 {z::d::(1,p) = z}\ 6113 {z::e::(1,q) = z}\ 6114 {e::~e 1}\ 6115 {d::~d 1}\ 6116 {b::~b 1}\ 6117 {a::~a 1}\ 6118 {c::~c 1}\ 6119 {b::~b 1}\ 6120 {a::~a 1}\ 6121 {A::A 2}\ 6122 {B::B 2}\ 6123 {C::C 2}\ 6124 {A::A 2}\ 6125 {B::B 2}\ 6126 {D::D 2}\ 6127 {E::E 2}\ 6128 {A::(2,_derived) = ::Z::D}\ 6129 {A::(2,m) = z}\ 6130 {B::(2,_derived) = ::Z::D}\ 6131 {B::(2,n) = z}\ 6132 {C::(2,_derived) = ::Z::E}\ 6133 {C::(2,o) = 1 2}\ 6134 {D::(2,_derived) = ::Z::E}\ 6135 {D::(2,p) = z}\ 6136 {E::(2,q) = z}\ 6137 {E::~E 2}\ 6138 {D::~D 2}\ 6139 {B::~B 2}\ 6140 {A::~A 2}\ 6141 {C::~C 2}\ 6142 {B::~B 2}\ 6143 {A::~A 2}\ 6144 {A::A 3}\ 6145 {B::B 3}\ 6146 {C::C 3}\ 6147 {A::A 3}\ 6148 {B::B 3}\ 6149 {D::D 3}\ 6150 {E::E 3}\ 6151 {Z::A::(3,_derived) = ::Z::D}\ 6152 {Z::A::(3,m) = z}\ 6153 {Z::B::(3,_derived) = ::Z::D}\ 6154 {Z::B::(3,n) = z}\ 6155 {Z::C::(3,_derived) = ::Z::E}\ 6156 {Z::C::(3,o) = 1 2}\ 6157 {Z::D::(3,_derived) = ::Z::E}\ 6158 {Z::D::(3,p) = z}\ 6159 {Z::E::(3,q) = z}\ 6160 {E::~E 3}\ 6161 {D::~D 3}\ 6162 {B::~B 3}\ 6163 {A::~A 3}\ 6164 {C::~C 3}\ 6165 {B::~B 3}\ 6166 {A::~A 3}\ 6167] 6168 6169test stooop-72 { 6170 check that multiply inherited base classes constructors work with variable 6171 number of arguments 6172} { 6173 set interpreter [interp create] 6174 $interpreter eval "source $source; namespace import stooop::*" 6175 $interpreter eval $dumpArraysCode 6176 set result [$interpreter eval { 6177 class z {} 6178 class z::a {} 6179 proc z::a::a {this args} { 6180 lappend ::result "a::a $this $args" 6181 set ($this,m) [lindex $args 0] 6182 } 6183 class z::b {} 6184 proc z::b::b {this p} { 6185 lappend ::result "b::b $this $p" 6186 set ($this,n) $p 6187 } 6188 class z::c {} 6189 proc z::c::c {this p args} { 6190 lappend ::result "c::c $this $p $args" 6191 set ($this,o) $p 6192 set ($this,p) [lindex $args 0] 6193 } 6194 class z::d {} 6195 proc z::d::d {this p args} z::a {$args} z::b {$p} z::c {$p $args} { 6196 lappend ::result "d::d $this $p $args" 6197 set ($this,q) $p 6198 set ($this,r) [lindex $args 0] 6199 } 6200 new z::d {x y} {1 2} 3 6201 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d::] 6202 6203 class Z { 6204 class A { 6205 proc A {this args} { 6206 lappend ::result "A::A $this $args" 6207 set ($this,m) [lindex $args 0] 6208 } 6209 } 6210 class B { 6211 proc B {this p} { 6212 lappend ::result "B::B $this $p" 6213 set ($this,n) $p 6214 } 6215 } 6216 class C { 6217 proc C {this p args} { 6218 lappend ::result "C::C $this $p $args" 6219 set ($this,o) $p 6220 set ($this,p) [lindex $args 0] 6221 } 6222 } 6223 class D { 6224 proc D {this p args} Z::A {$args} Z::B {$p} Z::C {$p $args} { 6225 lappend ::result "D::D $this $p $args" 6226 set ($this,q) $p 6227 set ($this,r) [lindex $args 0] 6228 } 6229 } 6230 new D {x y} {1 2} 3 6231 eval lappend ::result [dumpArrays A:: B:: C:: D::] 6232 } 6233 new Z::D {x y} {1 2} 3 6234 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D::] 6235 6236 set ::result 6237 }] 6238 interp delete $interpreter 6239 set result 6240} [list\ 6241 {a::a 1 {1 2} 3}\ 6242 {b::b 1 x y}\ 6243 {c::c 1 x y {1 2} 3}\ 6244 {d::d 1 x y {1 2} 3}\ 6245 {z::a::(1,_derived) = ::z::d}\ 6246 {z::a::(1,m) = 1 2}\ 6247 {z::b::(1,_derived) = ::z::d}\ 6248 {z::b::(1,n) = x y}\ 6249 {z::c::(1,_derived) = ::z::d}\ 6250 {z::c::(1,o) = x y}\ 6251 {z::c::(1,p) = 1 2}\ 6252 {z::d::(1,q) = x y}\ 6253 {z::d::(1,r) = 1 2}\ 6254 {A::A 2 {1 2} 3}\ 6255 {B::B 2 x y}\ 6256 {C::C 2 x y {1 2} 3}\ 6257 {D::D 2 x y {1 2} 3}\ 6258 {A::(2,_derived) = ::Z::D}\ 6259 {A::(2,m) = 1 2}\ 6260 {B::(2,_derived) = ::Z::D}\ 6261 {B::(2,n) = x y}\ 6262 {C::(2,_derived) = ::Z::D}\ 6263 {C::(2,o) = x y}\ 6264 {C::(2,p) = 1 2}\ 6265 {D::(2,q) = x y}\ 6266 {D::(2,r) = 1 2}\ 6267 {A::A 3 {1 2} 3}\ 6268 {B::B 3 x y}\ 6269 {C::C 3 x y {1 2} 3}\ 6270 {D::D 3 x y {1 2} 3}\ 6271 {Z::A::(2,_derived) = ::Z::D}\ 6272 {Z::A::(2,m) = 1 2}\ 6273 {Z::A::(3,_derived) = ::Z::D}\ 6274 {Z::A::(3,m) = 1 2}\ 6275 {Z::B::(2,_derived) = ::Z::D}\ 6276 {Z::B::(2,n) = x y}\ 6277 {Z::B::(3,_derived) = ::Z::D}\ 6278 {Z::B::(3,n) = x y}\ 6279 {Z::C::(2,_derived) = ::Z::D}\ 6280 {Z::C::(2,o) = x y}\ 6281 {Z::C::(2,p) = 1 2}\ 6282 {Z::C::(3,_derived) = ::Z::D}\ 6283 {Z::C::(3,o) = x y}\ 6284 {Z::C::(3,p) = 1 2}\ 6285 {Z::D::(2,q) = x y}\ 6286 {Z::D::(2,r) = 1 2}\ 6287 {Z::D::(3,q) = x y}\ 6288 {Z::D::(3,r) = 1 2}\ 6289] 6290 6291test stooop-73 { 6292 check multiple inheritance destruction order and data deallocation with a 6293 common indirect base class 6294} { 6295 set interpreter [interp create] 6296 $interpreter eval "source $source; namespace import stooop::*" 6297 $interpreter eval $dumpArraysCode 6298 set result [$interpreter eval { 6299 class z {} 6300 class z::a {} 6301 proc z::a::a {this p} { 6302 lappend ::result "a::a $this" 6303 set ($this,m) $p 6304 } 6305 proc z::a::~a {this} { 6306 lappend ::result "a::~a $this" 6307 } 6308 class z::b {} 6309 proc z::b::b {this p} { 6310 lappend ::result "b::b $this" 6311 set ($this,n) $p 6312 } 6313 proc z::b::~b {this} { 6314 lappend ::result "b::~b $this" 6315 } 6316 class z::c {} 6317 proc z::c::c {this p q r} z::a {$p} z::b {$q} { 6318 lappend ::result "c::c $this" 6319 set ($this,o) $r 6320 } 6321 proc z::c::~c {this} { 6322 lappend ::result "c::~c $this" 6323 } 6324 class z::d {} 6325 proc z::d::d {this p q r} z::a {$p} z::b {$q} { 6326 lappend ::result "d::d $this" 6327 set ($this,p) $p 6328 } 6329 proc z::d::~d {this} { 6330 lappend ::result "d::~d $this" 6331 } 6332 class z::e {} 6333 proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} { 6334 lappend ::result "e::e $this" 6335 set ($this,q) $q 6336 } 6337 proc z::e::~e {this} { 6338 lappend ::result "e::~e $this" 6339 } 6340 set o [new z::e {x y} z {1 2}] 6341 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::] 6342 delete $o 6343 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e::] 6344 6345 class Z { 6346 class A { 6347 proc A {this p} { 6348 lappend ::result "A::A $this" 6349 set ($this,m) $p 6350 } 6351 proc ~A {this} { 6352 lappend ::result "A::~A $this" 6353 } 6354 } 6355 class B { 6356 proc B {this p} { 6357 lappend ::result "B::B $this" 6358 set ($this,n) $p 6359 } 6360 proc ~B {this} { 6361 lappend ::result "B::~B $this" 6362 } 6363 } 6364 class C { 6365 proc C {this p q r} Z::A {$p} Z::B {$q} { 6366 lappend ::result "C::C $this" 6367 set ($this,o) $r 6368 } 6369 proc ~C {this} { 6370 lappend ::result "C::~C $this" 6371 } 6372 } 6373 class D { 6374 proc D {this p q r} Z::A {$p} Z::B {$q} { 6375 lappend ::result "D::D $this" 6376 set ($this,p) $p 6377 } 6378 proc ~D {this} { 6379 lappend ::result "D::~D $this" 6380 } 6381 } 6382 class E { 6383 proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} { 6384 lappend ::result "E::E $this" 6385 set ($this,q) $q 6386 } 6387 proc ~E {this} { 6388 lappend ::result "E::~E $this" 6389 } 6390 } 6391 set o [new E {x y} z {1 2}] 6392 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 6393 delete $o 6394 eval lappend ::result [dumpArrays A:: B:: C:: D:: E::] 6395 } 6396 set o [new Z::E {x y} z {1 2}] 6397 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::] 6398 delete $o 6399 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E::] 6400 6401 set ::result 6402 }] 6403 interp delete $interpreter 6404 set result 6405} [list\ 6406 {a::a 1}\ 6407 {b::b 1}\ 6408 {c::c 1}\ 6409 {a::a 1}\ 6410 {b::b 1}\ 6411 {d::d 1}\ 6412 {e::e 1}\ 6413 {z::a::(1,_derived) = ::z::d}\ 6414 {z::a::(1,m) = z}\ 6415 {z::b::(1,_derived) = ::z::d}\ 6416 {z::b::(1,n) = z}\ 6417 {z::c::(1,_derived) = ::z::e}\ 6418 {z::c::(1,o) = 1 2}\ 6419 {z::d::(1,_derived) = ::z::e}\ 6420 {z::d::(1,p) = z}\ 6421 {z::e::(1,q) = z}\ 6422 {e::~e 1}\ 6423 {d::~d 1}\ 6424 {b::~b 1}\ 6425 {a::~a 1}\ 6426 {c::~c 1}\ 6427 {b::~b 1}\ 6428 {a::~a 1}\ 6429 {A::A 2}\ 6430 {B::B 2}\ 6431 {C::C 2}\ 6432 {A::A 2}\ 6433 {B::B 2}\ 6434 {D::D 2}\ 6435 {E::E 2}\ 6436 {A::(2,_derived) = ::Z::D}\ 6437 {A::(2,m) = z}\ 6438 {B::(2,_derived) = ::Z::D}\ 6439 {B::(2,n) = z}\ 6440 {C::(2,_derived) = ::Z::E}\ 6441 {C::(2,o) = 1 2}\ 6442 {D::(2,_derived) = ::Z::E}\ 6443 {D::(2,p) = z}\ 6444 {E::(2,q) = z}\ 6445 {E::~E 2}\ 6446 {D::~D 2}\ 6447 {B::~B 2}\ 6448 {A::~A 2}\ 6449 {C::~C 2}\ 6450 {B::~B 2}\ 6451 {A::~A 2}\ 6452 {A::A 3}\ 6453 {B::B 3}\ 6454 {C::C 3}\ 6455 {A::A 3}\ 6456 {B::B 3}\ 6457 {D::D 3}\ 6458 {E::E 3}\ 6459 {Z::A::(3,_derived) = ::Z::D}\ 6460 {Z::A::(3,m) = z}\ 6461 {Z::B::(3,_derived) = ::Z::D}\ 6462 {Z::B::(3,n) = z}\ 6463 {Z::C::(3,_derived) = ::Z::E}\ 6464 {Z::C::(3,o) = 1 2}\ 6465 {Z::D::(3,_derived) = ::Z::E}\ 6466 {Z::D::(3,p) = z}\ 6467 {Z::E::(3,q) = z}\ 6468 {E::~E 3}\ 6469 {D::~D 3}\ 6470 {B::~B 3}\ 6471 {A::~A 3}\ 6472 {C::~C 3}\ 6473 {B::~B 3}\ 6474 {A::~A 3}\ 6475] 6476 6477test stooop-74 { 6478 check that optional arguments in constructors and multiple inheritance work 6479 together 6480} { 6481 set interpreter [interp create] 6482 $interpreter eval "source $source; namespace import stooop::*" 6483 $interpreter eval $dumpArraysCode 6484 set result [$interpreter eval { 6485 class z {} 6486 class z::a {} 6487 proc z::a::a {this {p 0}} { 6488 lappend ::result "a::a $this" 6489 set ($this,m) $p 6490 } 6491 proc z::a::~a {this} { 6492 lappend ::result "a::~a $this" 6493 } 6494 class z::b {} 6495 proc z::b::b {this {p 1}} { 6496 lappend ::result "b::b $this" 6497 set ($this,n) $p 6498 } 6499 proc z::b::~b {this} { 6500 lappend ::result "b::~b $this" 6501 } 6502 class z::c {} 6503 proc z::c::c {this {p 2} {q 3}} z::a {$p} z::b {$q} { 6504 lappend ::result "c::c $this" 6505 set ($this,o) $p 6506 set ($this,p) $q 6507 } 6508 proc z::c::~c {this} { 6509 lappend ::result "c::~c $this" 6510 } 6511 set o [new z::c {x y} z] 6512 eval lappend ::result [dumpArrays z::a:: z::b:: z::c::] 6513 delete $o 6514 set o [new z::c] 6515 eval lappend ::result [dumpArrays z::a:: z::b:: z::c::] 6516 6517 class Z { 6518 class A { 6519 proc A {this {p 0}} { 6520 lappend ::result "A::A $this" 6521 set ($this,m) $p 6522 } 6523 proc ~A {this} { 6524 lappend ::result "A::~A $this" 6525 } 6526 } 6527 class B { 6528 proc B {this {p 1}} { 6529 lappend ::result "B::B $this" 6530 set ($this,n) $p 6531 } 6532 proc ~B {this} { 6533 lappend ::result "B::~B $this" 6534 } 6535 } 6536 class C { 6537 proc C {this {p 2} {q 3}} Z::A {$p} Z::B {$q} { 6538 lappend ::result "C::C $this" 6539 set ($this,o) $p 6540 set ($this,p) $q 6541 } 6542 proc ~C {this} { 6543 lappend ::result "C::~C $this" 6544 } 6545 } 6546 set o [new C {x y} z] 6547 eval lappend ::result [dumpArrays A:: B:: C::] 6548 delete $o 6549 set o [new C] 6550 eval lappend ::result [dumpArrays A:: B:: C::] 6551 delete $o 6552 } 6553 set o [new Z::C {x y} z] 6554 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::] 6555 delete $o 6556 set o [new Z::C] 6557 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C::] 6558 6559 set ::result 6560 }] 6561 interp delete $interpreter 6562 set result 6563} [list\ 6564 {a::a 1}\ 6565 {b::b 1}\ 6566 {c::c 1}\ 6567 {z::a::(1,_derived) = ::z::c}\ 6568 {z::a::(1,m) = x y}\ 6569 {z::b::(1,_derived) = ::z::c}\ 6570 {z::b::(1,n) = z}\ 6571 {z::c::(1,o) = x y}\ 6572 {z::c::(1,p) = z}\ 6573 {c::~c 1}\ 6574 {b::~b 1}\ 6575 {a::~a 1}\ 6576 {a::a 2}\ 6577 {b::b 2}\ 6578 {c::c 2}\ 6579 {z::a::(2,_derived) = ::z::c}\ 6580 {z::a::(2,m) = 2}\ 6581 {z::b::(2,_derived) = ::z::c}\ 6582 {z::b::(2,n) = 3}\ 6583 {z::c::(2,o) = 2}\ 6584 {z::c::(2,p) = 3}\ 6585 {A::A 3}\ 6586 {B::B 3}\ 6587 {C::C 3}\ 6588 {A::(3,_derived) = ::Z::C}\ 6589 {A::(3,m) = x y}\ 6590 {B::(3,_derived) = ::Z::C}\ 6591 {B::(3,n) = z}\ 6592 {C::(3,o) = x y}\ 6593 {C::(3,p) = z}\ 6594 {C::~C 3}\ 6595 {B::~B 3}\ 6596 {A::~A 3}\ 6597 {A::A 4}\ 6598 {B::B 4}\ 6599 {C::C 4}\ 6600 {A::(4,_derived) = ::Z::C}\ 6601 {A::(4,m) = 2}\ 6602 {B::(4,_derived) = ::Z::C}\ 6603 {B::(4,n) = 3}\ 6604 {C::(4,o) = 2}\ 6605 {C::(4,p) = 3}\ 6606 {C::~C 4}\ 6607 {B::~B 4}\ 6608 {A::~A 4}\ 6609 {A::A 5}\ 6610 {B::B 5}\ 6611 {C::C 5}\ 6612 {Z::A::(5,_derived) = ::Z::C}\ 6613 {Z::A::(5,m) = x y}\ 6614 {Z::B::(5,_derived) = ::Z::C}\ 6615 {Z::B::(5,n) = z}\ 6616 {Z::C::(5,o) = x y}\ 6617 {Z::C::(5,p) = z}\ 6618 {C::~C 5}\ 6619 {B::~B 5}\ 6620 {A::~A 5}\ 6621 {A::A 6}\ 6622 {B::B 6}\ 6623 {C::C 6}\ 6624 {Z::A::(6,_derived) = ::Z::C}\ 6625 {Z::A::(6,m) = 2}\ 6626 {Z::B::(6,_derived) = ::Z::C}\ 6627 {Z::B::(6,n) = 3}\ 6628 {Z::C::(6,o) = 2}\ 6629 {Z::C::(6,p) = 3}\ 6630] 6631 6632test stooop-75 { 6633 check various virtual procedures configurations in a 3 level deep class 6634 hierarchy 6635} { 6636 set interpreter [interp create] 6637 $interpreter eval "source $source; namespace import stooop::*" 6638 set result [$interpreter eval { 6639 class z {} 6640 class z::a {} 6641 proc z::a::a {this} {} 6642 proc z::a::~a {this} {} 6643 virtual proc z::a::f {this p q} {} 6644 virtual proc z::a::g {this p q} 6645 virtual proc z::a::h {this p q} { 6646 lappend ::result "a::h $this $p $q" 6647 } 6648 virtual proc z::a::i {this p q} { 6649 lappend ::result "a::i $this $p $q" 6650 } 6651 virtual proc z::a::k {this p q} 6652 virtual proc z::a::l {this p q} { 6653 lappend ::result "a::l $this $p $q" 6654 } 6655 class z::b {} 6656 proc z::b::b {this} z::a {} {} 6657 proc z::b::~b {this} {} 6658 virtual proc z::b::f {this p q} { 6659 lappend ::result "b::f $this $p $q" 6660 } 6661 virtual proc z::b::g {this p q} 6662 virtual proc z::b::h {this p q} { 6663 lappend ::result "b::h $this $p $q" 6664 } 6665 proc z::b::i {this p q} { 6666 lappend ::result "b::i $this $p $q" 6667 } 6668 virtual proc z::b::k {this p q} { 6669 lappend ::result "b::k $this $p $q" 6670 } 6671 virtual proc z::b::l {this p q} 6672 class z::c {} 6673 proc z::c::c {this} z::b {} {} 6674 proc z::c::~c {this} {} 6675 proc z::c::f {this p q} { 6676 lappend ::result "c::f $this $p $q" 6677 } 6678 proc z::c::g {this p q} { 6679 lappend ::result "c::g $this $p $q" 6680 } 6681 proc z::c::i {this p q} { 6682 lappend ::result "c::i $this $p $q" 6683 } 6684 proc z::c::k {this p q} { 6685 lappend ::result "c::k $this $p $q" 6686 } 6687 proc z::c::l {this p q} { 6688 lappend ::result "c::l $this $p $q" 6689 } 6690 set o [new z::c] 6691 z::a::f $o x {y z} 6692 z::a::g $o x {y z} 6693 z::a::h $o x {y z} 6694 z::a::i $o x {y z} 6695 z::a::k $o x {y z} 6696 z::a::l $o x {y z} 6697 6698 class Z { 6699 class A { 6700 proc A {this} {} 6701 proc ~A {this} {} 6702 virtual proc f {this p q} {} 6703 virtual proc g {this p q} 6704 virtual proc h {this p q} { 6705 lappend ::result "A::h $this $p $q" 6706 } 6707 virtual proc i {this p q} { 6708 lappend ::result "A::i $this $p $q" 6709 } 6710 virtual proc k {this p q} 6711 virtual proc l {this p q} { 6712 lappend ::result "A::l $this $p $q" 6713 } 6714 } 6715 class B { 6716 proc B {this} Z::A {} {} 6717 proc ~B {this} {} 6718 virtual proc f {this p q} { 6719 lappend ::result "B::f $this $p $q" 6720 } 6721 virtual proc g {this p q} 6722 virtual proc h {this p q} { 6723 lappend ::result "B::h $this $p $q" 6724 } 6725 proc i {this p q} { 6726 lappend ::result "B::i $this $p $q" 6727 } 6728 virtual proc k {this p q} { 6729 lappend ::result "B::k $this $p $q" 6730 } 6731 virtual proc l {this p q} 6732 } 6733 class C { 6734 proc C {this} Z::B {} {} 6735 proc ~C {this} {} 6736 proc f {this p q} { 6737 lappend ::result "C::f $this $p $q" 6738 } 6739 proc g {this p q} { 6740 lappend ::result "C::g $this $p $q" 6741 } 6742 proc i {this p q} { 6743 lappend ::result "C::i $this $p $q" 6744 } 6745 proc k {this p q} { 6746 lappend ::result "C::k $this $p $q" 6747 } 6748 proc l {this p q} { 6749 lappend ::result "C::l $this $p $q" 6750 } 6751 } 6752 set o [new C] 6753 A::f $o x {y z} 6754 A::g $o x {y z} 6755 A::h $o x {y z} 6756 A::i $o x {y z} 6757 A::k $o x {y z} 6758 A::l $o x {y z} 6759 } 6760 set o [new Z::C] 6761 Z::A::f $o x {y z} 6762 Z::A::g $o x {y z} 6763 Z::A::h $o x {y z} 6764 Z::A::i $o x {y z} 6765 Z::A::k $o x {y z} 6766 Z::A::l $o x {y z} 6767 6768 set ::result 6769 }] 6770 interp delete $interpreter 6771 set result 6772} [list\ 6773 {c::f 1 x y z}\ 6774 {c::g 1 x y z}\ 6775 {b::h 1 x y z}\ 6776 {b::i 1 x y z}\ 6777 {c::k 1 x y z}\ 6778 {c::l 1 x y z}\ 6779 {C::f 2 x y z}\ 6780 {C::g 2 x y z}\ 6781 {B::h 2 x y z}\ 6782 {B::i 2 x y z}\ 6783 {C::k 2 x y z}\ 6784 {C::l 2 x y z}\ 6785 {C::f 3 x y z}\ 6786 {C::g 3 x y z}\ 6787 {B::h 3 x y z}\ 6788 {B::i 3 x y z}\ 6789 {C::k 3 x y z}\ 6790 {C::l 3 x y z}\ 6791] 6792 6793test stooop-76 { 6794 check various virtual procedures with variable number of arguments 6795 configurations in a 3 level deep class hierarchy 6796} { 6797 set interpreter [interp create] 6798 $interpreter eval "source $source; namespace import stooop::*" 6799 set result [$interpreter eval { 6800 class z {} 6801 class z::a {} 6802 proc z::a::a {this} {} 6803 proc z::a::~a {this} {} 6804 virtual proc z::a::f {this p args} {} 6805 virtual proc z::a::g {this p args} 6806 virtual proc z::a::h {this p args} { 6807 lappend ::result "a::h $this $p $args" 6808 } 6809 virtual proc z::a::i {this p args} { 6810 lappend ::result "a::i $this $p $args" 6811 } 6812 virtual proc z::a::k {this p args} 6813 virtual proc z::a::l {this p args} { 6814 lappend ::result "a::l $this $p $args" 6815 } 6816 class z::b {} 6817 proc z::b::b {this} z::a {} {} 6818 proc z::b::~b {this} {} 6819 virtual proc z::b::f {this p args} { 6820 lappend ::result "b::f $this $p $args" 6821 } 6822 virtual proc z::b::g {this p args} 6823 virtual proc z::b::h {this p args} { 6824 lappend ::result "b::h $this $p $args" 6825 } 6826 proc z::b::i {this p args} { 6827 lappend ::result "b::i $this $p $args" 6828 } 6829 virtual proc z::b::k {this p args} { 6830 lappend ::result "b::k $this $p $args" 6831 } 6832 virtual proc z::b::l {this p args} 6833 class z::c {} 6834 proc z::c::c {this} z::b {} {} 6835 proc z::c::~c {this} {} 6836 proc z::c::f {this p args} { 6837 lappend ::result "c::f $this $p $args" 6838 } 6839 proc z::c::g {this p args} { 6840 lappend ::result "c::g $this $p $args" 6841 } 6842 proc z::c::i {this p args} { 6843 lappend ::result "c::i $this $p $args" 6844 } 6845 proc z::c::k {this p args} { 6846 lappend ::result "c::k $this $p $args" 6847 } 6848 proc z::c::l {this p args} { 6849 lappend ::result "c::l $this $p $args" 6850 } 6851 set o [new z::c] 6852 z::a::f $o x {y z} 6853 z::a::g $o x {y z} 6854 z::a::h $o x {y z} 6855 z::a::i $o x {y z} 6856 z::a::k $o x {y z} 6857 z::a::l $o x {y z} 6858 6859 class Z { 6860 class A { 6861 proc A {this} {} 6862 proc ~A {this} {} 6863 virtual proc f {this p args} {} 6864 virtual proc g {this p args} 6865 virtual proc h {this p args} { 6866 lappend ::result "A::h $this $p $args" 6867 } 6868 virtual proc i {this p args} { 6869 lappend ::result "A::i $this $p $args" 6870 } 6871 virtual proc k {this p args} 6872 virtual proc l {this p args} { 6873 lappend ::result "A::l $this $p $args" 6874 } 6875 } 6876 class B { 6877 proc B {this} Z::A {} {} 6878 proc ~B {this} {} 6879 virtual proc f {this p args} { 6880 lappend ::result "B::f $this $p $args" 6881 } 6882 virtual proc g {this p args} 6883 virtual proc h {this p args} { 6884 lappend ::result "B::h $this $p $args" 6885 } 6886 proc i {this p args} { 6887 lappend ::result "B::i $this $p $args" 6888 } 6889 virtual proc k {this p args} { 6890 lappend ::result "B::k $this $p $args" 6891 } 6892 virtual proc l {this p args} 6893 } 6894 class C { 6895 proc C {this} Z::B {} {} 6896 proc ~C {this} {} 6897 proc f {this p args} { 6898 lappend ::result "C::f $this $p $args" 6899 } 6900 proc g {this p args} { 6901 lappend ::result "C::g $this $p $args" 6902 } 6903 proc i {this p args} { 6904 lappend ::result "C::i $this $p $args" 6905 } 6906 proc k {this p args} { 6907 lappend ::result "C::k $this $p $args" 6908 } 6909 proc l {this p args} { 6910 lappend ::result "C::l $this $p $args" 6911 } 6912 } 6913 set o [new C] 6914 A::f $o x {y z} 6915 A::g $o x {y z} 6916 A::h $o x {y z} 6917 A::i $o x {y z} 6918 A::k $o x {y z} 6919 A::l $o x {y z} 6920 } 6921 set o [new Z::C] 6922 Z::A::f $o x {y z} 6923 Z::A::g $o x {y z} 6924 Z::A::h $o x {y z} 6925 Z::A::i $o x {y z} 6926 Z::A::k $o x {y z} 6927 Z::A::l $o x {y z} 6928 6929 set ::result 6930 }] 6931 interp delete $interpreter 6932 set result 6933} [list\ 6934 {c::f 1 x {y z}}\ 6935 {c::g 1 x {y z}}\ 6936 {b::h 1 x {y z}}\ 6937 {b::i 1 x {y z}}\ 6938 {c::k 1 x {y z}}\ 6939 {c::l 1 x {y z}}\ 6940 {C::f 2 x {y z}}\ 6941 {C::g 2 x {y z}}\ 6942 {B::h 2 x {y z}}\ 6943 {B::i 2 x {y z}}\ 6944 {C::k 2 x {y z}}\ 6945 {C::l 2 x {y z}}\ 6946 {C::f 3 x {y z}}\ 6947 {C::g 3 x {y z}}\ 6948 {B::h 3 x {y z}}\ 6949 {B::i 3 x {y z}}\ 6950 {C::k 3 x {y z}}\ 6951 {C::l 3 x {y z}}\ 6952] 6953 6954test stooop-77 { 6955 check normal and user defined cloning operation with multiple inheritance 6956 and member objects 6957} { 6958 set interpreter [interp create] 6959 $interpreter eval "source $source; namespace import stooop::*" 6960 $interpreter eval $dumpArraysCode 6961 set result [$interpreter eval { 6962 class z {} 6963 class z::a {} 6964 proc z::a::a {this p} { 6965 set ($this,m) $p 6966 } 6967 class z::b {} 6968 proc z::b::b {this p} { 6969 set ($this,n) $p 6970 } 6971 class z::c {} 6972 proc z::c::c {this p q r} z::a {$p} z::b {$q} { 6973 set ($this,o) $r 6974 set ($this,O) [new z::f] 6975 } 6976 proc z::c::c {this copy} z::a {$z::a::($copy,m)} z::b 1 { 6977 set ($this,o) $($copy,o) 6978 set ($this,O) [new z::f] 6979 } 6980 class z::d {} 6981 proc z::d::d {this p q r} z::a {$p} z::b {$q} { 6982 set ($this,p) $p 6983 } 6984 class z::e {} 6985 proc z::e::e {this p q r} z::c {$p $q $r} z::d {$q $q $r} { 6986 set ($this,q) $q 6987 } 6988 class z::f {} 6989 proc z::f::f {this} { 6990 set ($this,x) 0 6991 } 6992 new [new z::e {x y} z {1 2}] 6993 eval lappend ::result [dumpArrays z::a:: z::b:: z::c:: z::d:: z::e:: z::f::] 6994 6995 class Z { 6996 class A { 6997 proc A {this p} { 6998 set ($this,m) $p 6999 } 7000 } 7001 class B { 7002 proc B {this p} { 7003 set ($this,n) $p 7004 } 7005 } 7006 class C { 7007 proc C {this p q r} Z::A {$p} Z::B {$q} { 7008 set ($this,o) $r 7009 set ($this,O) [new Z::F] 7010 } 7011 proc C {this copy} Z::A {$Z::A::($copy,m)} Z::B 1 { 7012 set ($this,o) $($copy,o) 7013 set ($this,O) [new Z::F] 7014 } 7015 } 7016 class D { 7017 proc D {this p q r} Z::A {$p} Z::B {$q} { 7018 set ($this,p) $p 7019 } 7020 } 7021 class E { 7022 proc E {this p q r} Z::C {$p $q $r} Z::D {$q $q $r} { 7023 set ($this,q) $q 7024 } 7025 } 7026 class F { 7027 proc F {this} { 7028 set ($this,x) 0 7029 } 7030 } 7031 new [new E {x y} z {1 2}] 7032 eval lappend ::result [dumpArrays A:: B:: C:: D:: E:: F::] 7033 } 7034 new [new Z::E {x y} z {1 2}] 7035 eval lappend ::result [dumpArrays Z::A:: Z::B:: Z::C:: Z::D:: Z::E:: Z::F::] 7036 7037 set ::result 7038 }] 7039 interp delete $interpreter 7040 set result 7041} [list\ 7042 {z::a::(1,_derived) = ::z::d}\ 7043 {z::a::(1,m) = z}\ 7044 {z::a::(3,_derived) = ::z::d}\ 7045 {z::a::(3,m) = z}\ 7046 {z::b::(1,_derived) = ::z::d}\ 7047 {z::b::(1,n) = z}\ 7048 {z::b::(3,_derived) = ::z::d}\ 7049 {z::b::(3,n) = z}\ 7050 {z::c::(1,O) = 2}\ 7051 {z::c::(1,_derived) = ::z::e}\ 7052 {z::c::(1,o) = 1 2}\ 7053 {z::c::(3,O) = 4}\ 7054 {z::c::(3,_derived) = ::z::e}\ 7055 {z::c::(3,o) = 1 2}\ 7056 {z::d::(1,_derived) = ::z::e}\ 7057 {z::d::(1,p) = z}\ 7058 {z::d::(3,_derived) = ::z::e}\ 7059 {z::d::(3,p) = z}\ 7060 {z::e::(1,q) = z}\ 7061 {z::e::(3,q) = z}\ 7062 {z::f::(2,x) = 0}\ 7063 {z::f::(4,x) = 0}\ 7064 {A::(5,_derived) = ::Z::D}\ 7065 {A::(5,m) = z}\ 7066 {A::(7,_derived) = ::Z::D}\ 7067 {A::(7,m) = z}\ 7068 {B::(5,_derived) = ::Z::D}\ 7069 {B::(5,n) = z}\ 7070 {B::(7,_derived) = ::Z::D}\ 7071 {B::(7,n) = z}\ 7072 {C::(5,O) = 6}\ 7073 {C::(5,_derived) = ::Z::E}\ 7074 {C::(5,o) = 1 2}\ 7075 {C::(7,O) = 8}\ 7076 {C::(7,_derived) = ::Z::E}\ 7077 {C::(7,o) = 1 2}\ 7078 {D::(5,_derived) = ::Z::E}\ 7079 {D::(5,p) = z}\ 7080 {D::(7,_derived) = ::Z::E}\ 7081 {D::(7,p) = z}\ 7082 {E::(5,q) = z}\ 7083 {E::(7,q) = z}\ 7084 {F::(6,x) = 0}\ 7085 {F::(8,x) = 0}\ 7086 {Z::A::(11,_derived) = ::Z::D}\ 7087 {Z::A::(11,m) = z}\ 7088 {Z::A::(5,_derived) = ::Z::D}\ 7089 {Z::A::(5,m) = z}\ 7090 {Z::A::(7,_derived) = ::Z::D}\ 7091 {Z::A::(7,m) = z}\ 7092 {Z::A::(9,_derived) = ::Z::D}\ 7093 {Z::A::(9,m) = z}\ 7094 {Z::B::(11,_derived) = ::Z::D}\ 7095 {Z::B::(11,n) = z}\ 7096 {Z::B::(5,_derived) = ::Z::D}\ 7097 {Z::B::(5,n) = z}\ 7098 {Z::B::(7,_derived) = ::Z::D}\ 7099 {Z::B::(7,n) = z}\ 7100 {Z::B::(9,_derived) = ::Z::D}\ 7101 {Z::B::(9,n) = z}\ 7102 {Z::C::(11,O) = 12}\ 7103 {Z::C::(11,_derived) = ::Z::E}\ 7104 {Z::C::(11,o) = 1 2}\ 7105 {Z::C::(5,O) = 6}\ 7106 {Z::C::(5,_derived) = ::Z::E}\ 7107 {Z::C::(5,o) = 1 2}\ 7108 {Z::C::(7,O) = 8}\ 7109 {Z::C::(7,_derived) = ::Z::E}\ 7110 {Z::C::(7,o) = 1 2}\ 7111 {Z::C::(9,O) = 10}\ 7112 {Z::C::(9,_derived) = ::Z::E}\ 7113 {Z::C::(9,o) = 1 2}\ 7114 {Z::D::(11,_derived) = ::Z::E}\ 7115 {Z::D::(11,p) = z}\ 7116 {Z::D::(5,_derived) = ::Z::E}\ 7117 {Z::D::(5,p) = z}\ 7118 {Z::D::(7,_derived) = ::Z::E}\ 7119 {Z::D::(7,p) = z}\ 7120 {Z::D::(9,_derived) = ::Z::E}\ 7121 {Z::D::(9,p) = z}\ 7122 {Z::E::(11,q) = z}\ 7123 {Z::E::(5,q) = z}\ 7124 {Z::E::(7,q) = z}\ 7125 {Z::E::(9,q) = z}\ 7126 {Z::F::(10,x) = 0}\ 7127 {Z::F::(12,x) = 0}\ 7128 {Z::F::(6,x) = 0}\ 7129 {Z::F::(8,x) = 0}\ 7130] 7131 7132test stooop-78 { 7133 check that virtual procedure invocations from base class constructor behave 7134 as in C++ 7135} { 7136 set interpreter [interp create] 7137 $interpreter eval "source $source; namespace import stooop::*" 7138 set result [$interpreter eval { 7139 class z {} 7140 class z::a {} 7141 proc z::a::a {this} { 7142 z::a::f $this x 7143 z::a::g $this x {y z} 7144 # pure virtual invocations behavior is undefined 7145 lappend ::result [catch {z::a::h $this x}] 7146 lappend ::result [catch {z::a::i $this x {y z}}] 7147 } 7148 proc z::a::~a {this} {} 7149 virtual proc z::a::f {this p} { 7150 lappend ::result "a::f $this $p" 7151 } 7152 virtual proc z::a::g {this p args} { 7153 lappend ::result "a::g $this $p $args" 7154 } 7155 virtual proc z::a::h {this p} 7156 virtual proc z::a::i {this p args} 7157 class z::b {} 7158 proc z::b::b {this} z::a {} {} 7159 proc z::b::~b {this} {} 7160 virtual proc z::b::f {this p} { 7161 lappend ::result "b::f $this $p" 7162 } 7163 virtual proc z::b::g {this p args} { 7164 lappend ::result "b::g $this $p $args" 7165 } 7166 virtual proc z::b::h {this p} { 7167 lappend ::result "b::h $this $p" 7168 } 7169 proc z::b::i {this p args} { 7170 lappend ::result "b::i $this $p $args" 7171 } 7172 new z::b 7173 7174 class Z { 7175 class A { 7176 proc A {this} { 7177 f $this x 7178 g $this x {y z} 7179 # pure virtual invocations behavior is undefined 7180 lappend ::result [catch {A::h $this x}] 7181 lappend ::result [catch {A::i $this x {y z}}] 7182 } 7183 proc ~A {this} {} 7184 virtual proc f {this p} { 7185 lappend ::result "A::f $this $p" 7186 } 7187 virtual proc g {this p args} { 7188 lappend ::result "A::g $this $p $args" 7189 } 7190 virtual proc h {this p} 7191 virtual proc i {this p args} 7192 } 7193 class B { 7194 proc B {this} Z::A {} {} 7195 proc ~B {this} {} 7196 virtual proc f {this p} { 7197 lappend ::result "B::f $this $p" 7198 } 7199 virtual proc g {this p args} { 7200 lappend ::result "B::g $this $p $args" 7201 } 7202 virtual proc h {this p} { 7203 lappend ::result "B::h $this $p" 7204 } 7205 proc i {this p args} { 7206 lappend ::result "B::i $this $p $args" 7207 } 7208 } 7209 new B 7210 } 7211 new Z::B 7212 7213 set ::result 7214 }] 7215 interp delete $interpreter 7216 set result 7217} [list\ 7218 {a::f 1 x}\ 7219 {a::g 1 x {y z}}\ 7220 {1}\ 7221 {1}\ 7222 {A::f 2 x}\ 7223 {A::g 2 x {y z}}\ 7224 {1}\ 7225 {1}\ 7226 {A::f 3 x}\ 7227 {A::g 3 x {y z}}\ 7228 {1}\ 7229 {1}\ 7230] 7231 7232test stooop-79 { 7233 check that child nested class is visible within parent namespace 7234} { 7235 set interpreter [interp create] 7236 $interpreter eval "source $source; namespace import stooop::*" 7237 set result [$interpreter eval { 7238 class a {} 7239 proc a::a {this} { 7240 lappend ::result "a::a $this" 7241 new b 7242 } 7243 class a::b {} 7244 proc a::b::b {this} { 7245 lappend ::result "b::b $this" 7246 } 7247 new a 7248 7249 class a { 7250 proc a {this} { 7251 lappend ::result "a::a $this" 7252 new b 7253 } 7254 class b { 7255 proc b {this} { 7256 lappend ::result "b::b $this" 7257 } 7258 } 7259 new a 7260 } 7261 7262 set ::result 7263 }] 7264 interp delete $interpreter 7265 set result 7266} [list\ 7267 {a::a 1}\ 7268 {b::b 2}\ 7269 {a::a 3}\ 7270 {b::b 4}\ 7271] 7272 7273test stooop-80 { 7274 verify regular member procedure checking in procedure checking debug mode 7275} { 7276 set interpreter [interp create] 7277 $interpreter eval { 7278 # reset any existing environment variables: 7279 foreach name [array names env STOOOP*] {unset env($name)} 7280 set env(STOOOPCHECKPROCEDURES) 1 7281 } 7282 $interpreter eval "source $source; namespace import stooop::*" 7283 set result [$interpreter eval { 7284 class a {} 7285 proc a::a {this} {} 7286 proc a::p {this} {} 7287 class b {} 7288 proc b::b {this} {} 7289 proc b::p {this} {} 7290 set o [new a] 7291 a::p $o 7292 catch {b::p $o} message 7293 lappend ::result $message 7294 7295 class A { 7296 proc A {this} {} 7297 proc p {this} {} 7298 } 7299 class B { 7300 proc B {this} {} 7301 proc p {this} {} 7302 } 7303 set o [new A] 7304 A::p $o 7305 catch {B::p $o} message 7306 lappend ::result $message 7307 7308 class c {} 7309 class c::d {} 7310 proc c::d::d {this} {} 7311 proc c::d::p {this} {} 7312 class c::e {} 7313 proc c::e::e {this} {} 7314 proc c::e::p {this} {} 7315 set o [new c::d] 7316 c::d::p $o 7317 catch {c::e::p $o} message 7318 lappend ::result $message 7319 7320 class C { 7321 class D { 7322 proc D {this} {} 7323 proc p {this} {} 7324 } 7325 class E { 7326 proc E {this} {} 7327 proc p {this} {} 7328 } 7329 set o [new D] 7330 D::p $o 7331 catch {E::p $o} message 7332 lappend ::result $message 7333 } 7334 set o [new C::D] 7335 C::D::p $o 7336 catch {C::E::p $o} message 7337 lappend ::result $message 7338 7339 set ::result 7340 }] 7341 interp delete $interpreter 7342 set result 7343} [list\ 7344 {class b of ::b::p procedure not an ancestor of object 1 class a}\ 7345 {class B of ::B::p procedure not an ancestor of object 2 class A}\ 7346 {class c::e of ::c::e::p procedure not an ancestor of object 3 class c::d}\ 7347 {class C::E of ::C::E::p procedure not an ancestor of object 4 class C::D}\ 7348 {class C::E of ::C::E::p procedure not an ancestor of object 5 class C::D}\ 7349] 7350 7351test stooop-81 { 7352 verify regular member procedure checking within class hierarchy in 7353 procedure checking debug mode 7354} { 7355 set interpreter [interp create] 7356 $interpreter eval { 7357 # reset any existing environment variables: 7358 foreach name [array names env STOOOP*] {unset env($name)} 7359 set env(STOOOPCHECKPROCEDURES) 1 7360 } 7361 $interpreter eval "source $source; namespace import stooop::*" 7362 set result [$interpreter eval { 7363 class a {} 7364 proc a::a {this} {} 7365 proc a::~a {this} {} 7366 proc a::p {this} {} 7367 class b {} 7368 proc b::b {this} a {} {} 7369 proc b::~b {this} {} 7370 proc b::p {this} {} 7371 class c {} 7372 proc c::c {this} b {} {} 7373 proc c::~c {this} {} 7374 proc c::p {this} {} 7375 set o [new a] 7376 a::p $o 7377 catch {b::p $o} message 7378 lappend ::result $message 7379 catch {c::p $o} message 7380 lappend ::result $message 7381 delete $o 7382 set o [new b] 7383 a::p $o 7384 b::p $o 7385 catch {c::p $o} message 7386 lappend ::result $message 7387 delete $o 7388 set o [new c] 7389 a::p $o 7390 b::p $o 7391 c::p $o 7392 delete $o 7393 7394 class a { 7395 proc a {this} {} 7396 proc ~a {this} {} 7397 proc p {this} {} 7398 } 7399 class b { 7400 proc b {this} a {} {} 7401 proc ~b {this} {} 7402 proc p {this} {} 7403 } 7404 class c { 7405 proc c {this} b {} {} 7406 proc ~c {this} {} 7407 proc p {this} {} 7408 } 7409 set o [new a] 7410 a::p $o 7411 catch {b::p $o} message 7412 lappend ::result $message 7413 catch {c::p $o} message 7414 lappend ::result $message 7415 delete $o 7416 set o [new b] 7417 a::p $o 7418 b::p $o 7419 catch {c::p $o} message 7420 lappend ::result $message 7421 delete $o 7422 set o [new c] 7423 a::p $o 7424 b::p $o 7425 c::p $o 7426 delete $o 7427 7428 class d {} 7429 class d::e {} 7430 proc d::e::e {this} {} 7431 proc d::e::~e {this} {} 7432 proc d::e::p {this} {} 7433 class d::f {} 7434 proc d::f::f {this} d::e {} {} 7435 proc d::f::~f {this} {} 7436 proc d::f::p {this} {} 7437 class d::g {} 7438 proc d::g::g {this} d::f {} {} 7439 proc d::g::~g {this} {} 7440 proc d::g::p {this} {} 7441 set o [new d::e] 7442 d::e::p $o 7443 catch {d::f::p $o} message 7444 lappend ::result $message 7445 catch {d::g::p $o} message 7446 lappend ::result $message 7447 delete $o 7448 set o [new d::f] 7449 d::e::p $o 7450 d::f::p $o 7451 catch {d::g::p $o} message 7452 lappend ::result $message 7453 delete $o 7454 set o [new d::g] 7455 d::e::p $o 7456 d::f::p $o 7457 d::g::p $o 7458 delete $o 7459 7460 class C { 7461 class D { 7462 proc D {this} {} 7463 proc ~D {this} {} 7464 proc p {this} {} 7465 } 7466 class E { 7467 proc E {this} C::D {} {} 7468 proc ~E {this} {} 7469 proc p {this} {} 7470 } 7471 class F { 7472 proc F {this} C::E {} {} 7473 proc ~F {this} {} 7474 proc p {this} {} 7475 } 7476 set o [new D] 7477 D::p $o 7478 catch {E::p $o} message 7479 lappend ::result $message 7480 catch {F::p $o} message 7481 lappend ::result $message 7482 delete $o 7483 set o [new E] 7484 D::p $o 7485 E::p $o 7486 catch {F::p $o} message 7487 lappend ::result $message 7488 delete $o 7489 set o [new F] 7490 D::p $o 7491 E::p $o 7492 F::p $o 7493 delete $o 7494 } 7495 set o [new C::D] 7496 C::D::p $o 7497 catch {C::E::p $o} message 7498 lappend ::result $message 7499 catch {C::F::p $o} message 7500 lappend ::result $message 7501 delete $o 7502 set o [new C::E] 7503 C::D::p $o 7504 C::E::p $o 7505 catch {C::F::p $o} message 7506 lappend ::result $message 7507 delete $o 7508 set o [new C::F] 7509 C::D::p $o 7510 C::E::p $o 7511 C::F::p $o 7512 delete $o 7513 7514 set ::result 7515 }] 7516 interp delete $interpreter 7517 set result 7518} [list\ 7519 {class b of ::b::p procedure not an ancestor of object 1 class a}\ 7520 {class c of ::c::p procedure not an ancestor of object 1 class a}\ 7521 {class c of ::c::p procedure not an ancestor of object 2 class b}\ 7522 {class b of ::b::p procedure not an ancestor of object 4 class a}\ 7523 {class c of ::c::p procedure not an ancestor of object 4 class a}\ 7524 {class c of ::c::p procedure not an ancestor of object 5 class b}\ 7525 {class d::f of ::d::f::p procedure not an ancestor of object 7 class d::e}\ 7526 {class d::g of ::d::g::p procedure not an ancestor of object 7 class d::e}\ 7527 {class d::g of ::d::g::p procedure not an ancestor of object 8 class d::f}\ 7528 {class C::E of ::C::E::p procedure not an ancestor of object 10 class C::D}\ 7529 {class C::F of ::C::F::p procedure not an ancestor of object 10 class C::D}\ 7530 {class C::F of ::C::F::p procedure not an ancestor of object 11 class C::E}\ 7531 {class C::E of ::C::E::p procedure not an ancestor of object 13 class C::D}\ 7532 {class C::F of ::C::F::p procedure not an ancestor of object 13 class C::D}\ 7533 {class C::F of ::C::F::p procedure not an ancestor of object 14 class C::E}\ 7534] 7535 7536test stooop-82 { 7537 verify regular member procedure checking within multiple inheritance class 7538 hierarchy in procedure checking debug mode 7539} { 7540 set interpreter [interp create] 7541 $interpreter eval { 7542 # reset any existing environment variables: 7543 foreach name [array names env STOOOP*] {unset env($name)} 7544 set env(STOOOPCHECKPROCEDURES) 1 7545 } 7546 $interpreter eval "source $source; namespace import stooop::*" 7547 set result [$interpreter eval { 7548 class a {} 7549 proc a::a {this} {} 7550 proc a::p {this} {} 7551 class b {} 7552 proc b::b {this} {} 7553 proc b::p {this} {} 7554 class c {} 7555 proc c::c {this} a {} b {} {} 7556 proc c::p {this} {} 7557 set o [new a] 7558 a::p $o 7559 catch {b::p $o} message 7560 lappend ::result $message 7561 catch {c::p $o} message 7562 lappend ::result $message 7563 7564 class A { 7565 proc A {this} {} 7566 proc p {this} {} 7567 } 7568 class B { 7569 proc B {this} {} 7570 proc p {this} {} 7571 } 7572 class C { 7573 proc C {this} A {} B {} {} 7574 proc p {this} {} 7575 } 7576 set o [new A] 7577 A::p $o 7578 catch {B::p $o} message 7579 lappend ::result $message 7580 catch {C::p $o} message 7581 lappend ::result $message 7582 7583 class d {} 7584 class d::e {} 7585 proc d::e::e {this} {} 7586 proc d::e::p {this} {} 7587 class d::f {} 7588 proc d::f::f {this} {} 7589 proc d::f::p {this} {} 7590 class d::g {} 7591 proc d::g::g {this} d::e {} d::f {} {} 7592 proc d::g::p {this} {} 7593 set o [new d::e] 7594 d::e::p $o 7595 catch {d::f::p $o} message 7596 lappend ::result $message 7597 catch {d::g::p $o} message 7598 lappend ::result $message 7599 7600 class D { 7601 class E { 7602 proc E {this} {} 7603 proc p {this} {} 7604 } 7605 class F { 7606 proc F {this} {} 7607 proc p {this} {} 7608 } 7609 class G { 7610 proc G {this} D::E {} D::F {} {} 7611 proc p {this} {} 7612 } 7613 set o [new E] 7614 E::p $o 7615 catch {F::p $o} message 7616 lappend ::result $message 7617 catch {G::p $o} message 7618 lappend ::result $message 7619 } 7620 set o [new D::E] 7621 D::E::p $o 7622 catch {D::F::p $o} message 7623 lappend ::result $message 7624 catch {D::G::p $o} message 7625 lappend ::result $message 7626 7627 set ::result 7628 }] 7629 interp delete $interpreter 7630 set result 7631} [list\ 7632 {class b of ::b::p procedure not an ancestor of object 1 class a}\ 7633 {class c of ::c::p procedure not an ancestor of object 1 class a}\ 7634 {class B of ::B::p procedure not an ancestor of object 2 class A}\ 7635 {class C of ::C::p procedure not an ancestor of object 2 class A}\ 7636 {class d::f of ::d::f::p procedure not an ancestor of object 3 class d::e}\ 7637 {class d::g of ::d::g::p procedure not an ancestor of object 3 class d::e}\ 7638 {class D::F of ::D::F::p procedure not an ancestor of object 4 class D::E}\ 7639 {class D::G of ::D::G::p procedure not an ancestor of object 4 class D::E}\ 7640 {class D::F of ::D::F::p procedure not an ancestor of object 5 class D::E}\ 7641 {class D::G of ::D::G::p procedure not an ancestor of object 5 class D::E}\ 7642] 7643 7644test stooop-83 { 7645 verify object identifier checking in procedure checking debug mode 7646} { 7647 set interpreter [interp create] 7648 $interpreter eval { 7649 # reset any existing environment variables: 7650 foreach name [array names env STOOOP*] {unset env($name)} 7651 set env(STOOOPCHECKPROCEDURES) 1 7652 } 7653 $interpreter eval "source $source; namespace import stooop::*" 7654 set result [$interpreter eval { 7655 class a {} 7656 proc a::a {this} {} 7657 proc a::p {this} {} 7658 catch {a::p 1} message 7659 lappend ::result $message 7660 7661 class A { 7662 proc A {this} {} 7663 proc p {this} {} 7664 } 7665 catch {A::p 2} message 7666 lappend ::result $message 7667 7668 class b {} 7669 class b::c {} 7670 proc b::c::c {this} {} 7671 proc b::c::p {this} {} 7672 catch {b::c::p 3} message 7673 lappend ::result $message 7674 7675 class B { 7676 class C { 7677 proc C {this} {} 7678 proc p {this} {} 7679 } 7680 catch {C::p 4} message 7681 lappend ::result $message 7682 } 7683 catch {B::C::p 5} message 7684 lappend ::result $message 7685 7686 set ::result 7687 }] 7688 interp delete $interpreter 7689 set result 7690} [list\ 7691 {1 is not a valid object identifier}\ 7692 {2 is not a valid object identifier}\ 7693 {3 is not a valid object identifier}\ 7694 {4 is not a valid object identifier}\ 7695 {5 is not a valid object identifier}\ 7696] 7697 7698test stooop-84 { 7699 verify virtual member procedure checking in procedure checking debug mode 7700} { 7701 set interpreter [interp create] 7702 $interpreter eval { 7703 # reset any existing environment variables: 7704 foreach name [array names env STOOOP*] {unset env($name)} 7705 set env(STOOOPCHECKPROCEDURES) 1 7706 } 7707 $interpreter eval "source $source; namespace import stooop::*" 7708 set result [$interpreter eval { 7709 class a {} 7710 proc a::a {this} {} 7711 proc a::~a {this} {} 7712 virtual proc a::p {this} { 7713 lappend ::result "a::p $this" 7714 } 7715 virtual proc a::q {this} 7716 virtual proc a::r {this} { 7717 lappend ::result "a::r $this" 7718 } 7719 class b {} 7720 proc b::b {this} a {} {} 7721 proc b::~b {this} {} 7722 proc b::p {this} { 7723 lappend ::result "b::p $this" 7724 } 7725 proc b::q {this} { 7726 lappend ::result "b::q $this" 7727 } 7728 set o [new b] 7729 a::p $o 7730 a::q $o 7731 a::r $o 7732 b::p $o 7733 b::q $o 7734 delete $o 7735 catch {a::p $o} message; lappend ::result $message 7736 catch {a::q $o} message; lappend ::result $message 7737 catch {a::r $o} message; lappend ::result $message 7738 catch {b::p $o} message; lappend ::result $message 7739 catch {b::q $o} message; lappend ::result $message 7740 7741 class A { 7742 proc A {this} {} 7743 proc ~A {this} {} 7744 virtual proc p {this} { 7745 lappend ::result "A::p $this" 7746 } 7747 virtual proc q {this} 7748 virtual proc r {this} { 7749 lappend ::result "A::r $this" 7750 } 7751 } 7752 class B { 7753 proc B {this} A {} {} 7754 proc ~B {this} {} 7755 proc p {this} { 7756 lappend ::result "B::p $this" 7757 } 7758 proc q {this} { 7759 lappend ::result "B::q $this" 7760 } 7761 } 7762 set o [new B] 7763 A::p $o 7764 A::q $o 7765 A::r $o 7766 B::p $o 7767 B::q $o 7768 delete $o 7769 catch {A::p $o} message; lappend ::result $message 7770 catch {A::q $o} message; lappend ::result $message 7771 catch {A::r $o} message; lappend ::result $message 7772 catch {B::p $o} message; lappend ::result $message 7773 catch {B::q $o} message; lappend ::result $message 7774 7775 class c {} 7776 class c::d {} 7777 proc c::d::d {this} {} 7778 proc c::d::~d {this} {} 7779 virtual proc c::d::p {this} { 7780 lappend ::result "d::p $this" 7781 } 7782 virtual proc c::d::q {this} 7783 virtual proc c::d::r {this} { 7784 lappend ::result "d::r $this" 7785 } 7786 class c::e {} 7787 proc c::e::e {this} c::d {} {} 7788 proc c::e::~e {this} {} 7789 proc c::e::p {this} { 7790 lappend ::result "e::p $this" 7791 } 7792 proc c::e::q {this} { 7793 lappend ::result "e::q $this" 7794 } 7795 set o [new c::e] 7796 c::d::p $o 7797 c::d::q $o 7798 c::d::r $o 7799 c::e::p $o 7800 c::e::q $o 7801 delete $o 7802 catch {c::d::p $o} message; lappend ::result $message 7803 catch {c::d::q $o} message; lappend ::result $message 7804 catch {c::d::r $o} message; lappend ::result $message 7805 catch {c::e::p $o} message; lappend ::result $message 7806 catch {c::e::q $o} message; lappend ::result $message 7807 7808 class C { 7809 class D { 7810 proc D {this} {} 7811 proc ~D {this} {} 7812 virtual proc p {this} { 7813 lappend ::result "D::p $this" 7814 } 7815 virtual proc q {this} 7816 virtual proc r {this} { 7817 lappend ::result "D::r $this" 7818 } 7819 } 7820 class E { 7821 proc E {this} C::D {} {} 7822 proc ~E {this} {} 7823 proc p {this} { 7824 lappend ::result "E::p $this" 7825 } 7826 proc q {this} { 7827 lappend ::result "E::q $this" 7828 } 7829 } 7830 set o [new E] 7831 D::p $o 7832 D::q $o 7833 D::r $o 7834 E::p $o 7835 E::q $o 7836 delete $o 7837 catch {D::p $o} message; lappend ::result $message 7838 catch {D::q $o} message; lappend ::result $message 7839 catch {D::r $o} message; lappend ::result $message 7840 catch {E::p $o} message; lappend ::result $message 7841 catch {E::q $o} message; lappend ::result $message 7842 } 7843 set o [new C::E] 7844 C::D::p $o 7845 C::D::q $o 7846 C::D::r $o 7847 C::E::p $o 7848 C::E::q $o 7849 delete $o 7850 catch {C::D::p $o} message; lappend ::result $message 7851 catch {C::D::q $o} message; lappend ::result $message 7852 catch {C::D::r $o} message; lappend ::result $message 7853 catch {C::E::p $o} message; lappend ::result $message 7854 catch {C::E::q $o} message; lappend ::result $message 7855 7856 set ::result 7857 }] 7858 interp delete $interpreter 7859 set result 7860} [list\ 7861 {b::p 1}\ 7862 {b::q 1}\ 7863 {a::r 1}\ 7864 {b::p 1}\ 7865 {b::q 1}\ 7866 {1 is not a valid object identifier}\ 7867 {1 is not a valid object identifier}\ 7868 {1 is not a valid object identifier}\ 7869 {1 is not a valid object identifier}\ 7870 {1 is not a valid object identifier}\ 7871 {B::p 2}\ 7872 {B::q 2}\ 7873 {A::r 2}\ 7874 {B::p 2}\ 7875 {B::q 2}\ 7876 {2 is not a valid object identifier}\ 7877 {2 is not a valid object identifier}\ 7878 {2 is not a valid object identifier}\ 7879 {2 is not a valid object identifier}\ 7880 {2 is not a valid object identifier}\ 7881 {e::p 3}\ 7882 {e::q 3}\ 7883 {d::r 3}\ 7884 {e::p 3}\ 7885 {e::q 3}\ 7886 {3 is not a valid object identifier}\ 7887 {3 is not a valid object identifier}\ 7888 {3 is not a valid object identifier}\ 7889 {3 is not a valid object identifier}\ 7890 {3 is not a valid object identifier}\ 7891 {E::p 4}\ 7892 {E::q 4}\ 7893 {D::r 4}\ 7894 {E::p 4}\ 7895 {E::q 4}\ 7896 {4 is not a valid object identifier}\ 7897 {4 is not a valid object identifier}\ 7898 {4 is not a valid object identifier}\ 7899 {4 is not a valid object identifier}\ 7900 {4 is not a valid object identifier}\ 7901 {E::p 5}\ 7902 {E::q 5}\ 7903 {D::r 5}\ 7904 {E::p 5}\ 7905 {E::q 5}\ 7906 {5 is not a valid object identifier}\ 7907 {5 is not a valid object identifier}\ 7908 {5 is not a valid object identifier}\ 7909 {5 is not a valid object identifier}\ 7910 {5 is not a valid object identifier}\ 7911] 7912 7913test stooop-85 { 7914 verify pure interface class object creation in procedure checking debug mode 7915} { 7916 set interpreter [interp create] 7917 $interpreter eval { 7918 # reset any existing environment variables: 7919 foreach name [array names env STOOOP*] {unset env($name)} 7920 set env(STOOOPCHECKPROCEDURES) 1 7921 } 7922 $interpreter eval "source $source; namespace import stooop::*" 7923 set result [$interpreter eval { 7924 class a {} 7925 proc a::a {this} { 7926 lappend ::result "a::a $this" 7927 } 7928 proc a::~a {this} {} 7929 virtual proc a::p {this} {} 7930 set o [new a] 7931 delete $o 7932 virtual proc a::q {this} 7933 catch {new a} message 7934 lappend ::result $message 7935 7936 class A { 7937 proc A {this} { 7938 lappend ::result "A::A $this" 7939 } 7940 proc ~A {this} {} 7941 virtual proc p {this} {} 7942 } 7943 set o [new A] 7944 delete $o 7945 class A { 7946 virtual proc q {this} 7947 } 7948 catch {new A} message 7949 lappend ::result $message 7950 7951 class b {} 7952 class b::c {} 7953 proc b::c::c {this} { 7954 lappend ::result "c::c $this" 7955 } 7956 proc b::c::~c {this} {} 7957 virtual proc b::c::p {this} {} 7958 set o [new b::c] 7959 delete $o 7960 virtual proc b::c::q {this} 7961 catch {new b::c} message 7962 lappend ::result $message 7963 7964 class B { 7965 class C { 7966 proc C {this} { 7967 lappend ::result "C::C $this" 7968 } 7969 proc ~C {this} {} 7970 virtual proc p {this} {} 7971 } 7972 set o [new C] 7973 delete $o 7974 class C { 7975 virtual proc q {this} 7976 } 7977 catch {new C} message 7978 lappend ::result $message 7979 } 7980 catch {new B::C} message 7981 lappend ::result $message 7982 7983 set ::result 7984 }] 7985 interp delete $interpreter 7986 set result 7987} [list\ 7988 {a::a 1}\ 7989 {class ::a with pure virtual procedures should not be instanciated}\ 7990 {A::A 2}\ 7991 {class ::A with pure virtual procedures should not be instanciated}\ 7992 {c::c 3}\ 7993 {class ::b::c with pure virtual procedures should not be instanciated}\ 7994 {C::C 4}\ 7995 {class ::B::C with pure virtual procedures should not be instanciated}\ 7996 {class ::B::C with pure virtual procedures should not be instanciated}\ 7997] 7998 7999test stooop-86 { 8000 verify member writing and unsetting within class procedures in member data 8001 checking mode 8002 (it seems that unset tracing prevents error reporting at this time (bug?)) 8003} { 8004 set interpreter [interp create] 8005 $interpreter eval { 8006 # reset any existing environment variables: 8007 foreach name [array names env STOOOP*] {unset env($name)} 8008 set env(STOOOPCHECKDATA) 1 8009 } 8010 $interpreter eval "source $source; namespace import stooop::*" 8011 set result [$interpreter eval { 8012 class a {} 8013 proc a::a {this} {} 8014 proc a::~a {this} {} 8015 proc a::p {this} { 8016 set b::($this,m) 0 8017 } 8018 proc a::q {this} { 8019 set b::(n) 0 8020 } 8021 proc a::r {this} { 8022 unset b::($this,m) 8023 } 8024 proc a::s {this} { 8025 unset b::(n) 8026 } 8027 set o [new a] 8028 class b {} 8029 set b::($o,m) 0 8030 set b::(n) 0 8031 catch {a::p $o} message; lappend ::result $message 8032 catch {a::q $o} message; lappend ::result $message 8033 catch {a::r $o} message; lappend ::result bug 8034 catch {a::s $o} message; lappend ::result bug 8035 delete $o 8036 8037 class A { 8038 proc A {this} {} 8039 proc ~A {this} {} 8040 proc p {this} { 8041 set B::($this,m) 0 8042 } 8043 proc q {this} { 8044 set B::(n) 0 8045 } 8046 proc r {this} { 8047 unset B::($this,m) 8048 } 8049 proc s {this} { 8050 unset B::(n) 8051 } 8052 } 8053 set o [new A] 8054 class B { 8055 set ($o,m) 0 8056 set (n) 0 8057 } 8058 class A { 8059 catch {p $o} message; lappend ::result $message 8060 catch {q $o} message; lappend ::result $message 8061 catch {r $o} message; lappend ::result bug 8062 catch {s $o} message; lappend ::result bug 8063 } 8064 delete $o 8065 8066 class c {} 8067 class c::d {} 8068 proc c::d::d {this} {} 8069 proc c::d::~d {this} {} 8070 proc c::d::p {this} { 8071 set c::e::($this,m) 0 8072 } 8073 proc c::d::q {this} { 8074 set c::e::(n) 0 8075 } 8076 proc c::d::r {this} { 8077 unset c::e::($this,m) 8078 } 8079 proc c::d::s {this} { 8080 unset c::e::(n) 8081 } 8082 class c::e {} 8083 set o [new c::d] 8084 set c::e::($o,m) 0 8085 set c::e::(n) 0 8086 catch {c::d::p $o} message; lappend ::result $message 8087 catch {c::d::q $o} message; lappend ::result $message 8088 catch {c::d::r $o} message; lappend ::result bug 8089 catch {c::d::s $o} message; lappend ::result bug 8090 delete $o 8091 8092 class C { 8093 class D { 8094 proc D {this} {} 8095 proc ~D {this} {} 8096 proc p {this} { 8097 set C::E::($this,m) 0 8098 } 8099 proc q {this} { 8100 set C::E::(n) 0 8101 } 8102 proc r {this} { 8103 unset C::E::($this,m) 8104 } 8105 proc s {this} { 8106 unset C::E::(n) 8107 } 8108 } 8109 set ::o [new D] 8110 class E { 8111 set ($o,m) 0 8112 set (n) 0 8113 } 8114 class D { 8115 catch {p $o} message; lappend ::result $message 8116 catch {q $o} message; lappend ::result $message 8117 catch {r $o} message; lappend ::result bug 8118 catch {s $o} message; lappend ::result bug 8119 } 8120 } 8121 catch {C::D::p $o} message; lappend ::result $message 8122 catch {C::D::q $o} message; lappend ::result $message 8123 catch {C::D::r $o} message; lappend ::result bug 8124 catch {C::D::s $o} message; lappend ::result bug 8125 delete $o 8126 8127 set ::result 8128 }] 8129 interp delete $interpreter 8130 set result 8131} [list\ 8132 {can't set "b::(1,m)": class access violation in procedure ::a::p}\ 8133 {can't set "b::(n)": class access violation in procedure ::a::q}\ 8134 bug\ 8135 bug\ 8136 {can't set "B::(2,m)": class access violation in procedure ::A::p}\ 8137 {can't set "B::(n)": class access violation in procedure ::A::q}\ 8138 bug\ 8139 bug\ 8140 {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\ 8141 {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\ 8142 bug\ 8143 bug\ 8144 {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\ 8145 {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\ 8146 bug\ 8147 bug\ 8148 {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\ 8149 {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\ 8150 bug\ 8151 bug\ 8152] 8153 8154test stooop-87 {verify member writing and unsetting within class namespaces in member data checking mode (it seems that unset tracing prevents error reporting at this time (bug?))} { 8155 set interpreter [interp create] 8156 $interpreter eval { 8157 # reset any existing environment variables: 8158 foreach name [array names env STOOOP*] {unset env($name)} 8159 set env(STOOOPCHECKDATA) 1 8160 } 8161 $interpreter eval "source $source; namespace import stooop::*" 8162 set result [$interpreter eval { 8163 class a { 8164 set (m) 0 8165 } 8166 proc a::a {this} { 8167 set ($this,n) 0 8168 } 8169 proc a::~a {this} {} 8170 set o [new a] 8171 catch {class b {incr a::(m)}} message; lappend ::result $message 8172 catch {class b {incr a::($o,n)}} message; lappend ::result $message 8173 catch {class b {unset a::(m)}} message; lappend ::result bug 8174 catch {class b {unset a::($o,n)}} message; lappend ::result bug 8175 delete $o 8176 8177 class A { 8178 set (m) 0 8179 proc A {this} { 8180 set ($this,n) 0 8181 } 8182 proc ~A {this} {} 8183 } 8184 set o [new A] 8185 class B { 8186 catch {incr A::(m)} message; lappend ::result $message 8187 catch {incr A::($o,n)} message; lappend ::result $message 8188 catch {unset A::(m)} message; lappend ::result bug 8189 catch {unset A::($o,n)} message; lappend ::result bug 8190 } 8191 delete $o 8192 8193 class c {} 8194 class c::d { 8195 set (m) 0 8196 } 8197 proc c::d::d {this} { 8198 set ($this,n) 0 8199 } 8200 proc c::d::~d {this} {} 8201 set o [new c::d] 8202 catch {class c::e {incr c::d::(m)}} message; lappend ::result $message 8203 catch {class c::e {incr c::d::($o,n)}} message; lappend ::result $message 8204 catch {class c::e {unset c::d::(m)}} message; lappend ::result bug 8205 catch {class c::e {unset c::d::($o,n)}} message; lappend ::result bug 8206 delete $o 8207 8208 class C { 8209 class D { 8210 set (m) 0 8211 proc D {this} { 8212 set ($this,n) 0 8213 } 8214 proc ~D {this} {} 8215 } 8216 set ::o [new D] 8217 class B { 8218 catch {incr C::D::(m)} message; lappend ::result $message 8219 catch {incr C::D::($o,n)} message; lappend ::result $message 8220 catch {unset C::D::(m)} message; lappend ::result bug 8221 catch {unset C::D::($o,n)} message; lappend ::result bug 8222 } 8223 } 8224 catch {set C::D::(m)} message; lappend ::result $message 8225 catch {set C::D::($o,n)} message; lappend ::result $message 8226 catch {unset C::D::(m)} message; lappend ::result bug 8227 catch {unset C::D::($o,n)} message; lappend ::result bug 8228 delete $o 8229 8230 set ::result 8231 }] 8232 interp delete $interpreter 8233 set result 8234} [list\ 8235 {can't set "a::(m)": class access violation in class b namespace}\ 8236 {can't set "a::(1,n)": class access violation in class b namespace}\ 8237 bug\ 8238 bug\ 8239 {can't set "A::(m)": class access violation in class B namespace}\ 8240 {can't set "A::(2,n)": class access violation in class B namespace}\ 8241 bug\ 8242 bug\ 8243 {can't set "c::d::(m)": class access violation in class c::e namespace}\ 8244 {can't set "c::d::(3,n)": class access violation in class c::e namespace}\ 8245 bug\ 8246 bug\ 8247 {can't set "C::D::(m)": class access violation in class C::B namespace}\ 8248 {can't set "C::D::(4,n)": class access violation in class C::B namespace}\ 8249 bug\ 8250 bug\ 8251 {can't read "C::D::(m)": no such element in array}\ 8252 {can't read "C::D::(4,n)": no such element in array}\ 8253 bug\ 8254 bug\ 8255] 8256 8257test stooop-88 { 8258 verify that object copying still works in member data checking mode 8259} { 8260 set interpreter [interp create] 8261 $interpreter eval { 8262 # reset any existing environment variables: 8263 foreach name [array names env STOOOP*] {unset env($name)} 8264 set env(STOOOPCHECKDATA) 1 8265 } 8266 $interpreter eval "source $source; namespace import stooop::*" 8267 set result [$interpreter eval { 8268 class a {} 8269 proc a::a {this} { 8270 set ($this,n) 0 8271 } 8272 new [new a] 8273 8274 class A { 8275 proc A {this} { 8276 set ($this,n) 0 8277 } 8278 } 8279 new [new A] 8280 8281 class b {} 8282 class b::c {} 8283 proc b::c::c {this} { 8284 set ($this,n) 0 8285 } 8286 new [new b::c] 8287 8288 class B { 8289 class C { 8290 proc C {this} { 8291 set ($this,n) 0 8292 } 8293 } 8294 new [new C] 8295 } 8296 new [new B::C] 8297 8298 set ::result {} 8299 }] 8300 interp delete $interpreter 8301 set result 8302} {} 8303 8304test stooop-89 { 8305 verify both data and procedure static access in member data checking mode 8306} { 8307 set interpreter [interp create] 8308 $interpreter eval { 8309 # reset any existing environment variables: 8310 foreach name [array names env STOOOP*] {unset env($name)} 8311 set env(STOOOPCHECKDATA) 1 8312 } 8313 $interpreter eval "source $source; namespace import stooop::*" 8314 set result [$interpreter eval { 8315 class a { 8316 set (m) 0 8317 } 8318 proc a::a {this} { 8319 set ($this,n) 0 8320 } 8321 proc a::~a {this} {} 8322 proc a::p {this} { 8323 incr (m) 8324 incr b::(o) 8325 } 8326 proc a::q {object} { 8327 incr ($object,n) 8328 incr b::($object,p) 8329 } 8330 class b { 8331 set (o) 0 8332 } 8333 proc b::b {this} a {} { 8334 set ($this,p) 0 8335 } 8336 proc b::~b {this} {} 8337 proc b::r {this} { 8338 incr (o) 8339 incr a::(m) 8340 } 8341 proc b::s {object} { 8342 incr ($object,p) 8343 incr a::($object,n) 8344 } 8345 set o [new b] 8346 catch {a::p $o} message; lappend ::result $message 8347 catch {a::q $o} message; lappend ::result $message 8348 catch {b::r $o} message; lappend ::result $message 8349 catch {b::s $o} message; lappend ::result $message 8350 delete $o 8351 8352 class A { 8353 set (m) 0 8354 proc A {this} { 8355 set ($this,n) 0 8356 } 8357 proc ~A {this} {} 8358 proc p {this} { 8359 incr (m) 8360 incr B::(o) 8361 } 8362 proc q {object} { 8363 incr ($object,n) 8364 incr B::($object,p) 8365 } 8366 } 8367 class B { 8368 set (o) 0 8369 proc B {this} A {} { 8370 set ($this,p) 0 8371 } 8372 proc ~B {this} {} 8373 proc r {this} { 8374 incr (o) 8375 incr A::(m) 8376 } 8377 proc s {object} { 8378 incr ($object,p) 8379 incr A::($object,n) 8380 } 8381 } 8382 set o [new B] 8383 catch {A::p $o} message; lappend ::result $message 8384 catch {A::q $o} message; lappend ::result $message 8385 catch {B::r $o} message; lappend ::result $message 8386 catch {B::s $o} message; lappend ::result $message 8387 delete $o 8388 8389 class c {} 8390 class c::d { 8391 set (m) 0 8392 } 8393 proc c::d::d {this} { 8394 set ($this,n) 0 8395 } 8396 proc c::d::~d {this} {} 8397 proc c::d::p {this} { 8398 incr (m) 8399 incr c::e::(o) 8400 } 8401 proc c::d::q {object} { 8402 incr ($object,n) 8403 incr c::e::($object,p) 8404 } 8405 class c::e { 8406 set (o) 0 8407 } 8408 proc c::e::e {this} c::d {} { 8409 set ($this,p) 0 8410 } 8411 proc c::e::~e {this} {} 8412 proc c::e::r {this} { 8413 incr (o) 8414 incr c::d::(m) 8415 } 8416 proc c::e::s {object} { 8417 incr ($object,p) 8418 incr c::d::($object,n) 8419 } 8420 set o [new c::e] 8421 catch {c::d::p $o} message; lappend ::result $message 8422 catch {c::d::q $o} message; lappend ::result $message 8423 catch {c::e::r $o} message; lappend ::result $message 8424 catch {c::e::s $o} message; lappend ::result $message 8425 delete $o 8426 8427 class C { 8428 class D { 8429 set (m) 0 8430 proc D {this} { 8431 set ($this,n) 0 8432 } 8433 proc ~D {this} {} 8434 proc p {this} { 8435 incr (m) 8436 incr C::E::(o) 8437 } 8438 proc q {object} { 8439 incr ($object,n) 8440 incr C::E::($object,p) 8441 } 8442 } 8443 class E { 8444 set (o) 0 8445 proc E {this} C::D {} { 8446 set ($this,p) 0 8447 } 8448 proc ~E {this} {} 8449 proc r {this} { 8450 incr (o) 8451 incr C::D::(m) 8452 } 8453 proc s {object} { 8454 incr ($object,p) 8455 incr C::D::($object,n) 8456 } 8457 } 8458 set ::o [new E] 8459 catch {D::p $o} message; lappend ::result $message 8460 catch {D::q $o} message; lappend ::result $message 8461 catch {E::r $o} message; lappend ::result $message 8462 catch {E::s $o} message; lappend ::result $message 8463 } 8464 catch {C::D::p $o} message; lappend ::result $message 8465 catch {C::D::q $o} message; lappend ::result $message 8466 catch {C::E::r $o} message; lappend ::result $message 8467 catch {C::E::s $o} message; lappend ::result $message 8468 delete $o 8469 8470 set ::result 8471 }] 8472 interp delete $interpreter 8473 set result 8474} [list\ 8475 {can't set "b::(o)": class access violation in procedure ::a::p}\ 8476 {can't set "b::(1,p)": class access violation in procedure ::a::q}\ 8477 {can't set "a::(m)": class access violation in procedure ::b::r}\ 8478 {can't set "a::(1,n)": class access violation in procedure ::b::s}\ 8479 {can't set "B::(o)": class access violation in procedure ::A::p}\ 8480 {can't set "B::(2,p)": class access violation in procedure ::A::q}\ 8481 {can't set "A::(m)": class access violation in procedure ::B::r}\ 8482 {can't set "A::(2,n)": class access violation in procedure ::B::s}\ 8483 {can't set "c::e::(o)": class access violation in procedure ::c::d::p}\ 8484 {can't set "c::e::(3,p)": class access violation in procedure ::c::d::q}\ 8485 {can't set "c::d::(m)": class access violation in procedure ::c::e::r}\ 8486 {can't set "c::d::(3,n)": class access violation in procedure ::c::e::s}\ 8487 {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\ 8488 {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\ 8489 {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\ 8490 {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\ 8491 {can't set "C::E::(o)": class access violation in procedure ::C::D::p}\ 8492 {can't set "C::E::(4,p)": class access violation in procedure ::C::D::q}\ 8493 {can't set "C::D::(m)": class access violation in procedure ::C::E::r}\ 8494 {can't set "C::D::(4,n)": class access violation in procedure ::C::E::s}\ 8495] 8496 8497test stooop-90 { 8498 verify member data checking when "array set" is used 8499} { 8500 set interpreter [interp create] 8501 $interpreter eval { 8502 # reset any existing environment variables: 8503 foreach name [array names env STOOOP*] {unset env($name)} 8504 set env(STOOOPCHECKDATA) 1 8505 } 8506 $interpreter eval "source $source; namespace import stooop::*" 8507 set result [$interpreter eval { 8508 class a {} 8509 proc a::a {this} {} 8510 proc a::~a {this} {} 8511 proc a::p {this} { 8512 array set b:: "$this,m 0" 8513 } 8514 proc a::q {this} { 8515 array set b:: {n 0} 8516 } 8517 set o [new a] 8518 class b {} 8519 array set b:: "$o,m 0 n 0" 8520 catch {a::p $o} message; lappend ::result $message 8521 catch {a::q $o} message; lappend ::result $message 8522 delete $o 8523 8524 class A { 8525 proc A {this} {} 8526 proc ~A {this} {} 8527 proc p {this} { 8528 array set B:: "$this,m 0" 8529 } 8530 proc q {this} { 8531 array set B:: {n 0} 8532 } 8533 } 8534 set o [new A] 8535 class B { 8536 array set B:: "$o,m 0 n 0" 8537 } 8538 class A { 8539 catch {p $o} message; lappend ::result $message 8540 catch {q $o} message; lappend ::result $message 8541 } 8542 delete $o 8543 8544 class c {} 8545 class c::d {} 8546 proc c::d::d {this} {} 8547 proc c::d::~d {this} {} 8548 proc c::d::p {this} { 8549 array set c::e:: "$this,m 0" 8550 } 8551 proc c::d::q {this} { 8552 array set c::e:: {n 0} 8553 } 8554 class c::e {} 8555 set o [new c::d] 8556 array set c::e:: "$o,m 0 n 0" 8557 catch {c::d::p $o} message; lappend ::result $message 8558 catch {c::d::q $o} message; lappend ::result $message 8559 delete $o 8560 8561 class C { 8562 class D { 8563 proc D {this} {} 8564 proc ~D {this} {} 8565 proc p {this} { 8566 array set C::E:: "$this,m 0" 8567 } 8568 proc q {this} { 8569 array set C::E:: {n 0} 8570 } 8571 } 8572 set ::o [new D] 8573 class E { 8574 array set C::E:: "$o,m 0 n 0" 8575 } 8576 class D { 8577 catch {p $o} message; lappend ::result $message 8578 catch {q $o} message; lappend ::result $message 8579 } 8580 } 8581 catch {C::D::p $o} message; lappend ::result $message 8582 catch {C::D::q $o} message; lappend ::result $message 8583 delete $o 8584 8585 set ::result 8586 }] 8587 interp delete $interpreter 8588 set result 8589} [list\ 8590 {can't set "b::(1,m)": class access violation in procedure ::a::p}\ 8591 {can't set "b::(n)": class access violation in procedure ::a::q}\ 8592 {can't set "B::(2,m)": class access violation in procedure ::A::p}\ 8593 {can't set "B::(n)": class access violation in procedure ::A::q}\ 8594 {can't set "c::e::(3,m)": class access violation in procedure ::c::d::p}\ 8595 {can't set "c::e::(n)": class access violation in procedure ::c::d::q}\ 8596 {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\ 8597 {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\ 8598 {can't set "C::E::(4,m)": class access violation in procedure ::C::D::p}\ 8599 {can't set "C::E::(n)": class access violation in procedure ::C::D::q}\ 8600] 8601 8602test stooop-91 { 8603 verify that packaged class works even in debugging mode 8604} { 8605 makeDirectory 91 8606 makeFile {package ifneeded 91 1 [list tclPkgSetup $dir 91 1 {{p.tcl source {::a::_copy ::a::a}}}]}\ 8607 [file join 91 pkgIndex.tcl] 8608 makeFile {package provide 91 1; class a {proc a {this} {}}}\ 8609 [file join 91 p.tcl] 8610 set interpreter [interp create] 8611 $interpreter eval { 8612 # search in test directory sub-directories: 8613 lappend auto_path [file dirname [info script]] 8614 # reset any existing environment variables: 8615 foreach name [array names env STOOOP*] {unset env($name)} 8616 set env(STOOOPCHECKPROCEDURES) 1 8617 } 8618 $interpreter eval "source $source; namespace import stooop::*" 8619 set result [$interpreter eval { 8620 package require 91 8621 new a 8622 set ::result {} 8623 }] 8624 interp delete $interpreter 8625 removeDirectory 91 8626 set result 8627} {} 8628 8629test stooop-92 { 8630 check that parameter passing by reference works with virtual declarations 8631} { 8632 set interpreter [interp create] 8633 $interpreter eval "source $source; namespace import stooop::*" 8634 $interpreter eval $dumpArraysCode 8635 set result [$interpreter eval { 8636 class a {} 8637 proc a::a {this} {} 8638 proc a::~a {this} {} 8639 virtual proc a::f {this a} {} 8640 virtual proc a::g {this a} 8641 virtual proc a::h {this a} { 8642 upvar $a d 8643 set d(0) 0 8644 } 8645 virtual proc a::i {this a} {} 8646 virtual proc a::j {this a} 8647 virtual proc a::k {this a} {} 8648 class b {} 8649 proc b::b {this} a {} {} 8650 proc b::~b {this} {} 8651 proc b::f {this a} { 8652 upvar $a d 8653 set d(1) 1 8654 } 8655 proc b::g {this a} { 8656 upvar $a d 8657 set d(2) 2 8658 } 8659 virtual proc b::i {this a} {} 8660 virtual proc b::j {this a} 8661 virtual proc b::k {this a} { 8662 upvar $a d 8663 set d(3) 3 8664 } 8665 class c {} 8666 proc c::c {this} b {} {} 8667 proc c::~c {this} {} 8668 proc c::i {this a} { 8669 upvar $a d 8670 set d(4) 4 8671 } 8672 proc c::j {this a} { 8673 upvar $a d 8674 set d(5) 5 8675 } 8676 set o [new c] 8677 a::f $o z 8678 a::g $o z 8679 a::h $o z 8680 a::i $o z 8681 a::j $o z 8682 a::k $o z 8683 eval lappend ::result [dumpArrays z] 8684 8685 class A { 8686 proc A {this} {} 8687 proc ~A {this} {} 8688 virtual proc f {this a} {} 8689 virtual proc g {this a} 8690 virtual proc h {this a} { 8691 upvar $a d 8692 set d(0) 0 8693 } 8694 virtual proc i {this a} {} 8695 virtual proc j {this a} 8696 virtual proc k {this a} {} 8697 } 8698 class B { 8699 proc B {this} A {} {} 8700 proc ~B {this} {} 8701 proc f {this a} { 8702 upvar $a d 8703 set d(1) 1 8704 } 8705 proc g {this a} { 8706 upvar $a d 8707 set d(2) 2 8708 } 8709 virtual proc i {this a} {} 8710 virtual proc j {this a} 8711 virtual proc k {this a} { 8712 upvar $a d 8713 set d(3) 3 8714 } 8715 } 8716 class C { 8717 proc C {this} B {} {} 8718 proc ~C {this} {} 8719 proc i {this a} { 8720 upvar $a d 8721 set d(4) 4 8722 } 8723 proc j {this a} { 8724 upvar $a d 8725 set d(5) 5 8726 } 8727 } 8728 set o [new C] 8729 A::f $o Z 8730 A::g $o Z 8731 A::h $o Z 8732 A::i $o Z 8733 A::j $o Z 8734 A::k $o Z 8735 eval lappend ::result [dumpArrays Z] 8736 8737 set ::result 8738 }] 8739 interp delete $interpreter 8740 set result 8741} [list\ 8742 {z(0) = 0}\ 8743 {z(1) = 1}\ 8744 {z(2) = 2}\ 8745 {z(3) = 3}\ 8746 {z(4) = 4}\ 8747 {z(5) = 5}\ 8748 {Z(0) = 0}\ 8749 {Z(1) = 1}\ 8750 {Z(2) = 2}\ 8751 {Z(3) = 3}\ 8752 {Z(4) = 4}\ 8753 {Z(5) = 5}\ 8754] 8755 8756test stooop-93 { 8757 check that member procedure invocation within constructor does not break 8758 procedure checking debug mode 8759} { 8760 set interpreter [interp create] 8761 $interpreter eval { 8762 # reset any existing environment variables: 8763 foreach name [array names env STOOOP*] {unset env($name)} 8764 set env(STOOOPCHECKPROCEDURES) 1 8765 } 8766 $interpreter eval "source $source; namespace import stooop::*" 8767 set result [$interpreter eval { 8768 class a {} 8769 proc a::a {this} { 8770 p $this 8771 q 8772 } 8773 proc a::~a {this} {} 8774 proc a::p {this} {} 8775 proc a::q {} {} 8776 new a 8777 8778 class A { 8779 proc A {this} { 8780 p $this 8781 q 8782 } 8783 proc ~A {this} {} 8784 proc p {this} {} 8785 proc q {} {} 8786 } 8787 new A 8788 8789 class b {} 8790 class b::c {} 8791 proc b::c::c {this} { 8792 p $this 8793 q 8794 } 8795 proc b::c::~c {this} {} 8796 proc b::c::p {this} {} 8797 proc b::c::q {} {} 8798 new b::c 8799 8800 class B { 8801 class C { 8802 proc C {this} { 8803 p $this 8804 q 8805 } 8806 proc ~C {this} {} 8807 proc p {this} {} 8808 proc q {} {} 8809 } 8810 } 8811 new B::C 8812 8813 set ::result {} 8814 }] 8815 interp delete $interpreter 8816 set result 8817} {} 8818 8819test stooop-94 { 8820 basic objects checking 8821} { 8822 set interpreter [interp create] 8823 $interpreter eval { 8824 # reset any existing environment variables: 8825 foreach name [array names env STOOOP*] {unset env($name)} 8826 set env(STOOOPCHECKOBJECTS) 1 8827 } 8828 $interpreter eval "source $source; namespace import stooop::*" 8829 # alias puts to be able to collect standard output data: 8830 proc appendResult {string} {lappend ::result $string} 8831 $interpreter alias puts appendResult 8832 set result {} 8833 $interpreter eval { 8834 class a {} 8835 proc a::a {this} {} 8836 proc a::~a {this} {} 8837 proc p {} { 8838 new a 8839 } 8840 namespace eval n { 8841 proc p {} { 8842 new a 8843 } 8844 } 8845 stooop::record 8846 new a 8847 stooop::report 8848 p 8849 stooop::report 8850 n::p 8851 stooop::report 8852 stooop::record 8853 delete 1 8854 stooop::report 8855 delete 2 8856 stooop::report 8857 delete 3 8858 stooop::report 8859 8860 class A { 8861 proc A {this} {} 8862 proc ~A {this} {} 8863 } 8864 proc q {} { 8865 new A 8866 } 8867 namespace eval m { 8868 proc q {} { 8869 new A 8870 } 8871 } 8872 stooop::record 8873 new A 8874 stooop::report 8875 q 8876 stooop::report 8877 m::q 8878 stooop::report 8879 stooop::record 8880 delete 4 8881 stooop::report 8882 delete 5 8883 stooop::report 8884 delete 6 8885 stooop::report 8886 } 8887 interp delete $interpreter 8888 set result 8889} [list\ 8890 {stooop::record invoked from top level}\ 8891 {stooop::report invoked from top level:}\ 8892 {+ ::a(1) + top level}\ 8893 {stooop::report invoked from top level:}\ 8894 {+ ::a(1) + top level}\ 8895 {+ ::a(2) + ::p}\ 8896 {stooop::report invoked from top level:}\ 8897 {+ ::a(1) + top level}\ 8898 {+ ::a(2) + ::p}\ 8899 {+ ::a(3) + ::n::p}\ 8900 {stooop::record invoked from top level}\ 8901 {stooop::report invoked from top level:}\ 8902 {- ::a(1) - top level + top level}\ 8903 {stooop::report invoked from top level:}\ 8904 {- ::a(1) - top level + top level}\ 8905 {- ::a(2) - top level + ::p}\ 8906 {stooop::report invoked from top level:}\ 8907 {- ::a(1) - top level + top level}\ 8908 {- ::a(2) - top level + ::p}\ 8909 {- ::a(3) - top level + ::n::p}\ 8910 {stooop::record invoked from top level}\ 8911 {stooop::report invoked from top level:}\ 8912 {+ ::A(4) + top level}\ 8913 {stooop::report invoked from top level:}\ 8914 {+ ::A(4) + top level}\ 8915 {+ ::A(5) + ::q}\ 8916 {stooop::report invoked from top level:}\ 8917 {+ ::A(4) + top level}\ 8918 {+ ::A(5) + ::q}\ 8919 {+ ::A(6) + ::m::q}\ 8920 {stooop::record invoked from top level}\ 8921 {stooop::report invoked from top level:}\ 8922 {- ::A(4) - top level + top level}\ 8923 {stooop::report invoked from top level:}\ 8924 {- ::A(4) - top level + top level}\ 8925 {- ::A(5) - top level + ::q}\ 8926 {stooop::report invoked from top level:}\ 8927 {- ::A(4) - top level + top level}\ 8928 {- ::A(5) - top level + ::q}\ 8929 {- ::A(6) - top level + ::m::q}\ 8930] 8931 8932test stooop-95 { 8933 objects checking from namespace body and namespace procedure 8934} { 8935 set interpreter [interp create] 8936 $interpreter eval { 8937 # reset any existing environment variables: 8938 foreach name [array names env STOOOP*] {unset env($name)} 8939 set env(STOOOPCHECKOBJECTS) 1 8940 } 8941 $interpreter eval "source $source; namespace import stooop::*" 8942 # alias puts to be able to collect standard output data: 8943 proc appendResult {string} {lappend ::result $string} 8944 $interpreter alias puts appendResult 8945 set result {} 8946 $interpreter eval { 8947 class a { 8948 proc a {this} {} 8949 proc ~a {this} {} 8950 } 8951 namespace eval n { 8952 proc p {} { 8953 new a 8954 } 8955 namespace eval m { 8956 proc q {} { 8957 new a 8958 } 8959 } 8960 } 8961 stooop::record 8962 namespace eval n { 8963 new a 8964 } 8965 stooop::report 8966 n::p 8967 stooop::report 8968 namespace eval n::m { 8969 new a 8970 } 8971 stooop::report 8972 n::m::q 8973 stooop::report 8974 delete 1 2 3 4 8975 } 8976 interp delete $interpreter 8977 set result 8978} [list\ 8979 {stooop::record invoked from top level}\ 8980 {stooop::report invoked from top level:}\ 8981 {+ ::a(1) + namespace ::n}\ 8982 {stooop::report invoked from top level:}\ 8983 {+ ::a(1) + namespace ::n}\ 8984 {+ ::a(2) + ::n::p}\ 8985 {stooop::report invoked from top level:}\ 8986 {+ ::a(1) + namespace ::n}\ 8987 {+ ::a(2) + ::n::p}\ 8988 {+ ::a(3) + namespace ::n::m}\ 8989 {stooop::report invoked from top level:}\ 8990 {+ ::a(1) + namespace ::n}\ 8991 {+ ::a(2) + ::n::p}\ 8992 {+ ::a(3) + namespace ::n::m}\ 8993 {+ ::a(4) + ::n::m::q}\ 8994] 8995 8996test stooop-96 { 8997 objects checking from within derived class constructor 8998} { 8999 set interpreter [interp create] 9000 $interpreter eval { 9001 # reset any existing environment variables: 9002 foreach name [array names env STOOOP*] {unset env($name)} 9003 set env(STOOOPCHECKOBJECTS) 1 9004 } 9005 $interpreter eval "source $source; namespace import stooop::*" 9006 # alias puts to be able to collect standard output data: 9007 proc appendResult {string} {lappend ::result $string} 9008 $interpreter alias puts appendResult 9009 set result {} 9010 $interpreter eval { 9011 class a { 9012 proc a {this i} {} 9013 proc ~a {this} {} 9014 } 9015 class b { 9016 proc b {this} a {[new c]} {} 9017 proc ~b {this} {} 9018 } 9019 class c { 9020 proc c {this} {} 9021 proc ~c {this} {} 9022 } 9023 stooop::record 9024 new b 9025 stooop::report 9026 9027 class A { 9028 class a { 9029 proc a {this i} {} 9030 proc ~a {this} {} 9031 } 9032 class b { 9033 proc b {this} a {[new c]} {} 9034 proc ~b {this} {} 9035 } 9036 class c { 9037 proc c {this} {} 9038 proc ~c {this} {} 9039 } 9040 stooop::record 9041 new b 9042 stooop::report 9043 } 9044 9045 } 9046 interp delete $interpreter 9047 set result 9048} [list\ 9049 {stooop::record invoked from top level}\ 9050 {stooop::report invoked from top level:}\ 9051 {+ ::b(1) + top level}\ 9052 {+ ::c(2) + ::b::b}\ 9053 {stooop::record invoked from namespace ::A}\ 9054 {stooop::report invoked from namespace ::A:}\ 9055 {+ ::A::b(3) + namespace ::A}\ 9056 {+ ::c(4) + ::A::b::b}\ 9057] 9058 9059test stooop-97 { 9060 objects checking with debugging procedures invocation from namespace body 9061 and namespace procedure 9062} { 9063 set interpreter [interp create] 9064 $interpreter eval { 9065 # reset any existing environment variables: 9066 foreach name [array names env STOOOP*] {unset env($name)} 9067 set env(STOOOPCHECKOBJECTS) 1 9068 } 9069 $interpreter eval "source $source; namespace import stooop::*" 9070 # alias puts to be able to collect standard output data: 9071 proc appendResult {string} {lappend ::result $string} 9072 $interpreter alias puts appendResult 9073 set result {} 9074 $interpreter eval { 9075 class a { 9076 proc a {this} {} 9077 proc ~a {this} {} 9078 } 9079 namespace eval n { 9080 proc p {} { 9081 stooop::record 9082 new a 9083 stooop::report 9084 } 9085 namespace eval m { 9086 proc q {} { 9087 stooop::record 9088 new a 9089 stooop::report 9090 } 9091 } 9092 } 9093 n::p 9094 n::m::q 9095 namespace eval n { 9096 stooop::record 9097 new a 9098 stooop::report 9099 } 9100 9101 } 9102 interp delete $interpreter 9103 set result 9104} [list\ 9105 {stooop::record invoked from ::n::p}\ 9106 {stooop::report invoked from ::n::p:}\ 9107 {+ ::a(1) + ::n::p}\ 9108 {stooop::record invoked from ::n::m::q}\ 9109 {stooop::report invoked from ::n::m::q:}\ 9110 {+ ::a(2) + ::n::m::q}\ 9111 {stooop::record invoked from namespace ::n}\ 9112 {stooop::report invoked from namespace ::n:}\ 9113 {+ ::a(3) + namespace ::n}\ 9114] 9115 9116test stooop-98 { 9117 objects checking with missing and extra objects 9118} { 9119 set interpreter [interp create] 9120 $interpreter eval { 9121 # reset any existing environment variables: 9122 foreach name [array names env STOOOP*] {unset env($name)} 9123 set env(STOOOPCHECKOBJECTS) 1 9124 } 9125 $interpreter eval "source $source; namespace import stooop::*" 9126 # alias puts to be able to collect standard output data: 9127 proc appendResult {string} {lappend ::result $string} 9128 $interpreter alias puts appendResult 9129 set result {} 9130 $interpreter eval { 9131 class a { 9132 proc a {this} {} 9133 proc ~a {this} {} 9134 } 9135 stooop::record 9136 set o [new a] 9137 stooop::report 9138 stooop::record 9139 delete $o 9140 stooop::report 9141 9142 } 9143 interp delete $interpreter 9144 set result 9145} [list\ 9146 {stooop::record invoked from top level}\ 9147 {stooop::report invoked from top level:}\ 9148 {+ ::a(1) + top level}\ 9149 {stooop::record invoked from top level}\ 9150 {stooop::report invoked from top level:}\ 9151 {- ::a(1) - top level + top level}\ 9152] 9153 9154test stooop-99 { 9155} { 9156 set interpreter [interp create] 9157 $interpreter eval { 9158 # reset any existing environment variables: 9159 foreach name [array names env STOOOP*] {unset env($name)} 9160 set env(STOOOPCHECKOBJECTS) 1 9161 } 9162 $interpreter eval "source $source; namespace import stooop::*" 9163 # alias puts to be able to collect standard output data: 9164 proc appendResult {string} {lappend ::result $string} 9165 $interpreter alias puts appendResult 9166 set result {} 9167 $interpreter eval { 9168 class a {} 9169 proc a::a {this} {} 9170 proc a::~a {this} {} 9171 proc p {} { 9172 new a 9173 } 9174 namespace eval n { 9175 proc p {} { 9176 new a 9177 } 9178 } 9179 stooop::printObjects 9180 new a 9181 stooop::printObjects 9182 p 9183 stooop::printObjects 9184 n::p 9185 stooop::printObjects 9186 delete 1 9187 stooop::printObjects 9188 delete 2 9189 stooop::printObjects 9190 delete 3 9191 stooop::printObjects 9192 9193 class A { 9194 proc A {this} {} 9195 proc ~A {this} {} 9196 } 9197 proc q {} { 9198 new A 9199 } 9200 namespace eval m { 9201 proc q {} { 9202 new A 9203 } 9204 } 9205 stooop::printObjects 9206 new A 9207 stooop::printObjects 9208 q 9209 stooop::printObjects 9210 m::q 9211 stooop::printObjects 9212 delete 4 9213 stooop::printObjects 9214 delete 5 9215 stooop::printObjects 9216 delete 6 9217 stooop::printObjects 9218 9219 } 9220 interp delete $interpreter 9221 set result 9222} [list\ 9223 {stooop::printObjects invoked from top level:}\ 9224 {stooop::printObjects invoked from top level:}\ 9225 {::a(1) + top level}\ 9226 {stooop::printObjects invoked from top level:}\ 9227 {::a(1) + top level}\ 9228 {::a(2) + ::p}\ 9229 {stooop::printObjects invoked from top level:}\ 9230 {::a(1) + top level}\ 9231 {::a(2) + ::p}\ 9232 {::a(3) + ::n::p}\ 9233 {stooop::printObjects invoked from top level:}\ 9234 {::a(2) + ::p}\ 9235 {::a(3) + ::n::p}\ 9236 {stooop::printObjects invoked from top level:}\ 9237 {::a(3) + ::n::p}\ 9238 {stooop::printObjects invoked from top level:}\ 9239 {stooop::printObjects invoked from top level:}\ 9240 {stooop::printObjects invoked from top level:}\ 9241 {::A(4) + top level}\ 9242 {stooop::printObjects invoked from top level:}\ 9243 {::A(4) + top level}\ 9244 {::A(5) + ::q}\ 9245 {stooop::printObjects invoked from top level:}\ 9246 {::A(4) + top level}\ 9247 {::A(5) + ::q}\ 9248 {::A(6) + ::m::q}\ 9249 {stooop::printObjects invoked from top level:}\ 9250 {::A(5) + ::q}\ 9251 {::A(6) + ::m::q}\ 9252 {stooop::printObjects invoked from top level:}\ 9253 {::A(6) + ::m::q}\ 9254 {stooop::printObjects invoked from top level:}\ 9255] 9256 9257test stooop-100 { 9258 objects checking pattern matching 9259} { 9260 set interpreter [interp create] 9261 $interpreter eval { 9262 # reset any existing environment variables: 9263 foreach name [array names env STOOOP*] {unset env($name)} 9264 set env(STOOOPCHECKOBJECTS) 1 9265 } 9266 $interpreter eval "source $source; namespace import stooop::*" 9267 # alias puts to be able to collect standard output data: 9268 proc appendResult {string} {lappend ::result $string} 9269 $interpreter alias puts appendResult 9270 set result {} 9271 $interpreter eval { 9272 class aa { 9273 proc aa {this} {} 9274 proc ~aa {this} {} 9275 } 9276 class ab { 9277 proc ab {this} {} 9278 proc ~ab {this} {} 9279 } 9280 class bb { 9281 proc bb {this} {} 9282 proc ~bb {this} {} 9283 } 9284 stooop::record 9285 new aa 9286 new ab 9287 new bb 9288 stooop::printObjects ::a* 9289 stooop::printObjects ::*b 9290 stooop::report ::a* 9291 stooop::report ::*b 9292 stooop::record 9293 delete 1 2 3 9294 stooop::report ::a* 9295 stooop::report ::*b 9296 9297 } 9298 interp delete $interpreter 9299 set result 9300} [list\ 9301 {stooop::record invoked from top level}\ 9302 {stooop::printObjects invoked from top level:}\ 9303 {::aa(1) + top level}\ 9304 {::ab(2) + top level}\ 9305 {stooop::printObjects invoked from top level:}\ 9306 {::ab(2) + top level}\ 9307 {::bb(3) + top level}\ 9308 {stooop::report invoked from top level:}\ 9309 {+ ::aa(1) + top level}\ 9310 {+ ::ab(2) + top level}\ 9311 {stooop::report invoked from top level:}\ 9312 {+ ::ab(2) + top level}\ 9313 {+ ::bb(3) + top level}\ 9314 {stooop::record invoked from top level}\ 9315 {stooop::report invoked from top level:}\ 9316 {- ::aa(1) - top level + top level}\ 9317 {- ::ab(2) - top level + top level}\ 9318 {stooop::report invoked from top level:}\ 9319 {- ::ab(2) - top level + top level}\ 9320 {- ::bb(3) - top level + top level}\ 9321] 9322 9323test stooop-101 { 9324 check that new lines within base class constructors arguments work without 9325 spacing 9326} { 9327 set interpreter [interp create] 9328 $interpreter eval "source $source; namespace import stooop::*" 9329 $interpreter eval $dumpArraysCode 9330 set result [$interpreter eval { 9331 class a {} 9332 proc a::a {this p q} { 9333 set ($this,m) $p 9334 set ($this,n) $q 9335 } 9336 class b {} 9337 proc b::b {this p q r} a { 9338 $p 9339 $q 9340 } { 9341 set ($this,o) $r 9342 } 9343 new b {x y} z {1 2} 9344 eval lappend ::result [dumpArrays a:: b::] 9345 9346 set ::result 9347 }] 9348 interp delete $interpreter 9349 set result 9350} [list\ 9351 {a::(1,_derived) = ::b}\ 9352 {a::(1,m) = x y}\ 9353 {a::(1,n) = z}\ 9354 {b::(1,o) = 1 2}\ 9355] 9356 9357test stooop-102 { 9358 check that new lines within base class constructors arguments work without 9359 spacing, with a DOS formatted file 9360} { 9361 set interpreter [interp create] 9362 $interpreter eval "source $source; namespace import stooop::*" 9363 $interpreter eval $dumpArraysCode 9364 set result [$interpreter eval { 9365 class a {} 9366 proc a::a {this p q} { 9367 set ($this,m) $p 9368 set ($this,n) $q 9369 } 9370 class b {} 9371 proc b::b {this p q r} a { 9372 $p 9373 $q 9374 } { 9375 set ($this,o) $r 9376 } 9377 new b {x y} z {1 2} 9378 eval lappend ::result [dumpArrays a:: b::] 9379 9380 set ::result 9381 }] 9382 interp delete $interpreter 9383 set result 9384} [list\ 9385 {a::(1,_derived) = ::b}\ 9386 {a::(1,m) = x y}\ 9387 {a::(1,n) = z}\ 9388 {b::(1,o) = 1 2}\ 9389] 9390 9391# ------------------------------------------------------------------------- 9392 9393testsuiteCleanup 9394return 9395 9396# Local variables: 9397# mode: tcl 9398# End: 9399